mirrors
/
janet
mirror of https://github.com/janet-lang/janet
1
0
Fork 0
Code Issues 1 Releases Wiki Activity

Add vars, split up headers, remove fiber->ret, add comparators, etc.

This commit is contained in:
bakpakin 2017-12-30 16:46:59 -05:00
parent 34a83839f5
commit f273aa8b1b
26 changed files with 2144 additions and 2261 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@ -1,6 +1,6 @@
# Target
/client/dst
./dst
dst
# Generated files
*.gen.h

91
2
View File

@ -1,91 +0,0 @@
/*
* Copyright (c) 2017 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include "compile.h"
void dst_compile_slotpool_init(DstSlotPool *pool) {
pool->s = NULL;
pool->count = 0;
pool->max;
pool->cap = 0;
}
void dst_compile_slotpool_deinit(DstSlotPool *pool) {
free(pool->s);
pool->s = NULL;
pool->cap = 0;
pool->max = 0;
pool->count = 0;
}
void dst_compile_slotpool_extend(DstSlotPool *pool, int32_t extra) {
int32_t i;
int32_t newcap = pool->cap + extra;
if (newcap > pool->cap) {
newcap *= 2;
pool->s = realloc(pool->s, newcap * sizeof(DstSlot));
if (NULL == pool->s) {
DST_OUT_OF_MEMORY;
}
}
pool->cap = newcap;
/* Mark all new slots as free */
for (i = pool->count; i < newcap; i++) {
pool->s[i].flags = 0;
}
}
DstSlot *dst_compile_slotpool_alloc(DstSlotPool *pool) {
int32_t oldcount = pool->count;
int32_t newcount = oldcount == 0xF0 ? 0x101 : oldcount + 1;
int32_t index = newcount - 1;
while (pool->count < pool->cap) {
if (!(pool->s[pool->count].flags & DST_SLOT_NOTEMPTY)) {
return pool->s + pool->count;
}
pool->free++;
}
dst_compile_slotpool_extend(pool, newcount - oldcount);
pool->s[index].flags = DST_SLOT_NOTEMPTY;
pool->s[index].index = index;
return pool->s + index;
}
void dst_compile_slotpool_freeindex(DstSlotPool *pool, int32_t index) {
if (index > 0 && index < pool->count) {
pool->s[index].flags = 0;
if (index < pool->free)
pool->free = index;
}
}
void dst_compile_slotpool_free(DstSlotPool *pool, DstSlot *s) {
DstSlot *oldfree = pool->s + pool->free;
if (s >= pool->s && s < (pool->s + pool->count)) {
if (s < oldfree) {
pool->free = s - pool->s;
}
s->flags = 0;
}
}

14
Makefile
View File

@ -26,13 +26,13 @@ PREFIX?=/usr/local
BINDIR=$(PREFIX)/bin
VERSION=\"0.0.0-beta\"
CFLAGS=-std=c99 -Wall -Wextra -Wfatal-errors -I./include -I./libs -g -DDST_VERSION=$(VERSION)
CFLAGS=-std=c99 -Wall -Wextra -I./include -I./libs -g -DDST_VERSION=$(VERSION)
PREFIX=/usr/local
DST_TARGET=dst
DST_XXD=xxd
DEBUGGER=lldb
DST_INTERNAL_HEADERS=$(addprefix core/,symcache.h opcodes.h strtod.h compile.h gc.h)
DST_HEADERS=$(addprefix include/dst/,dst.h)
DST_INTERNAL_HEADERS=$(addprefix core/,symcache.h opcodes.h strtod.h compile.h gc.h sourcemap.h)
DST_HEADERS=$(addprefix include/dst/,dst.h dstconfig.h dsttypes.h dststate.h dststl.h)
#############################
##### Generated headers #####
@ -60,13 +60,13 @@ $(DST_XXD): libs/xxd.c
DST_CORE_SOURCES=$(addprefix core/,\
array.c asm.c buffer.c compile.c\
fiber.c func.c gc.c parse.c string.c strtod.c\
struct.c symcache.c syscalls.c table.c tuple.c userdata.c util.c\
fiber.c func.c gc.c math.c parse.c sourcemap.c string.c stl.c strtod.c\
struct.c symcache.c table.c tuple.c userdata.c util.c\
value.c vm.c wrap.c)
DST_CORE_OBJECTS=$(patsubst %.c,%.o,$(DST_CORE_SOURCES))
$(DST_TARGET): $(DST_CORE_OBJECTS)
$(CC) $(CFLAGS) -o $(DST_TARGET) $(DST_CORE_OBJECTS)
$(DST_TARGET): client/main.o $(DST_CORE_OBJECTS)
$(CC) $(CFLAGS) -o $(DST_TARGET) $^
# Compile all .c to .o
%.o: %.c $(DST_ALL_HEADERS)

359
client/main.c
View File

@ -24,196 +24,159 @@
#include <stdio.h>
#include <dst/dst.h>
static int client_strequal(const char *a, const char *b) {
while (*a)
if (*a++ != *b++) return 0;
return *a == *b;
}
static int client_strequal_witharg(const char *a, const char *b) {
while (*b)
if (*a++ != *b++) return 0;
return *a == '=';
}
#define DST_CLIENT_HELP 1
#define DST_CLIENT_VERBOSE 2
#define DST_CLIENT_VERSION 4
#define DST_CLIENT_REPL 8
#define DST_CLIENT_NOCOLOR 16
#define DST_CLIENT_UNKNOWN 32
#define DST_CLIENT_UNKNOWN 16
static void printf_flags(int64_t flags, const char *col, const char *fmt, const char *arg) {
if (!(flags & DST_CLIENT_NOCOLOR))
printf("\x1B[%sm", col);
printf(fmt, arg);
if (!(flags & DST_CLIENT_NOCOLOR))
printf("\x1B[0m");
static DstValue env;
static int client_strequal(const char *a, const char *b) {
while (*a) if (*a++ != *b++) return 0;
return *a == *b;
}
/* Simple read line functionality */
static char *dst_getline() {
char *line = malloc(100);
char *linep = line;
size_t lenmax = 100;
size_t len = lenmax;
int c;
if (line == NULL)
return NULL;
for (;;) {
c = fgetc(stdin);
if (c == EOF)
break;
if (--len == 0) {
len = lenmax;
char *linen = realloc(linep, lenmax *= 2);
if (linen == NULL) {
free(linep);
return NULL;
}
line = linen + (line - linep);
linep = linen;
}
if ((*line++ = c) == '\n')
break;
}
*line = '\0';
return linep;
static int client_strequal_witharg(const char *a, const char *b) {
while (*b) if (*a++ != *b++) return 0;
return *a == '=';
}
/* Compile and run an ast */
static int debug_compile_and_run(Dst *vm, DstValue ast, int64_t flags) {
DstValue func = dst_compile(vm, vm->env, ast);
/* Check for compilation errors */
if (func.type != DST_FUNCTION) {
printf_flags(flags, "31", "compiler error: %s\n", (const char *)dst_to_string(vm, func));
return 1;
}
/* Execute function */
if (dst_run(vm, func)) {
printf_flags(flags, "31", "vm error: %s\n", (const char *)dst_to_string(vm, vm->ret));
return 1;
}
return 0;
}
/* Parse a file and execute it */
static int debug_run(Dst *vm, FILE *in, int64_t flags) {
/* Load source from a file */
static const uint8_t *loadsource(const char *fpath, int32_t *len) {
FILE *f = fopen(fpath, "rb");
long fsize;
size_t fsizet;
uint8_t *source = NULL;
uint32_t sourceSize = 0;
long bufsize;
if (fseek(f, 0, SEEK_END)) goto error;
fsize = ftell(f);
if (fsize > INT32_MAX || fsize < 0) goto error;
fsizet = fsize;
if (fseek(f, 0, SEEK_SET)) goto error;
if (!fsize) goto error;
source = malloc(fsize);
if (fread(source, 1, fsize, f) != fsizet) goto error;
if (fclose(f)) goto error;
*len = (int32_t) fsizet;
return source;
/* Read file into memory */
if (!fseek(in, 0L, SEEK_END) == 0) goto file_error;
bufsize = ftell(in);
if (bufsize == -1) goto file_error;
sourceSize = (uint32_t) bufsize;
source = malloc(bufsize);
if (!source) goto file_error;
if (fseek(in, 0L, SEEK_SET) != 0) goto file_error;
fread(source, sizeof(char), bufsize, in);
if (ferror(in) != 0) goto file_error;
while (source) {
source = dst_parseb(vm, 0, source, sourceSize);
}
/* Finish up */
fclose(in);
return 0;
/* Handle errors */
file_error:
if (source) {
free(source);
}
printf_flags(flags, "31", "parse error: could not read file%s\n", "");
fclose(in);
return 1;
char buffer[2048] = {0};
const char *reader = buffer;
for (;;) {
int status = dst_parsec(vm, )
while (p.status != DST_PARSER_ERROR && p.status != DST_PARSER_FULL) {
if (*reader == '\0') {
if (!fgets(buffer, sizeof(buffer), in)) {
/* Check that parser is complete */
if (p.status != DST_PARSER_FULL && p.status != DST_PARSER_ROOT) {
printf_flags(flags, "31", "parse error: unexpected end of source%s\n", "");
return 1;
}
/* Otherwise we finished the file with no problems */
return 0;
}
reader = buffer;
}
reader += dst_parse_cstring(&p, reader);
}
/* Check if file read in correctly */
if (p.error) {
printf_flags(flags, "31", "parse error: %s\n", p.error);
break;
}
/* Check that parser is complete */
if (p.status != DST_PARSER_FULL && p.status != DST_PARSER_ROOT) {
printf_flags(flags, "31", "parse error: unexpected end of source%s\n", "");
break;
}
if (debug_compile_and_run(vm, dst_parse_consume(&p), flags)) {
break;
}
}
return 1;
error:
free(source);
return NULL;
}
/* A simple repl */
static int debug_repl(Dst *vm, uint64_t flags) {
char *buffer, *reader;
DstParser p;
buffer = reader = NULL;
/* simple repl */
static int repl() {
DstBuffer b;
dst_buffer_init(&b, 256);
for (;;) {
/* Init parser */
dst_parser(&p, vm);
while (p.status != DST_PARSER_ERROR && p.status != DST_PARSER_FULL) {
if (p.status == DST_PARSER_ERROR || p.status == DST_PARSER_FULL)
int c;
DstParseResult res;
DstCompileResult cres;
DstCompileOptions opts;
if (b.count == 0)
printf("> ");
else
printf(">> ");
for (;;) {
c = fgetc(stdin);
if (c == EOF) {
printf("\n");
goto done;
}
dst_buffer_push_u8(&b, c);
if (c == '\n') break;
}
res = dst_parse(b.data, b.count);
switch (res.status) {
case DST_PARSE_NODATA:
b.count = 0;
break;
case DST_PARSE_UNEXPECTED_EOS:
break;
case DST_PARSE_ERROR:
dst_puts(dst_formatc("syntax error at %d: %S\n",
res.bytes_read + 1, res.error));
b.count = 0;
break;
case DST_PARSE_OK:
{
opts.source = res.value;
opts.flags = 0;
opts.sourcemap = res.map;
opts.env = env;
cres = dst_compile(opts);
if (cres.status == DST_COMPILE_OK) {
DstFunction *f = dst_compile_func(cres);
DstValue ret;
if (dst_run(dst_wrap_function(f), &ret)) {
dst_puts(dst_formatc("runtime error: %v\n", ret));
} else {
dst_puts(dst_formatc("%v\n", ret));
}
} else {
dst_puts(dst_formatc("compile error at %d: %S\n",
cres.error_start + 1, cres.error));
}
b.count = 0;
}
break;
if (!reader || *reader == '\0') {
printf_flags(flags, "33", "> %s", "");
if (buffer)
free(buffer);
buffer = dst_getline();
if (!buffer || *buffer == '\0')
return 0;
reader = buffer;
}
reader += dst_parse_cstring(&p, reader);
}
/* Check if file read in correctly */
if (p.error) {
printf_flags(flags, "31", "parse error: %s\n", p.error);
buffer = reader = NULL;
continue;
}
/* Check that parser is complete */
if (p.status != DST_PARSER_FULL && p.status != DST_PARSER_ROOT) {
printf_flags(flags, "31", "parse error: unexpected end of source%s\n", "");
continue;
}
dst_env_putc(vm, vm->env, "_", vm->ret);
dst_env_putc(vm, vm->env, "-env-", dst_wrap_table(vm->env));
if (!debug_compile_and_run(vm, dst_parse_consume(&p), flags)) {
printf_flags(flags, "36", "%s\n", (const char *) dst_description(vm, vm->ret));
}
done:
dst_buffer_deinit(&b);
return 0;
}
/* Run file */
static void runfile(const uint8_t *src, int32_t len) {
DstCompileOptions opts;
DstCompileResult cres;
DstParseResult res;
const uint8_t *s = src;
const uint8_t *end = src + len;
while (s < end) {
res = dst_parse(s, end - s);
switch (res.status) {
case DST_PARSE_NODATA:
return;
case DST_PARSE_UNEXPECTED_EOS:
case DST_PARSE_ERROR:
dst_puts(dst_formatc("syntax error at %d: %S\n",
s - src + res.bytes_read + 1, res.error));
break;
case DST_PARSE_OK:
{
opts.source = res.value;
opts.flags = 0;
opts.sourcemap = res.map;
opts.env = env;
cres = dst_compile(opts);
if (cres.status == DST_COMPILE_OK) {
DstValue ret = dst_wrap_nil();
DstFunction *f = dst_compile_func(cres);
if (dst_run(dst_wrap_function(f), &ret)) {
dst_puts(dst_formatc("runtime error: %v\n", ret));
} else {
dst_puts(dst_formatc("runtime error: %v\n", ret));
break;
}
} else {
dst_puts(dst_formatc("compile error at %d: %S\n",
s - src + cres.error_start + 1, cres.error));
}
}
break;
}
s += res.bytes_read;
}
}
int main(int argc, const char **argv) {
Dst vm;
int main(int argc, char **argv) {
int status = -1;
int i;
int fileRead = 0;
uint32_t memoryInterval = 4096;
uint32_t gcinterval = 8192;
uint64_t flags = 0;
/* Read the arguments. Ignore files. */
@ -231,22 +194,15 @@ int main(int argc, const char **argv) {
flags |= DST_CLIENT_VERBOSE;
} else if (client_strequal(arg + 2, "repl")) {
flags |= DST_CLIENT_REPL;
} else if (client_strequal(arg + 2, "nocolor")) {
flags |= DST_CLIENT_NOCOLOR;
} else if (client_strequal_witharg(arg + 2, "memchunk")) {
int64_t val = memoryInterval;
const uint8_t *end = (const uint8_t *)(arg + 2);
} else if (client_strequal_witharg(arg + 2, "gcinterval")) {
int status = 0;
int32_t m;
const uint8_t *start = (const uint8_t *)(arg + 13);
const uint8_t *end = start;
while (*end) ++end;
int status = dst_read_integer((const uint8_t *)arg + 11, end, &val);
if (status) {
if (val > 0xFFFFFFFF) {
memoryInterval = 0xFFFFFFFF;
} else if (val < 0) {
memoryInterval = 0;
} else {
memoryInterval = val;
}
}
m = dst_scan_integer(start, end - start, &status);
if (!status)
gcinterval = m;
} else {
flags |= DST_CLIENT_UNKNOWN;
}
@ -267,9 +223,6 @@ int main(int argc, const char **argv) {
case 'r':
flags |= DST_CLIENT_REPL;
break;
case 'c':
flags |= DST_CLIENT_NOCOLOR;
break;
default:
flags |= DST_CLIENT_UNKNOWN;
break;
@ -284,14 +237,13 @@ int main(int argc, const char **argv) {
printf( "Usage:\n"
"%s -opts --fullopt1 --fullopt2 file1 file2...\n"
"\n"
" -h --help : Shows this information.\n"
" -V --verbose : Show more output.\n"
" -r --repl : Launch a repl after all files are processed.\n"
" -c --nocolor : Don't use VT100 color codes in the repl.\n"
" -v --version : Print the version number and exit.\n"
" --memchunk=[int] : Set the amount of memory to allocate before\n"
" forcing a collection in bytes. Max is 2^32-1,\n"
" min is 0.\n\n",
" -h --help Shows this information.\n"
" -V --verbose Show more output.\n"
" -r --repl Launch a repl after all files are processed.\n"
" -v --version Print the version number and exit.\n"
" --gcinterval=[int] Set the amount of memory to allocate before\n"
" forcing a collection in bytes. Max is 2^31-1,\n"
" min is 0.\n\n",
argv[0]);
return 0;
}
@ -301,26 +253,31 @@ int main(int argc, const char **argv) {
}
/* Set up VM */
dst_init(&vm);
vm.memoryInterval = memoryInterval;
dst_stl_load(&vm);
dst_init();
dst_vm_gc_interval = gcinterval;
env = dst_loadstl(DST_LOAD_ROOT);
/* Read the arguments. Only process files. */
for (i = 1; i < argc; ++i) {
const char *arg = argv[i];
if (*arg != '-') {
FILE *f;
f = fopen(arg, "rb");
fileRead = 1;
status = debug_run(&vm, f, flags);
int32_t len;
const uint8_t *s = loadsource(arg, &len);
if (NULL == s) {
printf("could not load file %s\n", arg);
} else {
runfile(s, len);
}
}
}
/* Run a repl if nothing else happened, or the flag is set */
if (!fileRead || (flags & DST_CLIENT_REPL)) {
status = debug_repl(&vm, flags);
status = repl();
}
dst_deinit(&vm);
dst_deinit();
return status;
}

103
core/asm.c
View File

@ -25,6 +25,7 @@
#include <dst/dst.h>
#include "opcodes.h"
#include "gc.h"
#include "sourcemap.h"
/* Bytecode op argument types */
@ -139,7 +140,6 @@ static const DstInstructionDef dst_ops[] = {
{"load-integer", DIT_SI, DOP_LOAD_INTEGER},
{"load-nil", DIT_S, DOP_LOAD_NIL},
{"load-self", DIT_S, DOP_LOAD_SELF},
{"load-syscall", DIT_SU, DOP_LOAD_SYSCALL},
{"load-true", DIT_S, DOP_LOAD_TRUE},
{"load-upvalue", DIT_SES, DOP_LOAD_UPVALUE},
{"move-far", DIT_SS, DOP_MOVE_FAR},
@ -164,8 +164,7 @@ static const DstInstructionDef dst_ops[] = {
{"shift-right-immediate", DIT_SSI, DOP_SHIFT_RIGHT_IMMEDIATE},
{"shift-right-unsigned", DIT_SSS, DOP_SHIFT_RIGHT_UNSIGNED},
{"shift-right-unsigned-immediate", DIT_SSS, DOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE},
{"subtract", DIT_SSS, 0x1F},
{"syscall", DIT_SU, DOP_SYSCALL},
{"subtract", DIT_SSS, DOP_SUBTRACT},
{"tailcall", DIT_S, DOP_TAILCALL},
{"transfer", DIT_SSS, DOP_TRANSFER},
{"typecheck", DIT_ST, DOP_TYPECHECK},
@ -376,38 +375,38 @@ static uint32_t read_instruction(
{
if (dst_tuple_length(argt) != 2)
dst_asm_error(a, map, "expected 1 argument: (op, slot)");
instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 3, 0, argt[1]);
instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 3, 0, argt[1]);
break;
}
case DIT_L:
{
if (dst_tuple_length(argt) != 2)
dst_asm_error(a, map, "expected 1 argument: (op, label)");
instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_LABEL, 1, 3, 1, argt[1]);
instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_LABEL, 1, 3, 1, argt[1]);
break;
}
case DIT_SS:
{
if (dst_tuple_length(argt) != 3)
dst_asm_error(a, map, "expected 2 arguments: (op, slot, slot)");
instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_SLOT, 2, 2, 0, argt[2]);
instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_SLOT, 2, 2, 0, argt[2]);
break;
}
case DIT_SL:
{
if (dst_tuple_length(argt) != 3)
dst_asm_error(a, map, "expected 2 arguments: (op, slot, label)");
instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_LABEL, 2, 2, 1, argt[2]);
instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_LABEL, 2, 2, 1, argt[2]);
break;
}
case DIT_ST:
{
if (dst_tuple_length(argt) != 3)
dst_asm_error(a, map, "expected 2 arguments: (op, slot, type)");
instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_TYPE, 2, 2, 0, argt[2]);
instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_TYPE, 2, 2, 0, argt[2]);
break;
}
case DIT_SI:
@ -415,17 +414,17 @@ static uint32_t read_instruction(
{
if (dst_tuple_length(argt) != 3)
dst_asm_error(a, map, "expected 2 arguments: (op, slot, integer)");
instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_INTEGER, 2, 2, idef->type == DIT_SI, argt[2]);
instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_INTEGER, 2, 2, idef->type == DIT_SI, argt[2]);
break;
}
case DIT_SSS:
{
if (dst_tuple_length(argt) != 4)
dst_asm_error(a, map, "expected 3 arguments: (op, slot, slot, slot)");
instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_SLOT, 2, 1, 0, argt[2]);
instr |= doarg(a, dst_parse_submap_index(map, 3), DST_OAT_SLOT, 3, 1, 0, argt[3]);
instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_SLOT, 2, 1, 0, argt[2]);
instr |= doarg(a, dst_sourcemap_index(map, 3), DST_OAT_SLOT, 3, 1, 0, argt[3]);
break;
}
case DIT_SSI:
@ -433,9 +432,9 @@ static uint32_t read_instruction(
{
if (dst_tuple_length(argt) != 4)
dst_asm_error(a, map, "expected 3 arguments: (op, slot, slot, integer)");
instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_SLOT, 2, 1, 0, argt[2]);
instr |= doarg(a, dst_parse_submap_index(map, 3), DST_OAT_INTEGER, 3, 1, idef->type == DIT_SSI, argt[3]);
instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_SLOT, 2, 1, 0, argt[2]);
instr |= doarg(a, dst_sourcemap_index(map, 3), DST_OAT_INTEGER, 3, 1, idef->type == DIT_SSI, argt[3]);
break;
}
case DIT_SES:
@ -444,23 +443,23 @@ static uint32_t read_instruction(
uint32_t env;
if (dst_tuple_length(argt) != 4)
dst_asm_error(a, map, "expected 3 arguments: (op, slot, environment, envslot)");
instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
env = doarg(a, dst_parse_submap_index(map, 2), DST_OAT_ENVIRONMENT, 0, 1, 0, argt[2]);
instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
env = doarg(a, dst_sourcemap_index(map, 2), DST_OAT_ENVIRONMENT, 0, 1, 0, argt[2]);
instr |= env << 16;
for (env += 1; env > 0; env--) {
b = b->parent;
if (NULL == b)
dst_asm_error(a, dst_parse_submap_index(map, 2), "invalid environment index");
dst_asm_error(a, dst_sourcemap_index(map, 2), "invalid environment index");
}
instr |= doarg(b, dst_parse_submap_index(map, 3), DST_OAT_SLOT, 3, 1, 0, argt[3]);
instr |= doarg(b, dst_sourcemap_index(map, 3), DST_OAT_SLOT, 3, 1, 0, argt[3]);
break;
}
case DIT_SC:
{
if (dst_tuple_length(argt) != 3)
dst_asm_error(a, map, "expected 2 arguments: (op, slot, constant)");
instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_CONSTANT, 2, 2, 0, argt[2]);
instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_CONSTANT, 2, 2, 0, argt[2]);
break;
}
}
@ -585,15 +584,15 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
x = dst_struct_get(st, dst_csymbolv("slots"));
if (dst_seq_view(x, &arr, &count)) {
const DstValue *slotmap =
dst_parse_submap_value(opts.sourcemap, dst_csymbolv("slots"));
dst_sourcemap_value(opts.sourcemap, dst_csymbolv("slots"));
for (i = 0; i < count; i++) {
const DstValue *imap = dst_parse_submap_index(slotmap, i);
const DstValue *imap = dst_sourcemap_index(slotmap, i);
DstValue v = arr[i];
if (dst_checktype(v, DST_TUPLE)) {
const DstValue *t = dst_unwrap_tuple(v);
int32_t j;
for (j = 0; j < dst_tuple_length(t); j++) {
const DstValue *tjmap = dst_parse_submap_index(imap, j);
const DstValue *tjmap = dst_sourcemap_index(imap, j);
if (!dst_checktype(t[j], DST_SYMBOL))
dst_asm_error(&a, tjmap, "slot names must be symbols");
dst_table_put(&a.slots, t[j], dst_wrap_integer(i));
@ -610,9 +609,9 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
x = dst_struct_get(st, dst_csymbolv("captures"));
if (dst_seq_view(x, &arr, &count)) {
const DstValue *emap =
dst_parse_submap_value(opts.sourcemap, dst_csymbolv("captures"));
dst_sourcemap_value(opts.sourcemap, dst_csymbolv("captures"));
for (i = 0; i < count; i++) {
const DstValue *imap = dst_parse_submap_index(emap, i);
const DstValue *imap = dst_sourcemap_index(emap, i);
dst_asm_assert(&a, dst_checktype(arr[i], DST_SYMBOL), imap, "environment must be a symbol");
if (dst_asm_addenv(&a, arr[i]) < 0) {
dst_asm_error(&a, imap, "environment not found");
@ -624,14 +623,14 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
x = dst_struct_get(st, dst_csymbolv("constants"));
if (dst_seq_view(x, &arr, &count)) {
const DstValue *cmap =
dst_parse_submap_value(opts.sourcemap, dst_csymbolv("constants"));
dst_sourcemap_value(opts.sourcemap, dst_csymbolv("constants"));
def->constants_length = count;
def->constants = malloc(sizeof(DstValue) * count);
if (NULL == def->constants) {
DST_OUT_OF_MEMORY;
}
for (i = 0; i < count; i++) {
const DstValue *imap = dst_parse_submap_index(cmap, i);
const DstValue *imap = dst_sourcemap_index(cmap, i);
DstValue ct = arr[i];
if (dst_checktype(ct, DST_TUPLE) &&
dst_tuple_length(dst_unwrap_tuple(ct)) > 1 &&
@ -663,11 +662,11 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
x = dst_struct_get(st, dst_csymbolv("bytecode"));
if (dst_seq_view(x, &arr, &count)) {
const DstValue *bmap =
dst_parse_submap_value(opts.sourcemap, dst_csymbolv("bytecode"));
dst_sourcemap_value(opts.sourcemap, dst_csymbolv("bytecode"));
/* Do labels and find length */
int32_t blength = 0;
for (i = 0; i < count; ++i) {
const DstValue *imap = dst_parse_submap_index(bmap, i);
const DstValue *imap = dst_sourcemap_index(bmap, i);
DstValue instr = arr[i];
if (dst_checktype(instr, DST_SYMBOL)) {
dst_table_put(&a.labels, instr, dst_wrap_integer(blength));
@ -685,7 +684,7 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
}
/* Do bytecode */
for (i = 0; i < count; ++i) {
const DstValue *imap = dst_parse_submap_index(bmap, i);
const DstValue *imap = dst_sourcemap_index(bmap, i);
DstValue instr = arr[i];
if (dst_checktype(instr, DST_SYMBOL)) {
continue;
@ -716,7 +715,7 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
x = dst_struct_get(st, dst_csymbolv("sourcemap"));
if (dst_seq_view(x, &arr, &count)) {
const DstValue *bmap =
dst_parse_submap_value(opts.sourcemap, dst_csymbolv("sourcemap"));
dst_sourcemap_value(opts.sourcemap, dst_csymbolv("sourcemap"));
dst_asm_assert(&a, count != 2 * def->bytecode_length, bmap, "sourcemap must have twice the length of the bytecode");
def->sourcemap = malloc(sizeof(int32_t) * 2 * count);
for (i = 0; i < count; i += 2) {
@ -724,12 +723,12 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
DstValue end = arr[i + 1];
if (!(dst_checktype(start, DST_INTEGER) ||
dst_unwrap_integer(start) < 0)) {
const DstValue *submap = dst_parse_submap_index(bmap, i);
const DstValue *submap = dst_sourcemap_index(bmap, i);
dst_asm_error(&a, submap, "expected positive integer");
}
if (!(dst_checktype(end, DST_INTEGER) ||
dst_unwrap_integer(end) < 0)) {
const DstValue *submap = dst_parse_submap_index(bmap, i + 1);
const DstValue *submap = dst_sourcemap_index(bmap, i + 1);
dst_asm_error(&a, submap, "expected positive integer");
}
def->sourcemap[i] = dst_unwrap_integer(start);
@ -853,11 +852,11 @@ static DstValue dst_asm_decode_instruction(uint32_t instr) {
DstValue dst_disasm(DstFuncDef *def) {
int32_t i;
DstArray *bcode = dst_array(def->bytecode_length);
DstArray *constants = dst_array(def->constants_length);
DstArray *constants;
DstTable *ret = dst_table(10);
dst_table_put(ret, dst_csymbolv("arity"), dst_wrap_integer(def->arity));
if (def->arity)
dst_table_put(ret, dst_csymbolv("arity"), dst_wrap_integer(def->arity));
dst_table_put(ret, dst_csymbolv("bytecode"), dst_wrap_array(bcode));
dst_table_put(ret, dst_csymbolv("constants"), dst_wrap_array(constants));
if (def->sourcepath) {
dst_table_put(ret, dst_csymbolv("sourcepath"), dst_wrap_string(def->sourcepath));
}
@ -869,17 +868,21 @@ DstValue dst_disasm(DstFuncDef *def) {
}
/* Add constants */
for (i = 0; i < def->constants_length; i++) {
DstValue src = def->constants[i];
DstValue dest;
if (dst_checktype(src, DST_TUPLE)) {
dest = tup2(dst_csymbolv("quote"), src);
} else {
dest = src;
if (def->constants_length > 0) {
constants = dst_array(def->constants_length);
dst_table_put(ret, dst_csymbolv("constants"), dst_wrap_array(constants));
for (i = 0; i < def->constants_length; i++) {
DstValue src = def->constants[i];
DstValue dest;
if (dst_checktype(src, DST_TUPLE)) {
dest = tup2(dst_csymbolv("quote"), src);
} else {
dest = src;
}
constants->data[i] = dest;
}
constants->data[i] = dest;
constants->count = def->constants_length;
}
constants->count = def->constants_length;
/* Add bytecode */
for (i = 0; i < def->bytecode_length; i++) {

510
core/compile.c
View File

@ -21,21 +21,27 @@
*/
#include <dst/dst.h>
#include <dst/dststl.h>
#include "compile.h"
#include "gc.h"
#include "sourcemap.h"
/* Lazily sort the optimizers */
/*static int optimizers_sorted = 0;*/
/* Lookups for specials and optimizable c functions. */
/*DstCFunctionOptimizer dst_compiler_optimizers[255];*/
/*DstSpecial dst_compiler_specials[16];*/
/* Throw an error with a dst string */
void dst_compile_error(DstCompiler *c, const DstValue *sourcemap, const uint8_t *m) {
c->results.error_start = dst_unwrap_integer(sourcemap[0]);
c->results.error_end = dst_unwrap_integer(sourcemap[1]);
c->results.error = m;
if (NULL != sourcemap) {
c->result.error_start = dst_unwrap_integer(sourcemap[0]);
c->result.error_end = dst_unwrap_integer(sourcemap[1]);
} else {
c->result.error_start = -1;
c->result.error_end = -1;
}
c->result.error = m;
longjmp(c->on_error, 1);
}
@ -47,20 +53,22 @@ void dst_compile_cerror(DstCompiler *c, const DstValue *sourcemap, const char *m
/* Use these to get sub options. They will traverse the source map so
* compiler errors make sense. Then modify the returned options. */
DstFormOptions dst_compile_getopts_index(DstFormOptions opts, int32_t index) {
const DstValue *sourcemap = dst_parse_submap_index(opts.sourcemap, index);
const DstValue *sourcemap = dst_sourcemap_index(opts.sourcemap, index);
DstValue nextval = dst_getindex(opts.x, index);
opts.x = nextval;
opts.sourcemap = sourcemap;
return opts;
}
DstFormOptions dst_compile_getopts_key(DstFormOptions opts, DstValue key) {
const DstValue *sourcemap = dst_parse_submap_key(opts.sourcemap, key);
const DstValue *sourcemap = dst_sourcemap_key(opts.sourcemap, key);
opts.x = key;
opts.sourcemap = sourcemap;
return opts;
}
DstFormOptions dst_compile_getopts_value(DstFormOptions opts, DstValue key) {
const DstValue *sourcemap = dst_parse_submap_value(opts.sourcemap, key);
const DstValue *sourcemap = dst_sourcemap_value(opts.sourcemap, key);
DstValue nextval = dst_get(opts.x, key);
opts.x = nextval;
opts.sourcemap = sourcemap;
@ -163,6 +171,12 @@ static void slotsym(DstScope *scope, const uint8_t *sym, DstSlot s) {
static int32_t addconst(DstCompiler *c, const DstValue *sourcemap, DstValue x) {
DstScope *scope = dst_compile_topscope(c);
int32_t i, index, newcount;
/* Get the topmost function scope */
while (scope > c->scopes) {
if (scope->flags & DST_SCOPE_FUNCTION)
break;
scope--;
}
for (i = 0; i < scope->ccount; i++) {
if (dst_equals(x, scope->consts[i]))
return i;
@ -185,7 +199,7 @@ static int32_t addconst(DstCompiler *c, const DstValue *sourcemap, DstValue x) {
}
/* Enter a new scope */
void dst_compile_scope(DstCompiler *c, int newfn) {
void dst_compile_scope(DstCompiler *c, int flags) {
int32_t newcount, oldcount;
DstScope *scope;
oldcount = c->scopecount;
@ -222,7 +236,7 @@ void dst_compile_scope(DstCompiler *c, int newfn) {
scope->scap = 0;
scope->smax = -1;
scope->flags = newfn ? DST_SCOPE_FUNCTION : 0;
scope->flags = flags;
}
/* Leave a scope. */
@ -302,7 +316,7 @@ DstSlot dst_compile_resolve(
DstValue ref = dst_get(check, dst_csymbolv("ref"));
if (dst_checktype(ref, DST_ARRAY)) {
DstSlot ret = dst_compile_constantslot(ref);
ret.flags |= DST_SLOT_REF;
ret.flags |= DST_SLOT_REF | DST_SLOT_NAMED | DST_SLOT_MUTABLE;
return ret;
} else {
DstValue value = dst_get(check, dst_csymbolv("value"));
@ -393,6 +407,16 @@ void dst_compile_emit(DstCompiler *c, const DstValue *sourcemap, uint32_t instr)
c->buffer[index] = instr;
}
/* Helper */
static int32_t slotalloc_temp(DstScope *scope, int32_t max, int32_t nth) {
int32_t ret = slotalloc_index(scope);
if (ret > max) {
slotfree_index(scope, ret);
ret = 0xF0 + nth;
}
return ret;
}
/* Realize any slot to a local slot. Call this to get a slot index
* that can be used in an instruction. */
static int32_t dst_compile_preread(
@ -410,11 +434,7 @@ static int32_t dst_compile_preread(
if (s.flags & DST_SLOT_CONSTANT) {
int32_t cindex;
ret = slotalloc_index(scope);
if (ret > max) {
slotfree_index(scope, ret);
ret = 0xF0 + nth;
}
ret = slotalloc_temp(scope, max, nth);
/* Use instructions for loading certain constants */
switch (dst_type(s.constant)) {
case DST_NIL:
@ -454,28 +474,18 @@ static int32_t dst_compile_preread(
DOP_GET_INDEX);
}
} else if (s.envindex > 0 || s.index > max) {
/* Get a local slot to shadow the environment or far slot */
ret = slotalloc_index(scope);
if (ret > max) {
slotfree_index(scope, ret);
ret = 0xF0 + nth;
}
/* Move the remote slot into the local space */
if (s.envindex > 0) {
/* Load the higher slot */
dst_compile_emit(c, sourcemap,
((uint32_t)(s.index) << 24) |
((uint32_t)(s.envindex) << 16) |
((uint32_t)(ret) << 8) |
DOP_LOAD_UPVALUE);
} else {
/* Slot is a far slot: greater than 0xFF. Get
* the far data and bring it to the near slot. */
dst_compile_emit(c, sourcemap,
((uint32_t)(s.index) << 16) |
((uint32_t)(ret) << 8) |
ret = slotalloc_temp(scope, max, nth);
dst_compile_emit(c, sourcemap,
((uint32_t)(s.index) << 24) |
((uint32_t)(s.envindex) << 16) |
((uint32_t)(ret) << 8) |
DOP_LOAD_UPVALUE);
} else if (s.index > max) {
ret = slotalloc_temp(scope, max, nth);
dst_compile_emit(c, sourcemap,
((uint32_t)(s.index) << 16) |
((uint32_t)(ret) << 8) |
DOP_MOVE_NEAR);
}
} else {
/* We have a normal slot that fits in the required bit width */
ret = s.index;
@ -492,96 +502,91 @@ static void dst_compile_postread(DstCompiler *c, DstSlot s, int32_t index) {
}
}
/* Get a write slot index to emit an instruction. */
static int32_t dst_compile_prewrite(
/* Move values from one slot to another. The destination must be mutable. */
static void dst_compile_copy(
DstCompiler *c,
const DstValue *sourcemap,
int32_t nth,
DstSlot s) {
int32_t ret = 0;
if (s.flags & DST_SLOT_CONSTANT) {
if (!(s.flags & DST_SLOT_REF)) {
dst_compile_cerror(c, sourcemap, "cannot write to constant");
}
} else if (s.envindex > 0 || s.index > 0xFF) {
DstScope *scope = dst_compile_topscope(c);
/* Get a local slot to shadow the environment or far slot */
ret = slotalloc_index(scope);
if (ret > 0xFF) {
slotfree_index(scope, ret);
ret = 0xF0 + nth;
}
/* Move the remote slot into the local space */
if (s.envindex > 0) {
/* Load the higher slot */
dst_compile_emit(c, sourcemap,
((uint32_t)(s.index) << 24) |
((uint32_t)(s.envindex) << 16) |
((uint32_t)(ret) << 8) |
DOP_LOAD_UPVALUE);
DstSlot dest,
DstSlot src) {
int writeback = 0;
int32_t destlocal = -1;
int32_t srclocal = -1;
int32_t reflocal = -1;
DstScope *scope = dst_compile_topscope(c);
/* Only write to mutable slots */
if (!(dest.flags & DST_SLOT_MUTABLE)) {
dst_compile_cerror(c, sourcemap, "cannot write to constant");
}
/* Short circuit if dest and source are equal */
if (dest.flags == src.flags &&
dest.index == src.index &&
dest.envindex == src.envindex) {
if (dest.flags & DST_SLOT_REF) {
if (dst_equals(dest.constant, src.constant))
return;
} else {
/* Slot is a far slot: greater than 0xFF. Get
* the far data and bring it to the near slot. */
dst_compile_emit(c, sourcemap,
((uint32_t)(s.index) << 16) |
((uint32_t)(ret) << 8) |
DOP_MOVE_NEAR);
return;
}
} else {
/* We have a normal slot that fits in the required bit width */
ret = s.index;
}
return ret;
}
/* Release a write index after emitting the instruction */
static void dst_compile_postwrite(
DstCompiler *c,
const DstValue *sourcemap,
DstSlot s,
int32_t index) {
/* Process: src -> srclocal -> destlocal -> dest */
/* src -> srclocal */
srclocal = dst_compile_preread(c, sourcemap, 0xFF, 1, src);
/* Set the ref */
if (s.flags & DST_SLOT_REF) {
DstScope *scope = dst_compile_topscope(c);
int32_t cindex = addconst(c, sourcemap, s.constant);
int32_t refindex = slotalloc_index(scope);
if (refindex > 0xFF) {
slotfree_index(scope, refindex);
refindex = 0xFF;
}
dst_compile_emit(c, sourcemap,
(cindex << 16) |
(refindex << 8) |
DOP_LOAD_CONSTANT);
/* Pull down dest (find destlocal) */
if (dest.flags & DST_SLOT_REF) {
writeback = 1;
destlocal = srclocal;
reflocal = slotalloc_temp(scope, 0xFF, 2);
dst_compile_emit(c, sourcemap,
(index << 16) |
(refindex << 8) |
DOP_PUT_INDEX);
slotfree_index(scope, refindex);
return;
(addconst(c, sourcemap, dest.constant) << 16) |
(reflocal << 8) |
DOP_LOAD_CONSTANT);
} else if (dest.envindex > 0) {
writeback = 2;
destlocal = srclocal;
} else if (dest.index > 0xFF) {
writeback = 3;
destlocal = srclocal;
} else {
destlocal = dest.index;
}
/* We need to save the data in the local slot to the original slot */
if (s.envindex > 0) {
/* Load the higher slot */
/* srclocal -> destlocal */
if (srclocal != destlocal) {
dst_compile_emit(c, sourcemap,
((uint32_t)(srclocal) << 16) |
((uint32_t)(destlocal) << 8) |
DOP_MOVE_NEAR);
}
/* destlocal -> dest */
if (writeback == 1) {
dst_compile_emit(c, sourcemap,
(destlocal << 16) |
(reflocal << 8) |
DOP_PUT_INDEX);
} else if (writeback == 2) {
dst_compile_emit(c, sourcemap,
((uint32_t)(s.index) << 24) |
((uint32_t)(s.envindex) << 16) |
((uint32_t)(index) << 8) |
((uint32_t)(dest.index) << 24) |
((uint32_t)(dest.envindex) << 16) |
((uint32_t)(destlocal) << 8) |
DOP_SET_UPVALUE);
} else if (s.index != index) {
/* There was a local remapping */
dst_compile_emit(c, sourcemap,
((uint32_t)(s.index) << 16) |
((uint32_t)(index) << 8) |
} else if (writeback == 3) {
dst_compile_emit(c, sourcemap,
((uint32_t)(dest.index) << 16) |
((uint32_t)(destlocal) << 8) |
DOP_MOVE_FAR);
}
if (index != s.index || s.envindex > 0) {
/* We need to free the temporary slot */
DstScope *scope = dst_compile_topscope(c);
slotfree_index(scope, index);
/* Cleanup */
if (reflocal >= 0) {
slotfree_index(scope, reflocal);
}
dst_compile_postread(c, src, srclocal);
}
/* Generate the return instruction for a slot. */
@ -685,6 +690,201 @@ static void dst_compile_pushtuple(
}
}
/* Quote */
DstSlot dst_compile_quote(DstFormOptions opts, int32_t argn, const DstValue *argv) {
if (argn != 1)
dst_compile_cerror(opts.compiler, opts.sourcemap, "expected 1 argument");
return dst_compile_constantslot(argv[0]);
}
/* Var */
DstSlot dst_compile_var(DstFormOptions opts, int32_t argn, const DstValue *argv) {
DstScope *scope = dst_compile_topscope(opts.compiler);
DstFormOptions subopts;
DstSlot ret;
if (argn != 2)
dst_compile_cerror(opts.compiler, opts.sourcemap, "expected 2 arguments");
if (!dst_checktype(argv[0], DST_SYMBOL))
dst_compile_cerror(opts.compiler, opts.sourcemap, "expected symbol");
subopts = dst_compile_getopts_index(opts, 2);
subopts.flags &= ~DST_FOPTS_TAIL;
ret = dst_compile_value(subopts);
if (scope->flags & DST_SCOPE_TOP) {
DstCompiler *c = opts.compiler;
const DstValue *sm = opts.sourcemap;
DstSlot refslot, refarrayslot;
/* Global var, generate var */
DstTable *reftab = dst_table(1);
DstArray *ref = dst_array(1);
dst_array_push(ref, dst_wrap_nil());
dst_table_put(reftab, dst_csymbolv("ref"), dst_wrap_array(ref));
dst_put(opts.compiler->env, argv[0], dst_wrap_table(reftab));
refslot = dst_compile_constantslot(dst_wrap_array(ref));
refarrayslot = refslot;
refslot.flags |= DST_SLOT_REF | DST_SLOT_NAMED | DST_SLOT_MUTABLE;
/* Generate code to set ref */
int32_t refarrayindex = dst_compile_preread(c, sm, 0xFF, 1, refarrayslot);
int32_t retindex = dst_compile_preread(c, sm, 0xFF, 2, ret);
dst_compile_emit(c, sm,
(retindex << 16) |
(refarrayindex << 8) |
DOP_PUT_INDEX);
dst_compile_postread(c, refarrayslot, refarrayindex);
dst_compile_postread(c, ret, retindex);
dst_compile_freeslot(c, refarrayslot);
ret = refslot;
} else {
/* Non root scope, bring to local slot */
DstSlot localslot = dst_compile_gettarget(opts);
localslot.flags |= DST_SLOT_NAMED | DST_SLOT_MUTABLE;
dst_compile_copy(opts.compiler, opts.sourcemap, localslot, ret);
slotsym(scope, dst_unwrap_symbol(argv[0]), localslot);
ret = localslot;
}
return ret;
}
/* Varset */
DstSlot dst_compile_varset(DstFormOptions opts, int32_t argn, const DstValue *argv) {
DstFormOptions subopts;
DstSlot ret, dest;
if (argn != 2)
dst_compile_cerror(opts.compiler, opts.sourcemap, "expected 2 arguments");
if (!dst_checktype(argv[0], DST_SYMBOL))
dst_compile_cerror(opts.compiler, opts.sourcemap, "expected symbol");
subopts = dst_compile_getopts_index(opts, 2);
subopts.flags &= ~DST_FOPTS_TAIL;
dest = dst_compile_resolve(opts.compiler, opts.sourcemap, dst_unwrap_symbol(argv[0]));
if (!(dest.flags & DST_SLOT_MUTABLE)) {
dst_compile_cerror(opts.compiler, opts.sourcemap, "cannot set constant");
}
subopts.flags |= DST_FOPTS_HINT;
subopts.hint = dest;
ret = dst_compile_value(subopts);
return ret;
}
/* Def */
DstSlot dst_compile_def(DstFormOptions opts, int32_t argn, const DstValue *argv) {
DstScope *scope = dst_compile_topscope(opts.compiler);
DstFormOptions subopts;
DstSlot ret;
if (argn != 2)
dst_compile_cerror(opts.compiler, opts.sourcemap, "expected 2 arguments");
if (!dst_checktype(argv[0], DST_SYMBOL))
dst_compile_cerror(opts.compiler, opts.sourcemap, "expected symbol");
subopts = dst_compile_getopts_index(opts, 2);
subopts.flags &= ~DST_FOPTS_TAIL;
ret = dst_compile_value(subopts);
ret.flags |= DST_SLOT_NAMED;
if (scope->flags & DST_SCOPE_TOP) {
/* Global def, generate code to store in env when executed */
DstCompiler *c = opts.compiler;
const DstValue *sm = opts.sourcemap;
/* Root scope, add to def table */
DstSlot envslot = dst_compile_constantslot(c->env);
DstSlot nameslot = dst_compile_constantslot(argv[0]);
DstSlot valsymslot = dst_compile_constantslot(dst_csymbolv("value"));
DstSlot tableslot = dst_compile_constantslot(dst_wrap_cfunction(dst_stl_table));
/* Create env entry */
int32_t valsymindex = dst_compile_preread(c, sm, 0xFF, 1, valsymslot);
int32_t retindex = dst_compile_preread(c, sm, 0xFFFF, 2, ret);
dst_compile_emit(c, sm,
(retindex << 16) |
(valsymindex << 8) |
DOP_PUSH_2);
dst_compile_postread(c, ret, retindex);
dst_compile_postread(c, valsymslot, valsymindex);
dst_compile_freeslot(c, valsymslot);
int32_t tableindex = dst_compile_preread(opts.compiler, opts.sourcemap, 0xFF, 1, tableslot);
dst_compile_emit(c, sm,
(tableindex << 16) |
(tableindex << 8) |
DOP_CALL);
/* Add env entry to env */
int32_t nameindex = dst_compile_preread(opts.compiler, opts.sourcemap, 0xFF, 2, nameslot);
int32_t envindex = dst_compile_preread(opts.compiler, opts.sourcemap, 0xFF, 3, envslot);
dst_compile_emit(opts.compiler, opts.sourcemap,
(tableindex << 24) |
(nameindex << 16) |
(envindex << 8) |
DOP_PUT);
dst_compile_postread(opts.compiler, envslot, envindex);
dst_compile_postread(opts.compiler, nameslot, nameindex);
dst_compile_postread(c, tableslot, tableindex);
dst_compile_freeslot(c, tableslot);
dst_compile_freeslot(c, envslot);
dst_compile_freeslot(c, tableslot);
} else {
/* Non root scope, simple slot alias */
slotsym(scope, dst_unwrap_symbol(argv[0]), ret);
}
return ret;
}
/* Do */
DstSlot dst_compile_do(DstFormOptions opts, int32_t argn, const DstValue *argv) {
int32_t i;
DstSlot ret;
dst_compile_scope(opts.compiler, 0);
for (i = 0; i < argn; i++) {
DstFormOptions subopts = dst_compile_getopts_index(opts, i + 1);
subopts.x = argv[i];
if (i == argn - 1) {
subopts.flags |= DST_FOPTS_TAIL;
} else {
subopts.flags &= ~DST_FOPTS_TAIL;
}
ret = dst_compile_value(subopts);
if (i != argn - 1) {
dst_compile_freeslot(opts.compiler, ret);
}
}
dst_compile_popscope(opts.compiler);
return ret;
}
/* Keep in lexographic order */
static const DstSpecial dst_compiler_specials[] = {
{"def", dst_compile_def},
{"do", dst_compile_do},
{"quote", dst_compile_quote},
{"var", dst_compile_var},
{"varset", dst_compile_varset}
};
static int dst_strcompare(const uint8_t *str, const char *other) {
int32_t len = dst_string_length(str);
int32_t index;
for (index = 0; index < len; index++) {
uint8_t c = str[index];
uint8_t k = ((const uint8_t *)other)[index];
if (c < k) return -1;
if (c > k) return 1;
if (k == '\0') break;
}
return (other[index] == '\0') ? 0 : -1;
}
/* Find an instruction definition given its name */
static const DstSpecial *dst_finds(const uint8_t *key) {
const DstSpecial *low = dst_compiler_specials;
const DstSpecial *hi = dst_compiler_specials +
(sizeof(dst_compiler_specials) / sizeof(DstSpecial));
while (low < hi) {
const DstSpecial *mid = low + ((hi - low) / 2);
int comp = dst_strcompare(key, mid->name);
if (comp < 0) {
hi = mid;
} else if (comp > 0) {
low = mid + 1;
} else {
return mid;
}
}
return NULL;
}
/* Compile a tuplle */
DstSlot dst_compile_tuple(DstFormOptions opts) {
DstSlot head;
@ -698,18 +898,21 @@ DstSlot dst_compile_tuple(DstFormOptions opts) {
return dst_compile_constantslot(opts.x);
}
if (dst_checktype(tup[0], DST_SYMBOL)) {
/* Check specials */
} else {
const DstSpecial *s = dst_finds(dst_unwrap_symbol(tup[0]));
if (NULL != s) {
return s->compile(opts, dst_tuple_length(tup) - 1, tup + 1);
}
}
if (!headcompiled) {
head = dst_compile_value(subopts);
headcompiled = 1;
if ((head.flags & DST_SLOT_CONSTANT)) {
/*
if ((head.flags & DST_SLOT_CONSTANT)) {
if (dst_checktype(head.constant, DST_CFUNCTION)) {
/* Cfunction optimization */
printf("add cfunction optimization here...\n");
}
/* Could also later check for other optimizations here, such
* as function inlining and aot evaluation on pure functions. */
}
*/
}
/* Compile a normal function call */
{
@ -750,11 +953,7 @@ DstSlot dst_compile_value(DstFormOptions opts) {
case DST_SYMBOL:
{
const uint8_t *sym = dst_unwrap_symbol(opts.x);
if (dst_string_length(sym) > 0 && sym[0] != ':') {
ret = dst_compile_resolve(opts.compiler, opts.sourcemap, sym);
} else {
ret = dst_compile_constantslot(opts.x);
}
ret = dst_compile_resolve(opts.compiler, opts.sourcemap, sym);
break;
}
case DST_TUPLE:
@ -772,6 +971,9 @@ DstSlot dst_compile_value(DstFormOptions opts) {
}
if ((opts.flags & DST_FOPTS_TAIL) && !dst_compile_did_return(opts.compiler)) {
dst_compile_return(opts.compiler, opts.sourcemap, ret);
} else if (opts.flags & DST_FOPTS_HINT) {
dst_compile_copy(opts.compiler, opts.sourcemap, opts.hint, ret);
ret = opts.hint;
}
opts.compiler->recursion_guard++;
return ret;
@ -807,7 +1009,9 @@ static DstFuncDef *dst_compile_pop_funcdef(DstCompiler *c) {
if (NULL == def->constants) {
DST_OUT_OF_MEMORY;
}
memcpy(def->constants, scope->consts, def->constants_length * sizeof(DstValue));
memcpy(def->constants,
scope->consts,
def->constants_length * sizeof(DstValue));
}
/* Copy bytecode */
@ -817,7 +1021,9 @@ static DstFuncDef *dst_compile_pop_funcdef(DstCompiler *c) {
if (NULL == def->bytecode) {
DST_OUT_OF_MEMORY;
}
memcpy(def->bytecode, c->buffer + scope->bytecode_start, def->bytecode_length * sizeof(uint32_t));
memcpy(def->bytecode,
c->buffer + scope->bytecode_start,
def->bytecode_length * sizeof(uint32_t));
}
/* Copy source map over */
@ -826,7 +1032,9 @@ static DstFuncDef *dst_compile_pop_funcdef(DstCompiler *c) {
if (NULL == def->sourcemap) {
DST_OUT_OF_MEMORY;
}
memcpy(def->sourcemap, c->mapbuffer + 2 * scope->bytecode_start, def->bytecode_length * 2 * sizeof(int32_t));
memcpy(def->sourcemap,
c->mapbuffer + 2 * scope->bytecode_start,
def->bytecode_length * 2 * sizeof(int32_t));
}
/* Reset bytecode gen */
@ -847,31 +1055,8 @@ static DstFuncDef *dst_compile_pop_funcdef(DstCompiler *c) {
return def;
}
/* Merge an environment */
/* Load an environment */
void dst_compile_loadenv(DstCompiler *c, DstValue env) {
int32_t count, cap;
const DstValue *hmap;
DstValue defs = dst_get(env, dst_csymbolv("defs"));
/*DstValue vars = dst_get(env, dst_csymbol("vars"));*/
/* TODO - add global vars via single element arrays. */
if (dst_hashtable_view(defs, &hmap, &count, &cap)) {
DstScope *scope = dst_compile_topscope(c);
int32_t i;
for (i = 0; i < cap; i += 2) {
const uint8_t *sym;
if (!dst_checktype(hmap[i], DST_SYMBOL)) continue;
sym = dst_unwrap_symbol(hmap[i]);
slotsym(scope, sym, dst_compile_constantslot(hmap[i+1]));
}
}
}
/* Initialize a compiler */
static void dst_compile_init(DstCompiler *c) {
static void dst_compile_init(DstCompiler *c, DstValue env) {
c->scopecount = 0;
c->scopecap = 0;
c->scopes = NULL;
@ -880,8 +1065,9 @@ static void dst_compile_init(DstCompiler *c) {
c->buffer = NULL;
c->mapbuffer = NULL;
c->recursion_guard = DST_RECURSION_GUARD;
c->env = env;
/* Push an empty function scope. This will be the global scope. */
/* Push an empty scope. This will be the global scope. */
dst_compile_scope(c, 0);
dst_compile_topscope(c)->flags |= DST_SCOPE_TOP;
@ -901,7 +1087,7 @@ static void dst_compile_deinit(DstCompiler *c) {
}
/* Compile a single form */
DstCompileResults dst_compile_one(DstCompiler *c, DstCompileOptions opts) {
DstCompileResult dst_compile_one(DstCompiler *c, DstCompileOptions opts) {
DstFormOptions fopts;
DstSlot s;
@ -910,13 +1096,13 @@ DstCompileResults dst_compile_one(DstCompiler *c, DstCompileOptions opts) {
dst_compile_popscope(c);
if (setjmp(c->on_error)) {
c->results.status = DST_COMPILE_ERROR;
c->results.funcdef = NULL;
return c->results;
c->result.status = DST_COMPILE_ERROR;
c->result.funcdef = NULL;
return c->result;
}
/* Push a function scope */
dst_compile_scope(c, 1);
dst_compile_scope(c, DST_SCOPE_FUNCTION | DST_SCOPE_TOP);
/* Set the global environment */
c->env = opts.env;
@ -930,18 +1116,18 @@ DstCompileResults dst_compile_one(DstCompiler *c, DstCompileOptions opts) {
/* Compile the value */
s = dst_compile_value(fopts);
c->results.funcdef = dst_compile_pop_funcdef(c);
c->results.status = DST_COMPILE_OK;
c->result.funcdef = dst_compile_pop_funcdef(c);
c->result.status = DST_COMPILE_OK;
return c->results;
return c->result;
}
/* Compile a form. */
DstCompileResults dst_compile(DstCompileOptions opts) {
DstCompileResult dst_compile(DstCompileOptions opts) {
DstCompiler c;
DstCompileResults res;
DstCompileResult res;
dst_compile_init(&c);
dst_compile_init(&c, opts.env);
res = dst_compile_one(&c, opts);
@ -950,7 +1136,7 @@ DstCompileResults dst_compile(DstCompileOptions opts) {
return res;
}
DstFunction *dst_compile_func(DstCompileResults res) {
DstFunction *dst_compile_func(DstCompileResult res) {
if (res.status != DST_COMPILE_OK) {
return NULL;
}

23
core/compile.h
View File

@ -67,10 +67,8 @@ struct DstSlot {
*/
#define DST_SCOPE_FUNCTION 1
#define DST_SCOPE_LASTSLOT 2
#define DST_SCOPE_FIRSTSLOT 4
#define DST_SCOPE_ENV 8
#define DST_SCOPE_TOP 16
#define DST_SCOPE_ENV 2
#define DST_SCOPE_TOP 4
/* A lexical scope during compilation */
struct DstScope {
@ -101,7 +99,7 @@ struct DstScope {
int32_t envcap;
int32_t bytecode_start;
uint32_t flags;
int flags;
};
#define dst_compile_topscope(c) ((c)->scopes + (c)->scopecount - 1)
@ -122,7 +120,7 @@ struct DstCompiler {
/* Hold the environment */
DstValue env;
DstCompileResults results;
DstCompileResult result;
};
#define DST_FOPTS_TAIL 0x10000
@ -152,22 +150,9 @@ typedef struct DstSpecial {
/* An array of optimizers sorted by key */
extern DstCFunctionOptimizer dst_compiler_optimizers[255];
/* An array of special forms */
extern DstSpecial dst_compiler_specials[16];
/* Dispatch to correct form compiler */
DstSlot dst_compile_value(DstFormOptions opts);
/* Compile special forms */
DstSlot dst_compile_do(DstFormOptions opts, int32_t argn, const DstValue *argv);
DstSlot dst_compile_fn(DstFormOptions opts, int32_t argn, const DstValue *argv);
DstSlot dst_compile_cond(DstFormOptions opts, int32_t argn, const DstValue *argv);
DstSlot dst_compile_while(DstFormOptions opts, int32_t argn, const DstValue *argv);
DstSlot dst_compile_quote(DstFormOptions opts, int32_t argn, const DstValue *argv);
DstSlot dst_compile_def(DstFormOptions opts, int32_t argn, const DstValue *argv);
DstSlot dst_compile_var(DstFormOptions opts, int32_t argn, const DstValue *argv);
DstSlot dst_compile_varset(DstFormOptions opts, int32_t argn, const DstValue *argv);
/****************************************************/
void dst_compile_error(DstCompiler *c, const DstValue *sourcemap, const uint8_t *m);

3
core/fiber.c
View File

@ -47,7 +47,6 @@ DstFiber *dst_fiber_reset(DstFiber *fiber) {
fiber->stacktop = DST_FRAME_SIZE;
fiber->status = DST_FIBER_DEAD;
fiber->parent = NULL;
fiber->ret = dst_wrap_nil();
return fiber;
}
@ -233,7 +232,7 @@ void dst_fiber_cframe(DstFiber *fiber) {
/* Create a cframe for a tail call */
void dst_fiber_cframe_tail(DstFiber *fiber) {
int32_t size = (fiber->stacktop - fiber->frametop) - DST_FRAME_SIZE;
int32_t nextframetop = fiber->frame + size;;
int32_t nextframetop = fiber->frame + size;
int32_t nextstacktop = nextframetop + DST_FRAME_SIZE;
if (fiber->frame == 0) {

18
core/gc.c
View File

@ -26,7 +26,7 @@
/* GC State */
void *dst_vm_blocks;
uint32_t dst_vm_memory_interval;
uint32_t dst_vm_gc_interval;
uint32_t dst_vm_next_collection;
/* Roots */
@ -333,6 +333,22 @@ int dst_gcunroot(DstValue root) {
return 0;
}
/* Remove a root value from the GC. This sets the effective reference count to 0. */
int dst_gcunrootall(DstValue root) {
DstValue *vtop = dst_vm_roots + dst_vm_root_count;
DstValue *v = dst_vm_roots;
int ret = 0;
/* Search from top to bottom as access is most likely LIFO */
for (v = dst_vm_roots; v < vtop; v++) {
if (dst_equals(root, *v)) {
*v = dst_vm_roots[--dst_vm_root_count];
vtop--;
ret = 1;
}
}
return ret;
}
/* Free all allocated memory */
void dst_clear_memory() {
DstGCMemoryHeader *current = dst_vm_blocks;

268
core/math.c Normal file
View File

@ -0,0 +1,268 @@
/*
* Copyright (c) 2017 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <math.h>
/* Convert a number to an integer */
int dst_int(int32_t argn, DstValue *argv, DstValue *ret) {
if (argn != 1) {
*ret = dst_cstringv("expected 1 argument");
return 1;
}
switch (dst_type(argv[0])) {
default:
*ret = dst_cstringv("could not convert to integer");
return 1;
case DST_REAL:
*ret = dst_wrap_integer((int32_t) dst_unwrap_real(argv[0]));
break;
case DST_INTEGER:
*ret = argv[0];
break;
}
return 0;
}
/* Convert a number to a real number */
int dst_real(int32_t argn, DstValue *argv, DstValue *ret) {
if (argn != 1) {
*ret = dst_cstringv("expected 1 argument");
return 1;
}
switch (dst_type(argv[0])) {
default:
*ret = dst_cstringv("could not convert to real");
return 1;
case DST_REAL:
*ret = argv[0];
break;
case DST_INTEGER:
*ret = dst_wrap_real((double) dst_unwrap_integer(argv[0]));
break;
}
return 0;
}
#define ADD(x, y) ((x) + (y))
#define SUB(x, y) ((x) - (y))
#define MUL(x, y) ((x) * (y))
#define MOD(x, y) ((x) % (y))
#define DIV(x, y) ((x) / (y))
#define DST_DEFINE_BINOP(name, op, rop, onerr)\
DstValue dst_op_##name(DstValue lhs, DstValue rhs) {\
if (!(dst_checktype(lhs, DST_INTEGER) || dst_checktype(lhs, DST_REAL))) onerr;\
if (!(dst_checktype(rhs, DST_INTEGER) || dst_checktype(rhs, DST_REAL))) onerr;\
return dst_checktype(lhs, DST_INTEGER)\
? (dst_checktype(rhs, DST_INTEGER)\
? dst_wrap_integer(op(dst_unwrap_integer(lhs), dst_unwrap_integer(rhs)))\
: dst_wrap_real(rop((double)dst_unwrap_integer(lhs), dst_unwrap_real(rhs))))\
: (dst_checktype(rhs, DST_INTEGER)\
? dst_wrap_real(rop(dst_unwrap_real(lhs), (double)dst_unwrap_integer(rhs)))\
: dst_wrap_real(rop(dst_unwrap_real(lhs), dst_unwrap_real(rhs))));\
}
DST_DEFINE_BINOP(add, ADD, ADD, return dst_wrap_nil())
DST_DEFINE_BINOP(subtract, SUB, SUB, return dst_wrap_nil())
DST_DEFINE_BINOP(multiply, MUL, MUL, return dst_wrap_nil())
#define DST_DEFINE_DIVIDER_OP(name, op, rop)\
DstValue dst_op_##name(DstValue lhs, DstValue rhs) {\
if (!(dst_checktype(lhs, DST_INTEGER) || dst_checktype(lhs, DST_REAL))) return dst_wrap_nil();\
if (!(dst_checktype(rhs, DST_INTEGER) || dst_checktype(rhs, DST_REAL))) return dst_wrap_nil();\
return dst_checktype(lhs, DST_INTEGER)\
? (dst_checktype(rhs, DST_INTEGER)\
? (dst_unwrap_integer(rhs) == 0 || ((dst_unwrap_integer(lhs) == INT32_MIN) && (dst_unwrap_integer(rhs) == -1)))\
? dst_wrap_nil()\
: dst_wrap_integer(op(dst_unwrap_integer(lhs), dst_unwrap_integer(rhs)))\
: dst_wrap_real(rop((double)dst_unwrap_integer(lhs), dst_unwrap_real(rhs))))\
: (dst_checktype(rhs, DST_INTEGER)\
? dst_wrap_real(rop(dst_unwrap_real(lhs), (double)dst_unwrap_integer(rhs)))\
: dst_wrap_real(rop(dst_unwrap_real(lhs), dst_unwrap_real(rhs))));\
}
DST_DEFINE_DIVIDER_OP(divide, DIV, DIV)
DST_DEFINE_DIVIDER_OP(modulo, MOD, fmod)
#define DST_DEFINE_REDUCER(name, fop, start)\
int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\
int32_t i;\
DstValue accum = dst_wrap_integer(start);\
for (i = 0; i < argn; i++) {\
accum = fop(accum, argv[i]);\
}\
if (dst_checktype(accum, DST_NIL)) {\
*ret = dst_cstringv("expected number");\
return 1;\
}\
*ret = accum;\
return 0;\
}
DST_DEFINE_REDUCER(add, dst_op_add, 0)
DST_DEFINE_REDUCER(subtract, dst_op_subtract, 0)
DST_DEFINE_REDUCER(multiply, dst_op_multiply, 1)
#define DST_DEFINE_DIVIDER(name)\
int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\
int32_t i;\
DstValue accum;\
if (argn < 1) {\
*ret = dst_cstringv("expected at least one argument");\
return 1;\
} else if (argn == 1) {\
accum = dst_wrap_real(1);\
i = 0;\
} else {\
accum = argv[0];\
i = 1;\
}\
for (; i < argn; i++) {\
accum = dst_op_##name(accum, argv[i]);\
}\
if (dst_checktype(accum, DST_NIL)) {\
*ret = dst_cstringv("expected number or division error");\
return 1;\
}\
*ret = accum;\
return 0;\
}
DST_DEFINE_DIVIDER(divide)
DST_DEFINE_DIVIDER(modulo)
#undef ADD
#undef SUB
#undef MUL
#undef MOD
#undef DST_DEFINE_BINOP
int dst_bnot(int32_t argn, DstValue *argv, DstValue *ret) {
if (argn != 1) {
*ret = dst_cstringv("expected 1 argument");
return 1;
}
if (!dst_checktype(argv[0], DST_INTEGER)) {
*ret = dst_cstringv("expected integer");
return 1;
}
*ret = dst_wrap_integer(~dst_unwrap_integer(argv[0]));
return 0;
}
#define DST_DEFINE_BITOP(name, op, start)\
int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\
int32_t i;\
int32_t accum = start;\
for (i = 0; i < argn; i++) {\
DstValue arg = argv[i];\
if (!dst_checktype(arg, DST_INTEGER)) {\
*ret = dst_cstringv("expected integer");\
return -1;\
}\
accum op dst_unwrap_integer(arg);\
}\
*ret = dst_wrap_integer(accum);\
return 0;\
}
DST_DEFINE_BITOP(band, &=, -1)
DST_DEFINE_BITOP(bor, |=, 0)
DST_DEFINE_BITOP(bxor, ^=, 0)
#define DST_DEFINE_MATHOP(name, fop)\
int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\
if (argn != 1) {\
*ret = dst_cstringv("expected 1 argument");\
return 1;\
}\
if (dst_checktype(argv[0], DST_INTEGER)) {\
argv[0] = dst_wrap_real(dst_unwrap_integer(argv[0]));\
}\
if (!dst_checktype(argv[0], DST_REAL)) {\
*ret = dst_cstringv("expected number");\
return 1;\
}\
*ret = dst_wrap_real(fop(dst_unwrap_real(argv[0])));\
return 0;\
}
DST_DEFINE_MATHOP(acos, acos)
DST_DEFINE_MATHOP(asin, asin)
DST_DEFINE_MATHOP(atan, atan)
DST_DEFINE_MATHOP(cos, cos)
DST_DEFINE_MATHOP(cosh, cosh)
DST_DEFINE_MATHOP(sin, sin)
DST_DEFINE_MATHOP(sinh, sinh)
DST_DEFINE_MATHOP(tan, tan)
DST_DEFINE_MATHOP(tanh, tanh)
DST_DEFINE_MATHOP(exp, exp)
DST_DEFINE_MATHOP(log, log)
DST_DEFINE_MATHOP(log10, log10)
DST_DEFINE_MATHOP(sqrt, sqrt)
DST_DEFINE_MATHOP(ceil, ceil)
DST_DEFINE_MATHOP(fabs, fabs)
DST_DEFINE_MATHOP(floor, floor)
#define DST_DEFINE_MATH2OP(name, fop)\
int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\
if (argn != 2) {\
*ret = dst_cstringv("expected 2 arguments");\
return 1;\
}\
if (dst_checktype(argv[0], DST_INTEGER))\
argv[0] = dst_wrap_real(dst_unwrap_integer(argv[0]));\
if (dst_checktype(argv[1], DST_INTEGER))\
argv[1] = dst_wrap_real(dst_unwrap_integer(argv[1]));\
if (!dst_checktype(argv[0], DST_REAL) || !dst_checktype(argv[1], DST_REAL)) {\
*ret = dst_cstringv("expected real");\
return 1;\
}\
*ret =\
dst_wrap_real(fop(dst_unwrap_real(argv[0]), dst_unwrap_real(argv[1])));\
return 0;\
}\
DST_DEFINE_MATH2OP(atan2, atan2)
DST_DEFINE_MATH2OP(pow, pow)
DST_DEFINE_MATH2OP(fmod, fmod)
int dst_modf(int32_t argn, DstValue *argv, DstValue *ret) {
double intpart;
DstValue *tup;
if (argn != 1) {
*ret = dst_cstringv("expected 1 argument");
return 1;
}
if (dst_checktype(argv[0], DST_INTEGER))
argv[0] = dst_wrap_real(dst_unwrap_integer(argv[0]));
if (!dst_checktype(argv[0], DST_REAL)) {
*ret = dst_cstringv("expected real");
return 1;
}
tup = dst_tuple_begin(2);
tup[0] = dst_wrap_real(modf(dst_unwrap_real(argv[0]), &intpart));
tup[1] = dst_wrap_real(intpart);
*ret = dst_wrap_tuple(dst_tuple_end(tup));
return 0;
}

2
core/opcodes.h
View File

@ -79,8 +79,6 @@ enum DstOpCode {
DOP_PUSH_ARRAY,
DOP_CALL,
DOP_TAILCALL,
DOP_SYSCALL,
DOP_LOAD_SYSCALL,
DOP_TRANSFER,
DOP_GET,
DOP_PUT,

113
core/parse.c
View File

@ -48,6 +48,7 @@ static int is_whitespace(uint8_t c) {
|| c == '\n'
|| c == '\r'
|| c == '\0'
|| c == ';'
|| c == ',';
}
@ -69,6 +70,7 @@ static int is_symbol_char_gen(uint8_t c) {
if (c >= '0' && c <= '9') return 1;
return (c == '!' ||
c == '$' ||
c == '%' ||
c == '&' ||
c == '*' ||
c == '+' ||
@ -89,9 +91,10 @@ static int is_symbol_char_gen(uint8_t c) {
The table contains 256 bits, where each bit is 1
if the corresponding ascci code is a symbol char, and 0
if not. */
if not. The upper characters are also considered symbol
chars and are then checked for utf-8 compliance. */
static uint32_t symchars[256] = {
0x00000000, 0x77ffec52, 0xd7ffffff, 0x57fffffe,
0x00000000, 0x77ffec72, 0xd7ffffff, 0x57fffffe,
0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff
};
@ -215,7 +218,13 @@ static const uint8_t *parse_recur(
}
/* Check for end of source */
if (src >= end) goto unexpected_eos;
if (src >= end) {
if (qcount || recur != DST_RECURSION_GUARD) {
goto unexpected_eos;
} else {
goto nodata;
}
}
/* Open mapping */
mapstart = src;
@ -248,7 +257,11 @@ static const uint8_t *parse_recur(
} else {
if (!valid_utf8(src, tokenend - src))
goto invalid_utf8;
ret = dst_symbolv(src, tokenend - src);
if (*src == ':') {
ret = dst_stringv(src + 1, tokenend - src - 1);
} else {
ret = dst_symbolv(src, tokenend - src);
}
}
}
src = tokenend;
@ -382,7 +395,11 @@ static const uint8_t *parse_recur(
}
case '}':
{
if (n & 1) goto struct_oddargs;
if (n & 1) {
if (istable)
goto table_oddargs;
goto struct_oddargs;
}
if (istable) {
DstTable *t = dst_table(n);
DstTable *subt = dst_table(n);
@ -419,12 +436,6 @@ static const uint8_t *parse_recur(
}
}
/* Quote the returned value qcount times */
while (qcount--) ret = quote(ret);
/* Push the result to the stack */
dst_array_push(&args->stack, ret);
/* Push source mapping */
if (dst_checktype(submapping, DST_NIL)) {
/* We just parsed an atom */
@ -439,11 +450,33 @@ static const uint8_t *parse_recur(
submapping));
}
/* Quote the returned value qcount times */
while (qcount--) {
int32_t start = mapstart - args->srcstart;
int32_t end = src - args->srcstart;
DstValue sourcemap = dst_array_pop(&args->mapstack);
DstValue* tup = dst_tuple_begin(2);
tup[0] = atom_map(start, end);
tup[1] = sourcemap;
ret = quote(ret);
dst_array_push(&args->mapstack, ds_map(
start,
end,
dst_wrap_tuple(dst_tuple_end(tup))));
}
/* Push the result to the stack */
dst_array_push(&args->stack, ret);
/* Return the new source position for further calls */
return src;
/* Errors below */
nodata:
args->status = DST_PARSE_NODATA;
return NULL;
unexpected_eos:
args->errmsg = "unexpected end of source";
args->status = DST_PARSE_UNEXPECTED_EOS;
@ -459,6 +492,11 @@ static const uint8_t *parse_recur(
args->status = DST_PARSE_ERROR;
return src;
table_oddargs:
args->errmsg = "table literal needs an even number of arguments";
args->status = DST_PARSE_ERROR;
return src;
struct_oddargs:
args->errmsg = "struct literal needs an even number of arguments";
args->status = DST_PARSE_ERROR;
@ -525,56 +563,3 @@ DstParseResult dst_parsec(const char *src) {
while (src[len]) ++len;
return dst_parse((const uint8_t *)src, len);
}
/* Get the sub source map by indexing a value. Used to traverse
* into arrays and tuples */
const DstValue *dst_parse_submap_index(const DstValue *map, int32_t index) {
if (NULL != map && dst_tuple_length(map) >= 3) {
const DstValue *seq;
int32_t len;
if (dst_seq_view(map[2], &seq, &len)) {
if (index >= 0 && index < len) {
if (dst_checktype(seq[index], DST_TUPLE)) {
const DstValue *ret = dst_unwrap_tuple(seq[index]);
if (dst_tuple_length(ret) >= 2 &&
dst_checktype(ret[0], DST_INTEGER) &&
dst_checktype(ret[1], DST_INTEGER)) {
return ret;
}
}
}
}
}
return NULL;
}
/* Traverse into tables and structs */
static const DstValue *dst_parse_submap_kv(const DstValue *map, DstValue key, int kv) {
if (NULL != map && dst_tuple_length(map) >= 3) {
DstValue kvpair = dst_get(map[2], key);
if (dst_checktype(kvpair, DST_TUPLE)) {
const DstValue *kvtup = dst_unwrap_tuple(kvpair);
if (dst_tuple_length(kvtup) >= 2) {
if (dst_checktype(kvtup[kv], DST_TUPLE)) {
const DstValue *ret = dst_unwrap_tuple(kvtup[kv]);
if (dst_tuple_length(ret) >= 2 &&
dst_checktype(ret[0], DST_INTEGER) &&
dst_checktype(ret[1], DST_INTEGER)) {
return ret;
}
}
}
}
}
return NULL;
}
/* Traverse into a key of a table or struct */
const DstValue *dst_parse_submap_key(const DstValue *map, DstValue key) {
return dst_parse_submap_kv(map, key, 0);
}
/* Traverse into a value of a table or struct */
const DstValue *dst_parse_submap_value(const DstValue *map, DstValue key) {
return dst_parse_submap_kv(map, key, 1);
}

77
core/sourcemap.c Normal file
View File

@ -0,0 +1,77 @@
/*
* Copyright (c) 2017 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include "sourcemap.h"
/* Get the sub source map by indexing a value. Used to traverse
* into arrays and tuples */
const DstValue *dst_sourcemap_index(const DstValue *map, int32_t index) {
if (NULL != map && dst_tuple_length(map) >= 3) {
const DstValue *seq;
int32_t len;
if (dst_seq_view(map[2], &seq, &len)) {
if (index >= 0 && index < len) {
if (dst_checktype(seq[index], DST_TUPLE)) {
const DstValue *ret = dst_unwrap_tuple(seq[index]);
if (dst_tuple_length(ret) >= 2 &&
dst_checktype(ret[0], DST_INTEGER) &&
dst_checktype(ret[1], DST_INTEGER)) {
return ret;
}
}
}
}
}
return NULL;
}
/* Traverse into tables and structs */
static const DstValue *dst_sourcemap_kv(const DstValue *map, DstValue key, int kv) {
if (NULL != map && dst_tuple_length(map) >= 3) {
DstValue kvpair = dst_get(map[2], key);
if (dst_checktype(kvpair, DST_TUPLE)) {
const DstValue *kvtup = dst_unwrap_tuple(kvpair);
if (dst_tuple_length(kvtup) >= 2) {
if (dst_checktype(kvtup[kv], DST_TUPLE)) {
const DstValue *ret = dst_unwrap_tuple(kvtup[kv]);
if (dst_tuple_length(ret) >= 2 &&
dst_checktype(ret[0], DST_INTEGER) &&
dst_checktype(ret[1], DST_INTEGER)) {
return ret;
}
}
}
}
}
return NULL;
}
/* Traverse into a key of a table or struct */
const DstValue *dst_sourcemap_key(const DstValue *map, DstValue key) {
return dst_sourcemap_kv(map, key, 0);
}
/* Traverse into a value of a table or struct */
const DstValue *dst_sourcemap_value(const DstValue *map, DstValue key) {
return dst_sourcemap_kv(map, key, 1);
}

44
core/sourcemap.h Normal file
View File

@ -0,0 +1,44 @@
/*
* Copyright (c) 2017 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#ifndef DST_SOURCEMAP_H_defined
#define DST_SOURCEMAP_H_defined
#include <dst/dst.h>
/* Get the sub source map by indexing a value. Used to traverse
* into arrays and tuples */
const DstValue *dst_sourcemap_index(const DstValue *map, int32_t index);
/* Traverse into a key of a table or struct */
const DstValue *dst_sourcemap_key(const DstValue *map, DstValue key);
/* Traverse into a value of a table or struct */
const DstValue *dst_sourcemap_value(const DstValue *map, DstValue key);
/* Try to rebuild a source map from given another map */
const DstValue *dst_sourcemap_remap(
const DstValue *oldmap,
DstValue oldsource,
DstValue newsource);
#endif

1021
core/stl.c
View File

File diff suppressed because it is too large Load Diff

41
core/string.c
View File

@ -363,23 +363,41 @@ static int is_print_ds(DstValue v) {
/* VT100 Colors for types */
/* TODO - generalize into configurable headers and footers */
/*
DST_NIL,
DST_FALSE,
DST_TRUE,
DST_FIBER,
DST_INTEGER,
DST_REAL,
DST_STRING,
DST_SYMBOL,
DST_ARRAY,
DST_TUPLE,
DST_TABLE,
DST_STRUCT,
DST_BUFFER,
DST_FUNCTION,
DST_CFUNCTION,
DST_USERDATA
*/
static const char *dst_type_colors[16] = {
"\x1B[35m",
"\x1B[33m",
"\x1B[33m",
"\x1B[35m",
"\x1B[35m",
"\x1B[32m",
"",
"\x1B[33m",
"\x1B[33m",
"\x1B[36m",
"",
"",
"",
"",
"\x1B[37m",
"\x1B[37m",
"\x1B[37m",
"\x1B[37m",
"\x1B[37m"
"",
"",
"",
"",
""
};
/* Forward declaration */
@ -629,6 +647,13 @@ const uint8_t *dst_formatc(const char *format, ...) {
dst_description_helper(&printer, va_arg(args, DstValue));
break;
}
case 'C':
{
dst_printer_defaults(&printer);
printer.flags |= DST_PRINTFLAG_COLORIZE;
dst_description_helper(&printer, va_arg(args, DstValue));
break;
}
case 'q':
{
const uint8_t *str = va_arg(args, const uint8_t *);

177
core/strtod.c
View File

@ -70,7 +70,7 @@ static uint8_t digit_lookup[128] = {
/* Read in a mantissa and exponent of a certain base, and give
* back the double value. Should properly handle 0s, Inifinties, and
* denormalized numbers. (When the exponent values are too large) */
static double dst_convert_mantissa_exp(
static double convert(
int negative,
uint64_t mantissa,
int32_t base,
@ -117,41 +117,58 @@ static double dst_convert_mantissa_exp(
}
}
}
/* Build the number to return */
return ldexp(mantissa, exponent2);
return negative
? -ldexp(mantissa, exponent2)
: ldexp(mantissa, exponent2);
}
/* Result of scanning a number source */
struct DstScanRes {
uint64_t mant;
int32_t ex;
int error;
int base;
int seenpoint;
int foundexp;
int neg;
};
/* Get the mantissa and exponent of decimal number. The
* mantissa will be stored in a 64 bit unsigned integer (always positive).
* The exponent will be in a signed 32 bit integer. Will also check if
* the decimal point has been seen. Returns -1 if there is an invalid
* number. */
DstValue dst_scan_number(
static struct DstScanRes dst_scan_impl(
const uint8_t *str,
int32_t len) {
struct DstScanRes res;
const uint8_t *end = str + len;
int32_t seenpoint = 0;
uint64_t mant = 0;
int32_t neg = 0;
int32_t ex = 0;
int foundExp = 0;
/* Set some constants */
int base = 10;
/* Initialize flags */
int seenadigit = 0;
/* Initialize result */
res.mant = 0;
res.ex = 0;
res.error = 0;
res.base = 10;
res.seenpoint = 0;
res.foundexp = 0;
res.neg = 0;
/* Prevent some kinds of overflow bugs relating to the exponent
* overflowing. For example, if a string was passed 2GB worth of 0s after
* the decimal point, exponent could wrap around and become positive. It's
* easier to reject ridiculously large inputs than to check for overflows.
* */
if (len > INT32_MAX / base) goto error;
if (len > INT32_MAX / 40) goto error;
/* Get sign */
if (str >= end) goto error;
if (*str == '-') {
neg = 1;
res.neg = 1;
str++;
} else if (*str == '+') {
str++;
@ -159,53 +176,59 @@ DstValue dst_scan_number(
/* Skip leading zeros */
while (str < end && (*str == '0' || *str == '.')) {
if (seenpoint) ex--;
if (res.seenpoint) res.ex--;
if (*str == '.') {
if (seenpoint) goto error;
seenpoint = 1;
if (res.seenpoint) goto error;
res.seenpoint = 1;
}
seenadigit = 1;
str++;
}
/* Parse significant digits */
while (str < end) {
if (*str == '.') {
if (seenpoint) goto error;
seenpoint = 1;
if (res.seenpoint) goto error;
res.seenpoint = 1;
} else if (*str == '&') {
foundExp = 1;
res.foundexp = 1;
break;
} else if (base == 10 && (*str == 'E' || *str == 'e')) {
foundExp = 1;
} else if (res.base == 10 && (*str == 'E' || *str == 'e')) {
res.foundexp = 1;
break;
} else if (*str == 'x' || *str == 'X') {
if (seenpoint || mant > 0) goto error;
base = 16;
mant = 0;
if (res.seenpoint || res.mant > 0) goto error;
res.base = 16;
res.mant = 0;
} else if (*str == 'r' || *str == 'R') {
if (seenpoint) goto error;
if (mant < 2 || mant > 36) goto error;
base = mant;
mant = 0;
if (res.seenpoint) goto error;
if (res.mant < 2 || res.mant > 36) goto error;
res.base = res.mant;
res.mant = 0;
} else if (*str == '_') {
;
/* underscores are ignored - can be used for separator */
} else {
int digit = digit_lookup[*str & 0x7F];
if (digit >= base) goto error;
if (seenpoint) ex--;
if (mant > 0x00ffffffffffffff)
ex++;
if (digit >= res.base) goto error;
if (res.seenpoint) res.ex--;
if (res.mant > 0x00ffffffffffffff)
res.ex++;
else
mant = base * mant + digit;
res.mant = res.base * res.mant + digit;
seenadigit = 1;
}
str++;
}
if (!seenadigit)
goto error;
/* Read exponent */
if (str < end && foundExp) {
if (str < end && res.foundexp) {
int eneg = 0;
int ee = 0;
seenadigit = 0;
str++;
if (str >= end) goto error;
if (*str == '-') {
@ -216,27 +239,81 @@ DstValue dst_scan_number(
}
/* Skip leading 0s in exponent */
while (str < end && *str == '0') str++;
while (str < end && ee < (INT32_MAX / base - base)) {
while (str < end && ee < (INT32_MAX / 40)) {
int digit = digit_lookup[*str & 0x7F];
if (digit >= base) goto error;
ee = base * ee + digit;
if (digit >= res.base) goto error;
ee = res.base * ee + digit;
str++;
seenadigit = 1;
}
if (eneg) ex -= ee; else ex += ee;
} else if (!seenpoint) {
/* Check for integer literal */
int64_t i64 = neg ? -mant : mant;
if (i64 <= INT32_MAX && i64 >= INT32_MIN)
return dst_wrap_integer((int32_t) i64);
} else if (str < end) {
if (eneg) res.ex -= ee; else res.ex += ee;
}
if (!seenadigit)
goto error;
}
/* Convert mantissa and exponent into double */
return dst_wrap_real(dst_convert_mantissa_exp(neg, mant, base, ex));
return res;
/* return dst_wrap_real(dst_convert_mantissa_exp(neg, mant, base, ex)); */
error:
return dst_wrap_nil();
res.error = 1;
return res;
}
/* Scan an integer from a string. If the string cannot be converted into
* and integer, set *err to 1 and return 0. */
int32_t dst_scan_integer(
const uint8_t *str,
int32_t len,
int *err) {
struct DstScanRes res = dst_scan_impl(str, len);
int64_t i64;
if (res.error)
goto error;
i64 = res.neg ? -res.mant : res.mant;
if (i64 > INT32_MAX || i64 < INT32_MIN)
goto error;
if (NULL != err)
*err = 0;
return (int32_t) i64;
error:
if (NULL != err)
*err = 1;
return 0;
}
/* Scan a real (double) from a string. If the string cannot be converted into
* and integer, set *err to 1 and return 0. */
double dst_scan_real(
const uint8_t *str,
int32_t len,
int *err) {
struct DstScanRes res = dst_scan_impl(str, len);
if (res.error) {
if (NULL != err)
*err = 1;
return 0.0;
} else {
if (NULL != err)
*err = 0;
}
return convert(res.neg, res.mant, res.base, res.ex);
}
/* Scans a number from a string. Can return either an integer or a real if
* the number cannot be represented as an integer. Will return nil in case of
* an error. */
DstValue dst_scan_number(
const uint8_t *str,
int32_t len) {
struct DstScanRes res = dst_scan_impl(str, len);
if (res.error)
return dst_wrap_nil();
if (!res.foundexp && !res.seenpoint) {
int64_t i64 = res.neg ? -res.mant : res.mant;
if (i64 <= INT32_MAX && i64 >= INT32_MIN) {
return dst_wrap_integer((int32_t) i64);
}
}
return dst_wrap_real(convert(res.neg, res.mant, res.base, res.ex));
}

146
core/syscalls.c
View File

@ -1,146 +0,0 @@
/*
* Copyright (c) 2017 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <stdio.h>
int dst_sys_print(DstValue *argv, int32_t argn) {
int32_t i;
for (i = 0; i < argn; ++i) {
int32_t j, len;
const uint8_t *vstr = dst_to_string(argv[i]);
len = dst_string_length(vstr);
for (j = 0; j < len; ++j) {
putc(vstr[j], stdout);
}
}
putc('\n', stdout);
return 0;
}
int dst_sys_asm(DstValue *argv, int32_t argn) {
DstAssembleOptions opts;
DstAssembleResult res;
if (argn < 1) {
dst_vm_fiber->ret = dst_cstringv("expected assembly source");
return 1;
}
opts.source = argv[0];
opts.sourcemap = (argn >= 2 && dst_checktype(argv[1], DST_TUPLE))
? dst_unwrap_tuple(argv[1])
: NULL;
opts.flags = 0;
res = dst_asm(opts);
if (res.status == DST_ASSEMBLE_OK) {
dst_vm_fiber->ret = dst_wrap_function(dst_asm_func(res));
return 0;
} else {
dst_vm_fiber->ret = dst_wrap_string(res.error);
return 1;
}
}
int dst_sys_tuple(DstValue *argv, int32_t argn) {
dst_vm_fiber->ret = dst_wrap_tuple(dst_tuple_n(argv, argn));
return 0;
}
int dst_sys_array(DstValue *argv, int32_t argn) {
DstArray *array = dst_array(argn);
array->count = argn;
memcpy(array->data, argv, argn * sizeof(DstValue));
dst_vm_fiber->ret = dst_wrap_array(array);
return 0;
}
int dst_sys_table(DstValue *argv, int32_t argn) {
int32_t i;
DstTable *table = dst_table(argn/2);
if (argn & 1) {
dst_vm_fiber->ret = dst_cstringv("expected even number of arguments");
return 1;
}
for (i = 0; i < argn; i += 2) {
dst_table_put(table, argv[i], argv[i + 1]);
}
dst_vm_fiber->ret = dst_wrap_table(table);
return 0;
}
int dst_sys_struct(DstValue *argv, int32_t argn) {
int32_t i;
DstValue *st = dst_struct_begin(argn/2);
if (argn & 1) {
dst_vm_fiber->ret = dst_cstringv("expected even number of arguments");
return 1;
}
for (i = 0; i < argn; i += 2) {
dst_struct_put(st, argv[i], argv[i + 1]);
}
dst_vm_fiber->ret = dst_wrap_struct(dst_struct_end(st));
return 0;
}
int dst_sys_get(DstValue *argv, int32_t argn) {
int32_t i;
DstValue ds;
if (argn < 1) {
dst_vm_fiber->ret = dst_cstringv("expected at least 1 argument");
return 1;
}
ds = argv[0];
for (i = 1; i < argn; i++) {
ds = dst_get(ds, argv[i]);
if (dst_checktype(ds, DST_NIL))
break;
}
dst_vm_fiber->ret = ds;
return 0;
}
int dst_sys_put(DstValue *argv, int32_t argn) {
DstValue ds, key, value;
if (argn < 3) {
dst_vm_fiber->ret = dst_cstringv("expected at least 3 arguments");
return 1;
}
if(dst_sys_get(argv, argn - 2))
return 1;
ds = dst_vm_fiber->ret;
key = argv[argn - 2];
value = argv[argn - 1];
dst_put(ds, key, value);
return 0;
}
const DstCFunction dst_vm_syscalls[256] = {
dst_sys_print,
dst_sys_asm,
dst_sys_tuple,
dst_sys_array,
dst_sys_struct,
dst_sys_table,
dst_sys_get,
dst_sys_put,
NULL
};

107
core/vm.c
View File

@ -52,12 +52,13 @@ static int dst_update_fiber() {
}
/* Start running the VM from where it left off. */
int dst_continue() {
static int dst_continue(DstValue *returnreg) {
/* VM state */
DstValue *stack;
uint32_t *pc;
DstFunction *func;
DstValue retreg;
/* Eventually use computed gotos for more effient vm loop. */
#define vm_next() continue
@ -67,7 +68,7 @@ int dst_continue() {
* Pulls out unsigned integers */
#define oparg(shift, mask) (((*pc) >> ((shift) << 3)) & (mask))
#define vm_throw(e) do { dst_vm_fiber->ret = dst_cstringv((e)); goto vm_error; } while (0)
#define vm_throw(e) do { retreg = dst_cstringv((e)); goto vm_error; } while (0)
#define vm_assert(cond, e) do {if (!(cond)) vm_throw((e)); } while (0)
#define vm_binop_integer(op) \
@ -133,7 +134,7 @@ int dst_continue() {
vm_next();
case DOP_ERROR:
dst_vm_fiber->ret = stack[oparg(1, 0xFF)];
retreg = stack[oparg(1, 0xFF)];
goto vm_error;
case DOP_TYPECHECK:
@ -143,11 +144,11 @@ int dst_continue() {
vm_next();
case DOP_RETURN:
dst_vm_fiber->ret = stack[oparg(1, 0xFFFFFF)];
retreg = stack[oparg(1, 0xFFFFFF)];
goto vm_return;
case DOP_RETURN_NIL:
dst_vm_fiber->ret = dst_wrap_nil();
retreg = dst_wrap_nil();
goto vm_return;
case DOP_ADD_INTEGER:
@ -184,10 +185,10 @@ int dst_continue() {
vm_binop(*);
case DOP_DIVIDE_INTEGER:
vm_assert(dst_unwrap_integer(stack[oparg(3, 0xFF)]) != 0, "integer divide by zero");
vm_assert(dst_unwrap_integer(stack[oparg(3, 0xFF)]) != 0, "integer divide error");
vm_assert(!(dst_unwrap_integer(stack[oparg(3, 0xFF)]) == -1 &&
dst_unwrap_integer(stack[oparg(2, 0xFF)]) == DST_INTEGER_MIN),
"integer divide overflow");
dst_unwrap_integer(stack[oparg(2, 0xFF)]) == INT32_MIN),
"integer divide error");
vm_binop_integer(/);
case DOP_DIVIDE_IMMEDIATE:
@ -198,9 +199,9 @@ int dst_continue() {
* min value by -1). These checks could be omitted if the arg is not
* 0 or -1. */
if (op2 == 0)
vm_throw("integer divide by zero");
if (op2 == -1)
vm_throw("integer divide overflow");
vm_throw("integer divide error");
if (op2 == -1 && op1 == INT32_MIN)
vm_throw("integer divide error");
else
stack[oparg(1, 0xFF)] = dst_wrap_integer(op1 / op2);
pc++;
@ -217,10 +218,10 @@ int dst_continue() {
vm_assert(dst_checktype(op1, DST_INTEGER) || dst_checktype(op1, DST_REAL), "expected number");
vm_assert(dst_checktype(op2, DST_INTEGER) || dst_checktype(op2, DST_REAL), "expected number");
if (dst_checktype(op2, DST_INTEGER) && dst_unwrap_integer(op2) == 0)
op2 = dst_wrap_real(0.0);
vm_throw("integer divide error");
if (dst_checktype(op2, DST_INTEGER) && dst_unwrap_integer(op2) == -1 &&
dst_checktype(op1, DST_INTEGER) && dst_unwrap_integer(op1) == DST_INTEGER_MIN)
op2 = dst_wrap_real(-1.0);
dst_checktype(op1, DST_INTEGER) && dst_unwrap_integer(op1) == INT32_MIN)
vm_throw("integer divide error");
stack[oparg(1, 0xFF)] = dst_checktype(op1, DST_INTEGER)
? (dst_checktype(op2, DST_INTEGER)
? dst_wrap_integer(dst_unwrap_integer(op1) / dst_unwrap_integer(op2))
@ -486,10 +487,11 @@ int dst_continue() {
vm_checkgc_next();
} else if (dst_checktype(callee, DST_CFUNCTION)) {
dst_fiber_cframe(dst_vm_fiber);
dst_vm_fiber->ret = dst_wrap_nil();
retreg = dst_wrap_nil();
if (dst_unwrap_cfunction(callee)(
dst_vm_fiber->frametop - dst_vm_fiber->frame,
dst_vm_fiber->data + dst_vm_fiber->frame,
dst_vm_fiber->frametop - dst_vm_fiber->frame)) {
&retreg)) {
goto vm_error;
}
goto vm_return_cfunc;
@ -508,10 +510,11 @@ int dst_continue() {
vm_checkgc_next();
} else if (dst_checktype(callee, DST_CFUNCTION)) {
dst_fiber_cframe_tail(dst_vm_fiber);
dst_vm_fiber->ret = dst_wrap_nil();
retreg = dst_wrap_nil();
if (dst_unwrap_cfunction(callee)(
dst_vm_fiber->data + dst_vm_fiber->frame,
dst_vm_fiber->frametop - dst_vm_fiber->frame)) {
dst_vm_fiber->frametop - dst_vm_fiber->frame,
dst_vm_fiber->data + dst_vm_fiber->frame,
&retreg)) {
goto vm_error;
}
goto vm_return_cfunc;
@ -519,34 +522,12 @@ int dst_continue() {
vm_throw("expected function");
}
case DOP_SYSCALL:
{
DstCFunction f = dst_vm_syscalls[oparg(2, 0xFF)];
vm_assert(NULL != f, "invalid syscall");
dst_fiber_cframe(dst_vm_fiber);
dst_vm_fiber->ret = dst_wrap_nil();
if (f(dst_vm_fiber->data + dst_vm_fiber->frame,
dst_vm_fiber->frametop - dst_vm_fiber->frame)) {
goto vm_error;
}
goto vm_return_cfunc;
}
case DOP_LOAD_SYSCALL:
{
DstCFunction f = dst_vm_syscalls[oparg(2, 0xFF)];
vm_assert(NULL != f, "invalid syscall");
stack[oparg(1, 0xFF)] = dst_wrap_cfunction(f);
pc++;
vm_next();
}
case DOP_TRANSFER:
{
DstFiber *nextfiber;
DstStackFrame *frame = dst_stack_frame(stack);
DstValue temp = stack[oparg(2, 0xFF)];
DstValue retvalue = stack[oparg(3, 0xFF)];
retreg = stack[oparg(3, 0xFF)];
vm_assert(dst_checktype(temp, DST_FIBER) ||
dst_checktype(temp, DST_NIL), "expected fiber");
nextfiber = dst_checktype(temp, DST_FIBER)
@ -555,7 +536,7 @@ int dst_continue() {
/* Check for root fiber */
if (NULL == nextfiber) {
frame->pc = pc;
dst_vm_fiber->ret = retvalue;
*returnreg = retreg;
return 0;
}
vm_assert(nextfiber->status == DST_FIBER_PENDING, "can only transfer to pending fiber");
@ -563,7 +544,7 @@ int dst_continue() {
dst_vm_fiber->status = DST_FIBER_PENDING;
dst_vm_fiber = nextfiber;
vm_init_fiber_state();
stack[oparg(1, 0xFF)] = retvalue;
stack[oparg(1, 0xFF)] = retreg;
pc++;
vm_next();
}
@ -577,7 +558,7 @@ int dst_continue() {
case DOP_PUT_INDEX:
dst_setindex(stack[oparg(1, 0xFF)],
stack[oparg(3, 0xFF)],
stack[oparg(2, 0xFF)],
oparg(3, 0xFF));
++pc;
vm_next();
@ -599,11 +580,12 @@ int dst_continue() {
/* Return from c function. Simpler than retuning from dst function */
vm_return_cfunc:
{
DstValue ret = dst_vm_fiber->ret;
dst_fiber_popframe(dst_vm_fiber);
if (dst_update_fiber())
if (dst_update_fiber()) {
*returnreg = retreg;
return 0;
stack[oparg(1, 0xFF)] = ret;
}
stack[oparg(1, 0xFF)] = retreg;
pc++;
vm_checkgc_next();
}
@ -611,13 +593,14 @@ int dst_continue() {
/* Handle returning from stack frame. Expect return value in fiber->ret */
vm_return:
{
DstValue ret = dst_vm_fiber->ret;
dst_fiber_popframe(dst_vm_fiber);
if (dst_update_fiber())
if (dst_update_fiber()) {
*returnreg = retreg;
return 0;
}
stack = dst_vm_fiber->data + dst_vm_fiber->frame;
pc = dst_stack_frame(stack)->pc;
stack[oparg(1, 0xFF)] = ret;
stack[oparg(1, 0xFF)] = retreg;
pc++;
vm_checkgc_next();
}
@ -625,13 +608,14 @@ int dst_continue() {
/* Handle errors from c functions and vm opcodes */
vm_error:
{
DstValue ret = dst_vm_fiber->ret;
dst_vm_fiber->status = DST_FIBER_ERROR;
if (dst_update_fiber())
if (dst_update_fiber()) {
*returnreg = retreg;
return 1;
}
stack = dst_vm_fiber->data + dst_vm_fiber->frame;
pc = dst_stack_frame(stack)->pc;
stack[oparg(1, 0xFF)] = ret;
stack[oparg(1, 0xFF)] = retreg;
pc++;
vm_checkgc_next();
}
@ -654,21 +638,24 @@ int dst_continue() {
/* Run the vm with a given function. This function is
* called to start the vm. */
int dst_run(DstValue callee) {
int dst_run(DstValue callee, DstValue *returnreg) {
if (NULL == dst_vm_fiber) {
dst_vm_fiber = dst_fiber(0);
} else {
dst_fiber_reset(dst_vm_fiber);
}
if (dst_checktype(callee, DST_CFUNCTION)) {
dst_vm_fiber->ret = dst_wrap_nil();
*returnreg = dst_wrap_nil();
dst_fiber_cframe(dst_vm_fiber);
return dst_unwrap_cfunction(callee)(dst_vm_fiber->data + dst_vm_fiber->frame, 0);
return dst_unwrap_cfunction(callee)(
0,
dst_vm_fiber->data + dst_vm_fiber->frame,
returnreg);
} else if (dst_checktype(callee, DST_FUNCTION)) {
dst_fiber_funcframe(dst_vm_fiber, dst_unwrap_function(callee));
return dst_continue();
return dst_continue(returnreg);
}
dst_vm_fiber->ret = dst_cstringv("expected function");
*returnreg = dst_cstringv("expected function");
return 1;
}
@ -681,7 +668,7 @@ int dst_init() {
* a collection pretty much every cycle, which is
* horrible for performance, but helps ensure
* there are no memory bugs during dev */
dst_vm_memory_interval = 0x0000000;
dst_vm_gc_interval = 0x0000000;
dst_symcache_init();
/* Set thread */
dst_vm_fiber = NULL;

7
dsttest/basic.dst
View File

@ -1,4 +1,5 @@
# A really basic for to compile. for testing the compiler. Will extend
# A really basic form to compile for testing the compiler. Will extend
# as compiler is extended.
(∑ 1 2 3)
(print (+
(* 1 2 3 4 5 6 7 8 9 10)
-12839189321))

575
include/dst/dst.h
View File

@ -28,553 +28,9 @@
#include <stdlib.h>
#include <stdarg.h>
/*
* Detect OS and endianess.
* From webkit source.
*/
/* Check Unix */
#if defined(_AIX) \
|| defined(__APPLE__) /* Darwin */ \
|| defined(__FreeBSD__) || defined(__DragonFly__) \
|| defined(__FreeBSD_kernel__) \
|| defined(__GNU__) /* GNU/Hurd */ \
|| defined(__linux__) \
|| defined(__NetBSD__) \
|| defined(__OpenBSD__) \
|| defined(__QNXNTO__) \
|| defined(sun) || defined(__sun) /* Solaris */ \
|| defined(unix) || defined(__unix) || defined(__unix__)
#define DST_UNIX 1
#endif
/* Check Windows */
#if defined(WIN32) || defined(_WIN32)
#define DST_WINDOWS 1
#endif
/* Check 64-bit vs 32-bit */
#if ((defined(__x86_64__) || defined(_M_X64)) \
&& (defined(DST_UNIX) || defined(DST_WINDOWS))) \
|| (defined(__ia64__) && defined(__LP64__)) /* Itanium in LP64 mode */ \
|| defined(__alpha__) /* DEC Alpha */ \
|| (defined(__sparc__) && defined(__arch64__) || defined (__sparcv9)) /* BE */ \
|| defined(__s390x__) /* S390 64-bit (BE) */ \
|| (defined(__ppc64__) || defined(__PPC64__)) \
|| defined(__aarch64__) /* ARM 64-bit */
#define DST_64 1
#else
#define DST_32 1
#endif
/* Check big endian */
#if defined(__MIPSEB__) /* MIPS 32-bit */ \
|| defined(__ppc__) || defined(__PPC__) /* CPU(PPC) - PowerPC 32-bit */ \
|| defined(__powerpc__) || defined(__powerpc) || defined(__POWERPC__) \
|| defined(_M_PPC) || defined(__PPC) \
|| defined(__ppc64__) || defined(__PPC64__) /* PowerPC 64-bit */ \
|| defined(__sparc) /* Sparc 32bit */ \
|| defined(__sparc__) /* Sparc 64-bit */ \
|| defined(__s390x__) /* S390 64-bit */ \
|| defined(__s390__) /* S390 32-bit */ \
|| defined(__ARMEB__) /* ARM big endian */ \
|| ((defined(__CC_ARM) || defined(__ARMCC__)) /* ARM RealView compiler */ \
&& defined(__BIG_ENDIAN))
#define DST_BIG_ENDIAN 1
#else
#define DST_LITTLE_ENDIAN 1
#endif
/* Handle runtime errors */
#ifndef dst_exit
#include <stdlib.h>
#include <stdio.h>
#define dst_exit(m) do { \
printf("runtime error at line %d in file %s: %s\n",\
__LINE__,\
__FILE__,\
(m));\
exit(-1);\
} while (0)
#endif
#ifndef DST_NOASSERT
#define dst_assert(c, m) do { \
if (!(c)) dst_exit((m)); \
} while (0)
#endif
/* What to do when out of memory */
#ifndef DST_OUT_OF_MEMORY
#include <stdio.h>
#define DST_OUT_OF_MEMORY do { printf("out of memory\n"); exit(1); } while (0)
#endif
#define DST_INTEGER_MIN INT32_MIN
#define DST_INTEGER_MAX INT32_MAX
/* Helper for debugging */
#define dst_trace(x) dst_puts(dst_formatc("DST TRACE %s, %d: %v\n", __FILE__, __LINE__, x))
/* Prevent some recursive functions from recursing too deeply
* ands crashing (the parser). Instead, error out. */
#define DST_RECURSION_GUARD 1000
#define DST_NANBOX
#ifdef DST_NANBOX
typedef union DstValue DstValue;
#else
typedef struct DstValue DstValue;
#endif
/* All of the dst types */
typedef struct DstFunction DstFunction;
typedef struct DstArray DstArray;
typedef struct DstBuffer DstBuffer;
typedef struct DstTable DstTable;
typedef struct DstFiber DstFiber;
/* Other structs */
typedef struct DstReg DstReg;
typedef struct DstUserdataHeader DstUserdataHeader;
typedef struct DstFuncDef DstFuncDef;
typedef struct DstFuncEnv DstFuncEnv;
typedef struct DstStackFrame DstStackFrame;
typedef struct DstUserType DstUserType;
typedef int (*DstCFunction)(DstValue *argv, int32_t argn);
typedef enum DstAssembleStatus DstAssembleStatus;
typedef struct DstAssembleResult DstAssembleResult;
typedef struct DstAssembleOptions DstAssembleOptions;
typedef enum DstCompileStatus DstCompileStatus;
typedef struct DstCompileOptions DstCompileOptions;
typedef struct DstCompileResults DstCompileResults;
typedef struct DstParseResult DstParseResult;
typedef enum DstParseStatus DstParseStatus;
/* Names of all of the types */
extern const char *dst_type_names[16];
/* Basic types for all Dst Values */
typedef enum DstType {
DST_NIL,
DST_FALSE,
DST_TRUE,
DST_FIBER,
DST_INTEGER,
DST_REAL,
DST_STRING,
DST_SYMBOL,
DST_ARRAY,
DST_TUPLE,
DST_TABLE,
DST_STRUCT,
DST_BUFFER,
DST_FUNCTION,
DST_CFUNCTION,
DST_USERDATA
} DstType;
/* We provide two possible implemenations of DstValues. The preferred
* nanboxing approach, and the standard C version. Code in the rest of the
* application must interact through exposed interface. */
/* Required interface for DstValue */
/* wrap and unwrap for all types */
/* Get type quickly */
/* Check against type quickly */
/* Small footprint */
/* 32 bit integer support */
/* dst_type(x)
* dst_checktype(x, t)
* dst_wrap_##TYPE(x)
* dst_unwrap_##TYPE(x)
* dst_truthy(x)
* dst_memclear(p, n) - clear memory for hash tables to nils
* dst_u64(x) - get 64 bits of payload for hashing
*/
#ifdef DST_NANBOX
#include <math.h>
union DstValue {
uint64_t u64;
int64_t i64;
void *pointer;
const void *cpointer;
double real;
};
/* This representation uses 48 bit pointers. The trade off vs. the LuaJIT style
* 47 bit payload representaion is that the type bits are no long contiguous. Type
* checking can still be fast, but typewise polymorphism takes a bit longer. However,
* hopefully we can avoid some annoying problems that occur when trying to use 47 bit pointers
* in a 48 bit address space (Linux on ARM) */
/* |.......Tag.......|.......................Payload..................| */
/* Non-double: t|11111111111|1ttt|xxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx */
/* Types of NIL, TRUE, and FALSE must have payload set to all 1s. */
/* Double (no NaNs): x xxxxxxxxxxx xxxx xxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx */
/* A simple scheme for nan boxed values */
/* normal doubles, denormalized doubles, and infinities are doubles */
/* Quiet nan is nil. Sign bit should be 0. */
#define DST_NANBOX_TYPEBITS 0x0007000000000000lu
#define DST_NANBOX_TAGBITS 0xFFFF000000000000lu
#define DST_NANBOX_PAYLOADBITS 0x0000FFFFFFFFFFFFlu
#ifdef DST_64
#define DST_NANBOX_POINTERBITS 0x0000FFFFFFFFFFFFlu
#else
#define DST_NANBOX_POINTERBITS 0x00000000FFFFFFFFlu
#endif
#define dst_u64(x) ((x).u64)
#define dst_nanbox_lowtag(type) \
((((uint64_t)(type) & 0x8) << 12) | 0x7FF8 | (type))
#define dst_nanbox_tag(type) \
(dst_nanbox_lowtag(type) << 48)
#define dst_nanbox_checkauxtype(x, type) \
(((x).u64 & DST_NANBOX_TAGBITS) == dst_nanbox_tag((type)))
/* Check if number is nan or if number is real double */
#define dst_nanbox_isreal(x) \
(!isnan((x).real) || dst_nanbox_checkauxtype((x), DST_REAL))
#define dst_type(x) \
(isnan((x).real) \
? (((x).u64 & DST_NANBOX_TYPEBITS) >> 48) | (((x).u64 >> 60) & 0x8) \
: DST_REAL)
#define dst_checktype(x, t) \
(((t) == DST_REAL) \
? dst_nanbox_isreal(x) \
: dst_nanbox_checkauxtype((x), (t)))
void *dst_nanbox_to_pointer(DstValue x);
void dst_nanbox_memempty(DstValue *mem, int32_t count);
void *dst_nanbox_memalloc_empty(int32_t count);
DstValue dst_nanbox_from_pointer(void *p, uint64_t tagmask);
DstValue dst_nanbox_from_cpointer(const void *p, uint64_t tagmask);
DstValue dst_nanbox_from_double(double d);
DstValue dst_nanbox_from_bits(uint64_t bits);
#define dst_memempty(mem, len) dst_nanbox_memempty((mem), (len))
#define dst_memalloc_empty(count) dst_nanbox_memalloc_empty(count)
/* Todo - check for single mask operation */
#define dst_truthy(x) \
(!(dst_checktype((x), DST_NIL) || dst_checktype((x), DST_FALSE)))
#define dst_nanbox_from_payload(t, p) \
dst_nanbox_from_bits(dst_nanbox_tag(t) | (p))
#define dst_nanbox_wrap_(p, t) \
dst_nanbox_from_pointer((p), dst_nanbox_tag(t) | 0x7FF8000000000000lu)
#define dst_nanbox_wrap_c(p, t) \
dst_nanbox_from_cpointer((p), dst_nanbox_tag(t) | 0x7FF8000000000000lu)
/* Wrap the simple types */
#define dst_wrap_nil() dst_nanbox_from_payload(DST_NIL, 1)
#define dst_wrap_true() dst_nanbox_from_payload(DST_TRUE, 1)
#define dst_wrap_false() dst_nanbox_from_payload(DST_FALSE, 1)
#define dst_wrap_boolean(b) dst_nanbox_from_payload((b) ? DST_TRUE : DST_FALSE, 1)
#define dst_wrap_integer(i) dst_nanbox_from_payload(DST_INTEGER, (uint32_t)(i))
#define dst_wrap_real(r) dst_nanbox_from_double(r)
/* Unwrap the simple types */
#define dst_unwrap_boolean(x) \
(((x).u64 >> 48) == dst_nanbox_lowtag(DST_TRUE))
#define dst_unwrap_integer(x) \
((int32_t)((x).u64 & 0xFFFFFFFFlu))
#define dst_unwrap_real(x) ((x).real)
/* Wrap the pointer types */
#define dst_wrap_struct(s) dst_nanbox_wrap_c((s), DST_STRUCT)
#define dst_wrap_tuple(s) dst_nanbox_wrap_c((s), DST_TUPLE)
#define dst_wrap_fiber(s) dst_nanbox_wrap_((s), DST_FIBER)
#define dst_wrap_array(s) dst_nanbox_wrap_((s), DST_ARRAY)
#define dst_wrap_table(s) dst_nanbox_wrap_((s), DST_TABLE)
#define dst_wrap_buffer(s) dst_nanbox_wrap_((s), DST_BUFFER)
#define dst_wrap_string(s) dst_nanbox_wrap_c((s), DST_STRING)
#define dst_wrap_symbol(s) dst_nanbox_wrap_c((s), DST_SYMBOL)
#define dst_wrap_userdata(s) dst_nanbox_wrap_((s), DST_USERDATA)
#define dst_wrap_pointer(s) dst_nanbox_wrap_((s), DST_USERDATA)
#define dst_wrap_function(s) dst_nanbox_wrap_((s), DST_FUNCTION)
#define dst_wrap_cfunction(s) dst_nanbox_wrap_((s), DST_CFUNCTION)
/* Unwrap the pointer types */
#define dst_unwrap_struct(x) ((const DstValue *)dst_nanbox_to_pointer(x))
#define dst_unwrap_tuple(x) ((const DstValue *)dst_nanbox_to_pointer(x))
#define dst_unwrap_fiber(x) ((DstFiber *)dst_nanbox_to_pointer(x))
#define dst_unwrap_array(x) ((DstArray *)dst_nanbox_to_pointer(x))
#define dst_unwrap_table(x) ((DstTable *)dst_nanbox_to_pointer(x))
#define dst_unwrap_buffer(x) ((DstBuffer *)dst_nanbox_to_pointer(x))
#define dst_unwrap_string(x) ((const uint8_t *)dst_nanbox_to_pointer(x))
#define dst_unwrap_symbol(x) ((const uint8_t *)dst_nanbox_to_pointer(x))
#define dst_unwrap_userdata(x) (dst_nanbox_to_pointer(x))
#define dst_unwrap_pointer(x) (dst_nanbox_to_pointer(x))
#define dst_unwrap_function(x) ((DstFunction *)dst_nanbox_to_pointer(x))
#define dst_unwrap_cfunction(x) ((DstCFunction)dst_nanbox_to_pointer(x))
/* End of [#ifdef DST_NANBOX] */
#else
/* A general dst value type */
struct DstValue {
union {
uint64_t u64;
double real;
int32_t integer;
void *pointer;
const void *cpointer;
} as;
DstType type;
};
#define dst_u64(x) ((x).as.u64)
#define dst_memempty(mem, count) memset((mem), 0, sizeof(DstValue) * (count))
#define dst_memalloc_empty(count) calloc((count), sizeof(DstValue))
#define dst_type(x) ((x).type)
#define dst_checktype(x, t) ((x).type == (t))
#define dst_truthy(x) \
((x).type != DST_NIL && (x).type != DST_FALSE)
#define dst_unwrap_struct(x) ((const DstValue *)(x).as.pointer)
#define dst_unwrap_tuple(x) ((const DstValue *)(x).as.pointer)
#define dst_unwrap_fiber(x) ((DstFiber *)(x).as.pointer)
#define dst_unwrap_array(x) ((DstArray *)(x).as.pointer)
#define dst_unwrap_table(x) ((DstTable *)(x).as.pointer)
#define dst_unwrap_buffer(x) ((DstBuffer *)(x).as.pointer)
#define dst_unwrap_string(x) ((const uint8_t *)(x).as.pointer)
#define dst_unwrap_symbol(x) ((const uint8_t *)(x).as.pointer)
#define dst_unwrap_userdata(x) ((x).as.pointer)
#define dst_unwrap_pointer(x) ((x).as.pointer)
#define dst_unwrap_function(x) ((DstFunction *)(x).as.pointer)
#define dst_unwrap_cfunction(x) ((DstCFunction)(x).as.pointer)
#define dst_unwrap_boolean(x) ((x).type == DST_TRUE)
#define dst_unwrap_integer(x) ((x).as.integer)
#define dst_unwrap_real(x) ((x).as.real)
DstValue dst_wrap_nil();
DstValue dst_wrap_real(double x);
DstValue dst_wrap_integer(int32_t x);
DstValue dst_wrap_true();
DstValue dst_wrap_false();
DstValue dst_wrap_boolean(int x);
DstValue dst_wrap_string(const uint8_t *x);
DstValue dst_wrap_symbol(const uint8_t *x);
DstValue dst_wrap_array(DstArray *x);
DstValue dst_wrap_tuple(const DstValue *x);
DstValue dst_wrap_struct(const DstValue *x);
DstValue dst_wrap_fiber(DstFiber *x);
DstValue dst_wrap_buffer(DstBuffer *x);
DstValue dst_wrap_function(DstFunction *x);
DstValue dst_wrap_cfunction(DstCFunction x);
DstValue dst_wrap_table(DstTable *x);
DstValue dst_wrap_userdata(void *x);
DstValue dst_wrap_pointer(void *x);
/* End of tagged union implementation */
#endif
/* Used for creating libraries of cfunctions. */
struct DstReg {
const char *name;
DstCFunction function;
};
/* A lightweight green thread in dst. Does not correspond to
* operating system threads. */
struct DstFiber {
DstValue ret; /* Return value */
DstValue *data;
DstFiber *parent;
int32_t frame; /* Index of the stack frame */
int32_t frametop; /* Index of top of stack frame */
int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */
int32_t capacity;
enum {
DST_FIBER_PENDING = 0,
DST_FIBER_ALIVE,
DST_FIBER_DEAD,
DST_FIBER_ERROR
} status;
};
/* A stack frame on the fiber. Is stored along with the stack values. */
struct DstStackFrame {
DstFunction *func;
uint32_t *pc;
int32_t prevframe;
};
/* Number of DstValues a frame takes up in the stack */
#define DST_FRAME_SIZE ((sizeof(DstStackFrame) + sizeof(DstValue) - 1)/ sizeof(DstValue))
/* A dynamic array type. */
struct DstArray {
DstValue *data;
int32_t count;
int32_t capacity;
};
/* A bytebuffer type. Used as a mutable string or string builder. */
struct DstBuffer {
uint8_t *data;
int32_t count;
int32_t capacity;
};
/* A mutable associative data type. Backed by a hashtable. */
struct DstTable {
DstValue *data;
int32_t count;
int32_t capacity;
int32_t deleted;
};
/* Some function defintion flags */
#define DST_FUNCDEF_FLAG_VARARG 1
#define DST_FUNCDEF_FLAG_NEEDSENV 4
/* A function definition. Contains information needed to instantiate closures. */
struct DstFuncDef {
int32_t *environments; /* Which environments to capture from parent. */
DstValue *constants; /* Contains strings, FuncDefs, etc. */
uint32_t *bytecode;
/* Various debug information */
int32_t *sourcemap;
const uint8_t *source;
const uint8_t *sourcepath;
uint32_t flags;
int32_t slotcount; /* The amount of stack space required for the function */
int32_t arity; /* Not including varargs */
int32_t constants_length;
int32_t bytecode_length;
int32_t environments_length;
};
/* A fuction environment */
struct DstFuncEnv {
union {
DstFiber *fiber;
DstValue *values;
} as;
int32_t length; /* Size of environment */
int32_t offset; /* Stack offset when values still on stack. If offset is <= 0, then
environment is no longer on the stack. */
};
/* A function */
struct DstFunction {
DstFuncDef *def;
/* Consider allocating envs with entire function struct */
DstFuncEnv **envs;
};
/* Defines a type for userdata */
struct DstUserType {
const char *name;
int (*serialize)(void *data, size_t len);
int (*deserialize)();
void (*finalize)(void *data, size_t len);
};
/* Contains information about userdata */
struct DstUserdataHeader {
const DstUserType *type;
size_t size;
};
/* Assemble structs */
enum DstAssembleStatus {
DST_ASSEMBLE_OK,
DST_ASSEMBLE_ERROR
};
struct DstAssembleOptions {
const DstValue *sourcemap;
DstValue source;
uint32_t flags;
};
struct DstAssembleResult {
DstFuncDef *funcdef;
const uint8_t *error;
int32_t error_start;
int32_t error_end;
DstAssembleStatus status;
};
/* Compile structs */
enum DstCompileStatus {
DST_COMPILE_OK,
DST_COMPILE_ERROR
};
struct DstCompileResults {
DstCompileStatus status;
DstFuncDef *funcdef;
const uint8_t *error;
int32_t error_start;
int32_t error_end;
};
struct DstCompileOptions {
uint32_t flags;
const DstValue *sourcemap;
DstValue source;
DstValue env;
};
/* Parse structs */
enum DstParseStatus {
DST_PARSE_OK,
DST_PARSE_ERROR,
DST_PARSE_UNEXPECTED_EOS
};
struct DstParseResult {
DstValue value;
const uint8_t *error;
const DstValue *map;
int32_t bytes_read;
DstParseStatus status;
};
/* The VM state. Rather than a struct that is passed
* around, the vm state is global for simplicity. */
/* Garbage collection */
extern void *dst_vm_blocks;
extern uint32_t dst_vm_memory_interval;
extern uint32_t dst_vm_next_collection;
/* Immutable value cache */
extern const uint8_t **dst_vm_cache;
extern uint32_t dst_vm_cache_capacity;
extern uint32_t dst_vm_cache_count;
extern uint32_t dst_vm_cache_deleted;
/* Syscall table */
extern const DstCFunction dst_vm_syscalls[256];
/* GC roots */
extern DstValue *dst_vm_roots;
extern uint32_t dst_vm_root_count;
extern uint32_t dst_vm_root_capacity;
/* GC roots - TODO consider a top level fiber pool (per thread?) */
extern DstFiber *dst_vm_fiber;
#include "dstconfig.h"
#include "dsttypes.h"
#include "dststate.h"
/* Array functions */
DstArray *dst_array(int32_t capacity);
@ -626,6 +82,7 @@ const uint8_t *dst_description(DstValue x);
const uint8_t *dst_short_description(DstValue x);
const uint8_t *dst_to_string(DstValue x);
#define dst_cstringv(cstr) dst_wrap_string(dst_cstring(cstr))
#define dst_stringv(str, len) dst_wrap_string(dst_string((str), (len)))
const uint8_t *dst_formatc(const char *format, ...);
void dst_puts(const uint8_t *str);
@ -714,38 +171,36 @@ extern const char dst_base64[65];
int32_t dst_array_calchash(const DstValue *array, int32_t len);
int32_t dst_string_calchash(const uint8_t *str, int32_t len);
DstValue dst_loadreg(DstReg *regs, size_t count);
DstValue dst_scan_number(const uint8_t *src, int32_t len);
int32_t dst_scan_integer(const uint8_t *str, int32_t len, int *err);
double dst_scan_real(const uint8_t *str, int32_t len, int *err);
/* Parsing */
DstParseResult dst_parse(const uint8_t *src, int32_t len);
DstParseResult dst_parsec(const char *src);
const DstValue *dst_parse_submap_index(const DstValue *map, int32_t index);
const DstValue *dst_parse_submap_key(const DstValue *map, DstValue key);
const DstValue *dst_parse_submap_value(const DstValue *map, DstValue key);
/* VM functions */
int dst_init();
void dst_deinit();
int dst_continue();
int dst_run(DstValue callee);
DstValue dst_transfer(DstFiber *fiber, DstValue x);
int dst_run(DstValue callee, DstValue *returnreg);
/* Compile */
DstCompileResult dst_compile(DstCompileOptions opts);
DstFunction *dst_compile_func(DstCompileResult result);
/* Compile source code into FuncDef. */
DstCompileResults dst_compile(DstCompileOptions opts);
DstFunction *dst_compile_func(DstCompileResults results);
/* STL */
#define DST_LOAD_ROOT 1
DstValue dst_loadstl(int flags);
/* GC */
void dst_mark(DstValue x);
void dst_sweep();
void dst_collect();
void dst_clear_memory();
void dst_gcroot(DstValue root);
int dst_gcunroot(DstValue root);
/* Run garbage collection if needed */
int dst_gcunrootall(DstValue root);
#define dst_maybe_collect() do {\
if (dst_vm_next_collection >= dst_vm_memory_interval) dst_collect(); } while (0)
if (dst_vm_next_collection >= dst_vm_gc_interval) dst_collect(); } while (0)
#endif /* DST_H_defined */

121
include/dst/dstconfig.h Normal file
View File

@ -0,0 +1,121 @@
/*
* Copyright (c) 2017 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#ifndef DST_CONFIG_H_defined
#define DST_CONFIG_H_defined
#include <stdint.h>
#include "dst.h"
/*
* Detect OS and endianess.
* From webkit source.
*/
/* Check Unix */
#if defined(_AIX) \
|| defined(__APPLE__) /* Darwin */ \
|| defined(__FreeBSD__) || defined(__DragonFly__) \
|| defined(__FreeBSD_kernel__) \
|| defined(__GNU__) /* GNU/Hurd */ \
|| defined(__linux__) \
|| defined(__NetBSD__) \
|| defined(__OpenBSD__) \
|| defined(__QNXNTO__) \
|| defined(sun) || defined(__sun) /* Solaris */ \
|| defined(unix) || defined(__unix) || defined(__unix__)
#define DST_UNIX 1
#endif
/* Check Windows */
#if defined(WIN32) || defined(_WIN32)
#define DST_WINDOWS 1
#endif
/* Check 64-bit vs 32-bit */
#if ((defined(__x86_64__) || defined(_M_X64)) \
&& (defined(DST_UNIX) || defined(DST_WINDOWS))) \
|| (defined(__ia64__) && defined(__LP64__)) /* Itanium in LP64 mode */ \
|| defined(__alpha__) /* DEC Alpha */ \
|| (defined(__sparc__) && defined(__arch64__) || defined (__sparcv9)) /* BE */ \
|| defined(__s390x__) /* S390 64-bit (BE) */ \
|| (defined(__ppc64__) || defined(__PPC64__)) \
|| defined(__aarch64__) /* ARM 64-bit */
#define DST_64 1
#else
#define DST_32 1
#endif
/* Check big endian */
#if defined(__MIPSEB__) /* MIPS 32-bit */ \
|| defined(__ppc__) || defined(__PPC__) /* CPU(PPC) - PowerPC 32-bit */ \
|| defined(__powerpc__) || defined(__powerpc) || defined(__POWERPC__) \
|| defined(_M_PPC) || defined(__PPC) \
|| defined(__ppc64__) || defined(__PPC64__) /* PowerPC 64-bit */ \
|| defined(__sparc) /* Sparc 32bit */ \
|| defined(__sparc__) /* Sparc 64-bit */ \
|| defined(__s390x__) /* S390 64-bit */ \
|| defined(__s390__) /* S390 32-bit */ \
|| defined(__ARMEB__) /* ARM big endian */ \
|| ((defined(__CC_ARM) || defined(__ARMCC__)) /* ARM RealView compiler */ \
&& defined(__BIG_ENDIAN))
#define DST_BIG_ENDIAN 1
#else
#define DST_LITTLE_ENDIAN 1
#endif
/* Handle runtime errors */
#ifndef dst_exit
#include <stdlib.h>
#include <stdio.h>
#define dst_exit(m) do { \
printf("runtime error at line %d in file %s: %s\n",\
__LINE__,\
__FILE__,\
(m));\
exit(-1);\
} while (0)
#endif
#ifndef DST_NOASSERT
#define dst_assert(c, m) do { \
if (!(c)) dst_exit((m)); \
} while (0)
#endif
/* What to do when out of memory */
#ifndef DST_OUT_OF_MEMORY
#include <stdio.h>
#define DST_OUT_OF_MEMORY do { printf("out of memory\n"); exit(1); } while (0)
#endif
/* Helper for debugging */
#define dst_trace(x) dst_puts(dst_formatc("DST TRACE %s, %d: %v\n", __FILE__, __LINE__, x))
/* Prevent some recursive functions from recursing too deeply
* ands crashing (the parser). Instead, error out. */
#define DST_RECURSION_GUARD 1000
/* Use nanboxed values - uses 8 bytes per value instead of 12 or 16. */
#define DST_NANBOX
#endif /* DST_CONFIG_H_defined */

55
include/dst/dststate.h Normal file
View File

@ -0,0 +1,55 @@
/*
* Copyright (c) 2017 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#ifndef DST_STATE_H_defined
#define DST_STATE_H_defined
#include <stdint.h>
#include "dstconfig.h"
#include "dsttypes.h"
/* Names of all of the types */
extern const char *dst_type_names[16];
/* The VM state. Rather than a struct that is passed
* around, the vm state is global for simplicity. */
/* Garbage collection */
extern void *dst_vm_blocks;
extern uint32_t dst_vm_gc_interval;
extern uint32_t dst_vm_next_collection;
/* Immutable value cache */
extern const uint8_t **dst_vm_cache;
extern uint32_t dst_vm_cache_capacity;
extern uint32_t dst_vm_cache_count;
extern uint32_t dst_vm_cache_deleted;
/* GC roots */
extern DstValue *dst_vm_roots;
extern uint32_t dst_vm_root_count;
extern uint32_t dst_vm_root_capacity;
/* GC roots - TODO consider a top level fiber pool (per thread?) */
extern DstFiber *dst_vm_fiber;
#endif /* DST_STATE_H_defined */

56
include/dst/dststl.h Normal file
View File

@ -0,0 +1,56 @@
/*
* Copyright (c) 2017 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#ifndef DST_MATH_H_defined
#define DST_MATH_H_defined
#include "dsttypes.h"
int dst_add(int32_t argn, DstValue *argv, DstValue *ret);
int dst_subtract(int32_t argn, DstValue *argv, DstValue *ret);
int dst_multiply(int32_t argn, DstValue *argv, DstValue *ret);
int dst_divide(int32_t argn, DstValue *argv, DstValue *ret);
int dst_modulo(int32_t argn, DstValue *argv, DstValue *ret);
int dst_acos(int32_t argn, DstValue *argv, DstValue *ret);
int dst_asin(int32_t argn, DstValue *argv, DstValue *ret);
int dst_atan(int32_t argn, DstValue *argv, DstValue *ret);
int dst_cos(int32_t argn, DstValue *argv, DstValue *ret);
int dst_cosh(int32_t argn, DstValue *argv, DstValue *ret);
int dst_sin(int32_t argn, DstValue *argv, DstValue *ret);
int dst_sinh(int32_t argn, DstValue *argv, DstValue *ret);
int dst_tan(int32_t argn, DstValue *argv, DstValue *ret);
int dst_tanh(int32_t argn, DstValue *argv, DstValue *ret);
int dst_exp(int32_t argn, DstValue *argv, DstValue *ret);
int dst_log(int32_t argn, DstValue *argv, DstValue *ret);
int dst_log10(int32_t argn, DstValue *argv, DstValue *ret);
int dst_sqrt(int32_t argn, DstValue *argv, DstValue *ret);
int dst_ceil(int32_t argn, DstValue *argv, DstValue *ret);
int dst_fabs(int32_t argn, DstValue *argv, DstValue *ret);
int dst_floor(int32_t argn, DstValue *argv, DstValue *ret);
int dst_stl_table(int32_t argn, DstValue *argv, DstValue *ret);
int dst_stl_array(int32_t argn, DstValue *argv, DstValue *ret);
int dst_stl_struct(int32_t argn, DstValue *argv, DstValue *ret);
int dst_stl_tuple(int32_t argn, DstValue *argv, DstValue *ret);
#endif /* DST_MATH_H_defined */

455
include/dst/dsttypes.h Normal file
View File

@ -0,0 +1,455 @@
/*
* Copyright (c) 2017 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#ifndef DST_TYPES_H_defined
#define DST_TYPES_H_defined
#include <stdint.h>
#include "dstconfig.h"
#ifdef DST_NANBOX
typedef union DstValue DstValue;
#else
typedef struct DstValue DstValue;
#endif
/* All of the dst types */
typedef struct DstFunction DstFunction;
typedef struct DstArray DstArray;
typedef struct DstBuffer DstBuffer;
typedef struct DstTable DstTable;
typedef struct DstFiber DstFiber;
/* Other structs */
typedef struct DstReg DstReg;
typedef struct DstUserdataHeader DstUserdataHeader;
typedef struct DstFuncDef DstFuncDef;
typedef struct DstFuncEnv DstFuncEnv;
typedef struct DstStackFrame DstStackFrame;
typedef struct DstUserType DstUserType;
typedef int (*DstCFunction)(int32_t argn, DstValue *argv, DstValue *ret);
typedef enum DstAssembleStatus DstAssembleStatus;
typedef struct DstAssembleResult DstAssembleResult;
typedef struct DstAssembleOptions DstAssembleOptions;
typedef enum DstCompileStatus DstCompileStatus;
typedef struct DstCompileOptions DstCompileOptions;
typedef struct DstCompileResult DstCompileResult;
typedef struct DstParseResult DstParseResult;
typedef enum DstParseStatus DstParseStatus;
/* Basic types for all Dst Values */
typedef enum DstType {
DST_NIL,
DST_FALSE,
DST_TRUE,
DST_FIBER,
DST_INTEGER,
DST_REAL,
DST_STRING,
DST_SYMBOL,
DST_ARRAY,
DST_TUPLE,
DST_TABLE,
DST_STRUCT,
DST_BUFFER,
DST_FUNCTION,
DST_CFUNCTION,
DST_USERDATA
} DstType;
/* We provide two possible implemenations of DstValues. The preferred
* nanboxing approach, and the standard C version. Code in the rest of the
* application must interact through exposed interface. */
/* Required interface for DstValue */
/* wrap and unwrap for all types */
/* Get type quickly */
/* Check against type quickly */
/* Small footprint */
/* 32 bit integer support */
/* dst_type(x)
* dst_checktype(x, t)
* dst_wrap_##TYPE(x)
* dst_unwrap_##TYPE(x)
* dst_truthy(x)
* dst_memclear(p, n) - clear memory for hash tables to nils
* dst_u64(x) - get 64 bits of payload for hashing
*/
#ifdef DST_NANBOX
#include <math.h>
union DstValue {
uint64_t u64;
int64_t i64;
void *pointer;
const void *cpointer;
double real;
};
/* This representation uses 48 bit pointers. The trade off vs. the LuaJIT style
* 47 bit payload representaion is that the type bits are no long contiguous. Type
* checking can still be fast, but typewise polymorphism takes a bit longer. However,
* hopefully we can avoid some annoying problems that occur when trying to use 47 bit pointers
* in a 48 bit address space (Linux on ARM) */
/* |.......Tag.......|.......................Payload..................| */
/* Non-double: t|11111111111|1ttt|xxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx */
/* Types of NIL, TRUE, and FALSE must have payload set to all 1s. */
/* Double (no NaNs): x xxxxxxxxxxx xxxx xxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx */
/* A simple scheme for nan boxed values */
/* normal doubles, denormalized doubles, and infinities are doubles */
/* Quiet nan is nil. Sign bit should be 0. */
#define DST_NANBOX_TYPEBITS 0x0007000000000000lu
#define DST_NANBOX_TAGBITS 0xFFFF000000000000lu
#define DST_NANBOX_PAYLOADBITS 0x0000FFFFFFFFFFFFlu
#ifdef DST_64
#define DST_NANBOX_POINTERBITS 0x0000FFFFFFFFFFFFlu
#else
#define DST_NANBOX_POINTERBITS 0x00000000FFFFFFFFlu
#endif
#define dst_u64(x) ((x).u64)
#define dst_nanbox_lowtag(type) \
((((uint64_t)(type) & 0x8) << 12) | 0x7FF8 | (type))
#define dst_nanbox_tag(type) \
(dst_nanbox_lowtag(type) << 48)
#define dst_nanbox_checkauxtype(x, type) \
(((x).u64 & DST_NANBOX_TAGBITS) == dst_nanbox_tag((type)))
/* Check if number is nan or if number is real double */
#define dst_nanbox_isreal(x) \
(!isnan((x).real) || dst_nanbox_checkauxtype((x), DST_REAL))
#define dst_type(x) \
(isnan((x).real) \
? (((x).u64 & DST_NANBOX_TYPEBITS) >> 48) | (((x).u64 >> 60) & 0x8) \
: DST_REAL)
#define dst_checktype(x, t) \
(((t) == DST_REAL) \
? dst_nanbox_isreal(x) \
: dst_nanbox_checkauxtype((x), (t)))
void *dst_nanbox_to_pointer(DstValue x);
void dst_nanbox_memempty(DstValue *mem, int32_t count);
void *dst_nanbox_memalloc_empty(int32_t count);
DstValue dst_nanbox_from_pointer(void *p, uint64_t tagmask);
DstValue dst_nanbox_from_cpointer(const void *p, uint64_t tagmask);
DstValue dst_nanbox_from_double(double d);
DstValue dst_nanbox_from_bits(uint64_t bits);
#define dst_memempty(mem, len) dst_nanbox_memempty((mem), (len))
#define dst_memalloc_empty(count) dst_nanbox_memalloc_empty(count)
/* Todo - check for single mask operation */
#define dst_truthy(x) \
(!(dst_checktype((x), DST_NIL) || dst_checktype((x), DST_FALSE)))
#define dst_nanbox_from_payload(t, p) \
dst_nanbox_from_bits(dst_nanbox_tag(t) | (p))
#define dst_nanbox_wrap_(p, t) \
dst_nanbox_from_pointer((p), dst_nanbox_tag(t) | 0x7FF8000000000000lu)
#define dst_nanbox_wrap_c(p, t) \
dst_nanbox_from_cpointer((p), dst_nanbox_tag(t) | 0x7FF8000000000000lu)
/* Wrap the simple types */
#define dst_wrap_nil() dst_nanbox_from_payload(DST_NIL, 1)
#define dst_wrap_true() dst_nanbox_from_payload(DST_TRUE, 1)
#define dst_wrap_false() dst_nanbox_from_payload(DST_FALSE, 1)
#define dst_wrap_boolean(b) dst_nanbox_from_payload((b) ? DST_TRUE : DST_FALSE, 1)
#define dst_wrap_integer(i) dst_nanbox_from_payload(DST_INTEGER, (uint32_t)(i))
#define dst_wrap_real(r) dst_nanbox_from_double(r)
/* Unwrap the simple types */
#define dst_unwrap_boolean(x) \
(((x).u64 >> 48) == dst_nanbox_lowtag(DST_TRUE))
#define dst_unwrap_integer(x) \
((int32_t)((x).u64 & 0xFFFFFFFFlu))
#define dst_unwrap_real(x) ((x).real)
/* Wrap the pointer types */
#define dst_wrap_struct(s) dst_nanbox_wrap_c((s), DST_STRUCT)
#define dst_wrap_tuple(s) dst_nanbox_wrap_c((s), DST_TUPLE)
#define dst_wrap_fiber(s) dst_nanbox_wrap_((s), DST_FIBER)
#define dst_wrap_array(s) dst_nanbox_wrap_((s), DST_ARRAY)
#define dst_wrap_table(s) dst_nanbox_wrap_((s), DST_TABLE)
#define dst_wrap_buffer(s) dst_nanbox_wrap_((s), DST_BUFFER)
#define dst_wrap_string(s) dst_nanbox_wrap_c((s), DST_STRING)
#define dst_wrap_symbol(s) dst_nanbox_wrap_c((s), DST_SYMBOL)
#define dst_wrap_userdata(s) dst_nanbox_wrap_((s), DST_USERDATA)
#define dst_wrap_pointer(s) dst_nanbox_wrap_((s), DST_USERDATA)
#define dst_wrap_function(s) dst_nanbox_wrap_((s), DST_FUNCTION)
#define dst_wrap_cfunction(s) dst_nanbox_wrap_((s), DST_CFUNCTION)
/* Unwrap the pointer types */
#define dst_unwrap_struct(x) ((const DstValue *)dst_nanbox_to_pointer(x))
#define dst_unwrap_tuple(x) ((const DstValue *)dst_nanbox_to_pointer(x))
#define dst_unwrap_fiber(x) ((DstFiber *)dst_nanbox_to_pointer(x))
#define dst_unwrap_array(x) ((DstArray *)dst_nanbox_to_pointer(x))
#define dst_unwrap_table(x) ((DstTable *)dst_nanbox_to_pointer(x))
#define dst_unwrap_buffer(x) ((DstBuffer *)dst_nanbox_to_pointer(x))
#define dst_unwrap_string(x) ((const uint8_t *)dst_nanbox_to_pointer(x))
#define dst_unwrap_symbol(x) ((const uint8_t *)dst_nanbox_to_pointer(x))
#define dst_unwrap_userdata(x) (dst_nanbox_to_pointer(x))
#define dst_unwrap_pointer(x) (dst_nanbox_to_pointer(x))
#define dst_unwrap_function(x) ((DstFunction *)dst_nanbox_to_pointer(x))
#define dst_unwrap_cfunction(x) ((DstCFunction)dst_nanbox_to_pointer(x))
/* End of [#ifdef DST_NANBOX] */
#else
/* A general dst value type */
struct DstValue {
union {
uint64_t u64;
double real;
int32_t integer;
void *pointer;
const void *cpointer;
} as;
DstType type;
};
#define dst_u64(x) ((x).as.u64)
#define dst_memempty(mem, count) memset((mem), 0, sizeof(DstValue) * (count))
#define dst_memalloc_empty(count) calloc((count), sizeof(DstValue))
#define dst_type(x) ((x).type)
#define dst_checktype(x, t) ((x).type == (t))
#define dst_truthy(x) \
((x).type != DST_NIL && (x).type != DST_FALSE)
#define dst_unwrap_struct(x) ((const DstValue *)(x).as.pointer)
#define dst_unwrap_tuple(x) ((const DstValue *)(x).as.pointer)
#define dst_unwrap_fiber(x) ((DstFiber *)(x).as.pointer)
#define dst_unwrap_array(x) ((DstArray *)(x).as.pointer)
#define dst_unwrap_table(x) ((DstTable *)(x).as.pointer)
#define dst_unwrap_buffer(x) ((DstBuffer *)(x).as.pointer)
#define dst_unwrap_string(x) ((const uint8_t *)(x).as.pointer)
#define dst_unwrap_symbol(x) ((const uint8_t *)(x).as.pointer)
#define dst_unwrap_userdata(x) ((x).as.pointer)
#define dst_unwrap_pointer(x) ((x).as.pointer)
#define dst_unwrap_function(x) ((DstFunction *)(x).as.pointer)
#define dst_unwrap_cfunction(x) ((DstCFunction)(x).as.pointer)
#define dst_unwrap_boolean(x) ((x).type == DST_TRUE)
#define dst_unwrap_integer(x) ((x).as.integer)
#define dst_unwrap_real(x) ((x).as.real)
DstValue dst_wrap_nil();
DstValue dst_wrap_real(double x);
DstValue dst_wrap_integer(int32_t x);
DstValue dst_wrap_true();
DstValue dst_wrap_false();
DstValue dst_wrap_boolean(int x);
DstValue dst_wrap_string(const uint8_t *x);
DstValue dst_wrap_symbol(const uint8_t *x);
DstValue dst_wrap_array(DstArray *x);
DstValue dst_wrap_tuple(const DstValue *x);
DstValue dst_wrap_struct(const DstValue *x);
DstValue dst_wrap_fiber(DstFiber *x);
DstValue dst_wrap_buffer(DstBuffer *x);
DstValue dst_wrap_function(DstFunction *x);
DstValue dst_wrap_cfunction(DstCFunction x);
DstValue dst_wrap_table(DstTable *x);
DstValue dst_wrap_userdata(void *x);
DstValue dst_wrap_pointer(void *x);
/* End of tagged union implementation */
#endif
/* Used for creating libraries of cfunctions. */
struct DstReg {
const char *name;
DstCFunction function;
};
/* A lightweight green thread in dst. Does not correspond to
* operating system threads. */
struct DstFiber {
DstValue *data;
DstFiber *parent;
int32_t frame; /* Index of the stack frame */
int32_t frametop; /* Index of top of stack frame */
int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */
int32_t capacity;
enum {
DST_FIBER_PENDING = 0,
DST_FIBER_ALIVE,
DST_FIBER_DEAD,
DST_FIBER_ERROR
} status;
};
/* A stack frame on the fiber. Is stored along with the stack values. */
struct DstStackFrame {
DstFunction *func;
uint32_t *pc;
int32_t prevframe;
};
/* Number of DstValues a frame takes up in the stack */
#define DST_FRAME_SIZE ((sizeof(DstStackFrame) + sizeof(DstValue) - 1)/ sizeof(DstValue))
/* A dynamic array type. */
struct DstArray {
DstValue *data;
int32_t count;
int32_t capacity;
};
/* A bytebuffer type. Used as a mutable string or string builder. */
struct DstBuffer {
uint8_t *data;
int32_t count;
int32_t capacity;
};
/* A mutable associative data type. Backed by a hashtable. */
struct DstTable {
DstValue *data;
int32_t count;
int32_t capacity;
int32_t deleted;
};
/* Some function defintion flags */
#define DST_FUNCDEF_FLAG_VARARG 1
#define DST_FUNCDEF_FLAG_NEEDSENV 4
/* A function definition. Contains information needed to instantiate closures. */
struct DstFuncDef {
int32_t *environments; /* Which environments to capture from parent. */
DstValue *constants; /* Contains strings, FuncDefs, etc. */
uint32_t *bytecode;
/* Various debug information */
int32_t *sourcemap;
const uint8_t *source;
const uint8_t *sourcepath;
uint32_t flags;
int32_t slotcount; /* The amount of stack space required for the function */
int32_t arity; /* Not including varargs */
int32_t constants_length;
int32_t bytecode_length;
int32_t environments_length;
};
/* A fuction environment */
struct DstFuncEnv {
union {
DstFiber *fiber;
DstValue *values;
} as;
int32_t length; /* Size of environment */
int32_t offset; /* Stack offset when values still on stack. If offset is <= 0, then
environment is no longer on the stack. */
};
/* A function */
struct DstFunction {
DstFuncDef *def;
/* Consider allocating envs with entire function struct */
DstFuncEnv **envs;
};
/* Defines a type for userdata */
struct DstUserType {
const char *name;
int (*serialize)(void *data, size_t len);
int (*deserialize)();
void (*finalize)(void *data, size_t len);
};
/* Contains information about userdata */
struct DstUserdataHeader {
const DstUserType *type;
size_t size;
};
/* Assemble structs */
enum DstAssembleStatus {
DST_ASSEMBLE_OK,
DST_ASSEMBLE_ERROR
};
struct DstAssembleOptions {
const DstValue *sourcemap;
DstValue source;
uint32_t flags;
};
struct DstAssembleResult {
DstFuncDef *funcdef;
const uint8_t *error;
int32_t error_start;
int32_t error_end;
DstAssembleStatus status;
};
/* Compile structs */
enum DstCompileStatus {
DST_COMPILE_OK,
DST_COMPILE_ERROR
};
struct DstCompileResult {
DstCompileStatus status;
DstFuncDef *funcdef;
const uint8_t *error;
int32_t error_start;
int32_t error_end;
};
struct DstCompileOptions {
uint32_t flags;
const DstValue *sourcemap;
DstValue source;
DstValue env;
};
/* Parse structs */
enum DstParseStatus {
DST_PARSE_OK,
DST_PARSE_ERROR,
DST_PARSE_UNEXPECTED_EOS,
DST_PARSE_NODATA
};
struct DstParseResult {
DstValue value;
const uint8_t *error;
const DstValue *map;
int32_t bytes_read;
DstParseStatus status;
};
#endif /* DST_TYPES_H_defined */

17
unittests/compile_test.c
View File

@ -1,19 +1,30 @@
#include "unit.h"
#include <dst/dst.h>
#include <dst/dststl.h>
int testprint(DstValue *argv, int32_t argn) {
printf("hello!\n");
int32_t i;
for (i = 0; i < argn; i++) {
dst_puts(dst_formatc("%v\n", argv[i]));
}
return 0;
}
DstReg testreg[] = {
{"print", testprint}
{"print", testprint},
{"+", dst_add},
{"-", dst_subtract},
{"*", dst_multiply},
{"/", dst_divide},
{"%", dst_modulo},
{"acos", dst_acos},
{"asin", dst_asin}
};
int main() {
DstParseResult pres;
DstCompileOptions opts;
DstCompileResults cres;
DstCompileResult cres;
DstFunction *func;
FILE *f = fopen("./dsttest/basic.dst", "rb");