st/lama_byterun
1
0
Fork 0
mirror of https://github.com/ProgramSnail/Lama.git synced 2025-12-15 19:28:47 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

move to runtime

Browse source
This commit is contained in:
ProgramSnail 2024-10-31 21:08:48 +03:00
parent 6c39c65076
commit 26a42d4c81
21 changed files with 477 additions and 1879 deletions
Download patch file Download diff file Expand all files Collapse all files

216
byterun/include/builtin.h
View file

@ -1,216 +0,0 @@
#pragma once
#include <stdio.h>
#include "operations.h"
inline void f_read(struct State *s) {
int x = 0;
printf("> ");
scanf("%i", &x);
s_put_i(s, x);
}
inline void f_write(struct State *s) {
int x = s_take_i(s);
printf("%i", x);
}
inline void f_length(struct State *s) {
union VarT *x = s_take_var(s);
uint32_t type = dh_type(x->nil.data_header);
if (type == ARRAY_T || type == STR_T) {
s_put_i(s, dh_param(x->array.data_header));
} else if (type == STR_T) {
s_put_i(s, strlen(x->str.value));
} else { // TODO: lists ??
failure("no length func for type %ui", type);
}
}
// TODO
inline size_t str_sz(union VarT *var) {
switch (dh_type(var->nil.data_header)) {
case NIL_T: // <nil>
return strlen("<nil>");
case INT_T: // int
return snprintf(nullptr, 0, "%d", var->int_t.value);
case BOX_T: // "<box>:..."
return strlen("<box>") + (var->box.value != NULL
? str_sz((union VarT *)&var->box.value) + 1
: 0);
case STR_T: // "str"
return strlen(var->str.value);
case CLOJURE_T: // <clojure> // TODO
return strlen("<clojure>");
break;
case ARRAY_T: { // [a_1 a_2 a_3 ... a_n]
size_t sz = 0;
if (var->array.values != NULL) {
for (size_t i = 0; i < dh_param(var->array.data_header); ++i) {
sz += str_sz((union VarT *)var->array.values[i]) + 1;
}
--sz; // extra space
}
return sz + 2; // '[', ']'
}
case SEXP_T: { // tag:{a_1 a_2 ...}
size_t sz = 0;
if (var->sexp.tag != NULL) {
sz += strlen(var->sexp.tag) + 1; // tag and ':'
}
if (var->sexp.values != NULL) {
for (size_t i = 0; i < dh_param(var->sexp.data_header); ++i) {
sz += str_sz((union VarT *)var->sexp.values[i]) + 1;
}
--sz; // extra space
}
return sz + 2; // '{', '}'
}
case FUN_T: // <fun>
return strlen("<fun>");
}
}
// TODO
inline char *to_str(union VarT *var, char *str, size_t max_sz) {
str[0] = 0;
switch (dh_type(var->nil.data_header)) {
case NIL_T:
strcat(str, "<nil>");
break;
case INT_T:
snprintf(str, max_sz, "%d", var->int_t.value);
break;
case BOX_T:
strcat(str, "<box>");
if (var->box.value != NULL) {
strcat(str, ":");
str += strlen(str);
str = to_str((union VarT *)&var->box.value, str, max_sz);
}
break;
case STR_T:
strcat(str, "\"");
strcat(str, var->str.value);
strcat(str, "\"");
break;
case CLOJURE_T: // TODO
strcat(str, "<clojure>");
break;
case ARRAY_T:
strcat(str, "[");
++str;
for (size_t i = 0; i < dh_param(var->array.data_header); ++i) {
str = to_str((union VarT *)var->array.values[i], str, max_sz);
strcat(str, " ");
++str;
}
strcat(str, "]");
break;
case SEXP_T:
if (var->sexp.tag != NULL) {
strcat(str, var->sexp.tag);
strcat(str, ":");
}
strcat(str, "{");
str += strlen(str);
for (size_t i = 0; i < dh_param(var->sexp.data_header); ++i) {
str = to_str((union VarT *)var->sexp.values[i], str, max_sz);
strcat(str, " ");
++str;
}
strcat(str, "}");
break;
case FUN_T:
strcat(str, "<fun>");
break;
}
return str + strlen(str);
}
inline void f_string(struct State *s) {
union VarT *var = s_take_var(s);
size_t var_str_sz = str_sz(var);
char *var_str = (char *)malloc((var_str_sz + 1) * sizeof(char));
to_str(var, var_str, var_str_sz);
s_put_str(s, var_str);
free_var_ptr(var);
}
inline void f_array(struct State *s, int sz) { s_put_array(s, sz); }
inline void f_binop(struct State *s, const char *opr) {
size_t len = strlen(opr);
int y = s_take_i(s);
int x = s_take_i(s);
int z = 0;
if (len < 1) {
failure("BINOP: empty operation");
}
switch (opr[0]) {
case '+':
z = x + y;
break;
case '-':
z = x - y;
break;
case '*':
z = x * y;
break;
case '/':
if (y == 0) {
failure("BINOP: can't divide by zero");
}
z = x / y;
break;
case '%':
if (y == 0) {
failure("BINOP: can't take by mod zero");
}
z = x % y;
break;
case '<':
if (len == 1) { // <
z = x < y;
} else { // <=
z = x <= y;
}
break;
case '>':
if (len == 1) { // >
z = x > y;
} else { // >=
z = x >= y;
}
break;
case '=': // ==
z = x == y;
break;
case '!':
if (len == 1) {
failure("BINOP: '!...' opr len is 1");
}
if (opr[1] == '=') { // !=
z = x != y;
} else { // !!
z = x || y;
}
break;
case '&': // &&
z = x && y;
break;
default:
failure("BINOP: unknown operation");
}
s_put_i(s, z);
}

251
byterun/include/gc.h
View file

@ -1,251 +0,0 @@
// ============================================================================
// GC
// ============================================================================
// This is an implementation of a compactifying garbage collection algorithm.
// GC algorithm itself consists of two major stages:
// 1. Marking roots
// 2. Compacting stage
// Compacting is implemented in a very similar fashion to LISP2 algorithm,
// which is well-known.
// Most important pieces of code to discover to understand how everything works:
// - void *gc_alloc (size_t): this function is basically called whenever we are
// not able to allocate memory on the existing heap via simple bump allocator.
// - mark_phase(): this function will tell you everything you need to know
// about marking. I would also recommend to pay attention to the fact that
// marking is implemented without usage of any additional memory. Already
// allocated space is sufficient (for details see 'void mark (void *obj)').
// - void compact_phase (size_t additional_size): the whole compaction phase
// can be understood by looking at this piece of code plus couple of other
// functions used in there. It is basically an implementation of LISP2.
#ifndef __LAMA_GC__
#define __LAMA_GC__
#include "runtime_common.h"
#define GET_MARK_BIT(x) (((int)(x)) & 1)
#define SET_MARK_BIT(x) (x = (((int)(x)) | 1))
#define IS_ENQUEUED(x) (((int)(x)) & 2)
#define MAKE_ENQUEUED(x) (x = (((int)(x)) | 2))
#define MAKE_DEQUEUED(x) (x = (((int)(x)) & (~2)))
#define RESET_MARK_BIT(x) (x = (((int)(x)) & (~1)))
// since last 2 bits are used for mark-bit and enqueued-bit and due to correct
// alignment we can expect that last 2 bits don't influence address (they
// should always be zero)
#define GET_FORWARD_ADDRESS(x) (((size_t)(x)) & (~3))
// take the last two bits as they are and make all others zero
#define SET_FORWARD_ADDRESS(x, addr) (x = ((x & 3) | ((int)(addr))))
// if heap is full after gc shows in how many times it has to be extended
#define EXTRA_ROOM_HEAP_COEFFICIENT 2
#ifdef DEBUG_VERSION
# define MINIMUM_HEAP_CAPACITY (8)
#else
# define MINIMUM_HEAP_CAPACITY (1 << 2)
#endif
#include <stdbool.h>
#include <stddef.h>
typedef enum { ARRAY, CLOSURE, STRING, SEXP } lama_type;
typedef struct {
size_t *current;
} heap_iterator;
typedef struct {
lama_type type; // holds type of object, which fields we are iterating over
void *obj_ptr; // place to store a pointer to the object header
void *cur_field;
} obj_field_iterator;
// Memory pool for linear memory allocation
typedef struct {
size_t *begin;
size_t *end;
size_t *current;
size_t size;
} memory_chunk;
// the only GC-related function that should be exposed, others are useful for tests and internal implementation
// allocates object of the given size on the heap
void *alloc(size_t);
// takes number of words as a parameter
void *gc_alloc(size_t);
// takes number of words as a parameter
void *gc_alloc_on_existing_heap(size_t);
// specific for mark-and-compact_phase gc
void mark (void *obj);
void mark_phase (void);
// marks each pointer from extra roots
void scan_extra_roots (void);
#ifdef LAMA_ENV
// marks each valid pointer from global area
void scan_global_area (void);
#endif
// takes number of words that are required to be allocated somewhere on the heap
void compact_phase (size_t additional_size);
// specific for Lisp-2 algorithm
size_t compute_locations ();
void update_references (memory_chunk *);
void physically_relocate (memory_chunk *);
// ============================================================================
// GC extra roots
// ============================================================================
// Lama's program stack is continuous, i.e. it never interleaves with runtime
// function's activation records. But some valid Lama's pointers can escape
// into runtime. Those values (theirs stack addresses) has to be registered in
// an auxiliary data structure called `extra_roots_pool`.
// extra_roots_pool is a simple LIFO stack. During `pop` it compares that pop's
// argument is equal to the current stack top.
#define MAX_EXTRA_ROOTS_NUMBER 32
typedef struct {
int current_free;
void **roots[MAX_EXTRA_ROOTS_NUMBER];
} extra_roots_pool;
void clear_extra_roots (void);
void push_extra_root (void **p);
void pop_extra_root (void **p);
// ============================================================================
// Implemented in GASM: see gc_runtime.s
// ============================================================================
// MANDATORY TO CALL BEFORE ANY INTERACTION WITH GC (apart from cases where we
// are working with virtual stack as happens in tests)
void __gc_init (void);
// should be called before interaction with GC in case of using in tests with
// virtual stack, otherwise it is automatically invoked by `__gc_init`
void __init (void);
// mostly useful for tests but basically you want to call this in case you want
// to deallocate all object allocated via GC
extern void __shutdown (void);
// ============================================================================
// invoked from GASM: see gc_runtime.s
// ============================================================================
extern void gc_test_and_mark_root (size_t **root);
bool is_valid_heap_pointer (const size_t *);
static inline bool is_valid_pointer (const size_t *);
// ============================================================================
// Auxiliary functions for tests
// ============================================================================
#if defined(DEBUG_VERSION)
// makes a snapshot of current objects in heap (both alive and dead), writes these ids to object_ids_buf,
// returns number of ids dumped
// object_ids_buf is pointer to area preallocated by user for dumping ids of objects in heap
// object_ids_buf_size is in WORDS, NOT BYTES
size_t objects_snapshot (int *object_ids_buf, size_t object_ids_buf_size);
#endif
#ifdef DEBUG_VERSION
// essential function to mock program stack
void set_stack (size_t stack_top, size_t stack_bottom);
// function to mock extra roots (Lama specific)
void set_extra_roots (size_t extra_roots_size, void **extra_roots_ptr);
#endif
// ============================================================================
// Utility functions
// ============================================================================
// accepts pointer to the start of the region and to the end of the region
// scans it and if it meets a pointer, it should be modified in according to forward address
void scan_and_fix_region (memory_chunk *old_heap, void *start, void *end);
// takes a pointer to an object content as an argument, returns forwarding address
size_t get_forward_address (void *obj);
// takes a pointer to an object content as an argument, sets forwarding address to value 'addr'
void set_forward_address (void *obj, size_t addr);
// takes a pointer to an object content as an argument, returns whether this object was marked as live
bool is_marked (void *obj);
// takes a pointer to an object content as an argument, marks the object as live
void mark_object (void *obj);
// takes a pointer to an object content as an argument, marks the object as dead
void unmark_object (void *obj);
// takes a pointer to an object content as an argument, returns whether this object was enqueued to the queue (which is used in mark phase)
bool is_enqueued (void *obj);
// takes a pointer to an object content as an argument, marks object as enqueued
void make_enqueued (void *obj);
// takes a pointer to an object content as an argument, unmarks object as enqueued
void make_dequeued (void *obj);
// returns iterator to an object with the lowest address
heap_iterator heap_begin_iterator ();
void heap_next_obj_iterator (heap_iterator *it);
bool heap_is_done_iterator (heap_iterator *it);
// returns correct type when pointer to actual data is passed (header is excluded)
lama_type get_type_row_ptr (void *ptr);
// returns correct type when pointer to an object header is passed
lama_type get_type_header_ptr (void *ptr);
// returns correct object size (together with header) of an object, ptr is pointer to an actual data is passed (header is excluded)
size_t obj_size_row_ptr (void *ptr);
// returns correct object size (together with header) of an object, ptr is pointer to an object header
size_t obj_size_header_ptr (void *ptr);
// returns total padding size that we need to store given object type
size_t get_header_size (lama_type type);
// returns number of bytes that are required to allocate array with 'sz' elements (header included)
size_t array_size (size_t sz);
// returns number of bytes that are required to allocate string of length 'l' (header included)
size_t string_size (size_t len);
// returns number of bytes that are required to allocate closure with 'sz-1' captured values (header included)
size_t closure_size (size_t sz);
// returns number of bytes that are required to allocate s-expression with 'members' fields (header included)
size_t sexp_size (size_t members);
// returns an iterator over object fields, obj is ptr to object header
// (in case of s-exp, it is mandatory that obj ptr is very beginning of the object,
// considering that now we store two versions of header in there)
obj_field_iterator field_begin_iterator (void *obj);
// returns an iterator over object fields which are actual pointers, obj is ptr to object header
// (in case of s-exp, it is mandatory that obj ptr is very beginning of the object,
// considering that now we store two versions of header in there)
obj_field_iterator ptr_field_begin_iterator (void *obj);
// moves the iterator to next object field
void obj_next_field_iterator (obj_field_iterator *it);
// moves the iterator to the next object field which is an actual pointer
void obj_next_ptr_field_iterator (obj_field_iterator *it);
// returns if we are done iterating over fields of the object
bool field_is_done_iterator (obj_field_iterator *it);
// ptr is pointer to the actual object content, returns pointer to the very beginning of the object (header)
void *get_obj_header_ptr (void *ptr);
void *get_object_content_ptr (void *header_ptr);
void *get_end_of_obj (void *header_ptr);
void *alloc_string (int len);
void *alloc_array (int len);
void *alloc_sexp (int members);
void *alloc_closure (int captured);
#endif

298
byterun/include/operations.h
View file

@ -1,298 +0,0 @@
#pragma once
#include "gc.h"
#include "runtime.h"
#include "types.h"
#include "stdlib.h"
// ------ general ------
inline void free_var_ptr(union VarT *var);
inline void free_var(union VarT var) {
switch (dh_type(var.nil.data_header)) {
case NIL_T:
break;
case INT_T:
break;
case BOX_T:
// pointer, do not free original object
break;
case STR_T:
if (dh_param(var.str.data_header)) { // not const string
// free(var.str.value); // FIXME
}
break;
case CLOJURE_T:
// TODO
break;
case ARRAY_T:
// dh param is size
for (size_t i = 0; i < dh_param(var.array.data_header); ++i) {
free_var_ptr(to_var(var.array.values[i]));
}
// free(var.array.values); // FIXME
break;
case SEXP_T:
// tag is const string, no need to free
if (var.sexp.values != NULL) {
for (size_t i = 0; i < dh_param(var.sexp.data_header); ++i) {
free_var_ptr(to_var(var.sexp.values[i]));
}
// free(var.sexp.values); // FIXME
}
break;
case FUN_T:
break;
}
}
// TODO: use gc
inline void free_var_ptr(union VarT *var) {
free_var(*var);
// free((void *)var); // FIXME
}
//
inline struct NilT clear_var() {
struct NilT var = {.data_header = NIL_T};
return var;
}
// ------ put on stack ---
inline void s_put_ptr(struct State *s, char *val) { // any var
*s->vp = (struct NilT *)val;
++s->vp;
}
inline void s_put_var_ptr(struct State *s, struct NilT **val) { // any var
*s->vp = (struct NilT *)val;
++s->vp;
}
inline void s_put_var(struct State *s, struct NilT *val) { // any var
*s->vp = val;
++s->vp;
}
inline void s_put_nil(struct State *s) {
struct NilT *var = (struct NilT *)alloc(sizeof(struct NilT));
var->data_header = NIL_T; // no param
s_put_var(s, var);
}
inline void s_putn_nil(struct State *s, size_t n) {
for (size_t i = 0; i < n; ++i) {
s_put_nil(s);
}
}
inline void s_put_i(struct State *s, int val) {
struct IntT *var = (struct IntT *)alloc(sizeof(struct IntT));
var->data_header = INT_T; // no param
var->value = val;
s_put_var(s, (struct NilT *)var);
}
inline void s_put_box(struct State *s, struct NilT **val) {
struct BoxT *var = (struct BoxT *)alloc(sizeof(struct BoxT));
var->data_header = BOX_T; // no param
var->value = val;
s_put_var(s, (struct NilT *)var);
}
inline void s_put_const_str(struct State *s, const char *val) {
struct StrT *var = (struct StrT *)alloc(sizeof(struct StrT));
var->data_header = 0 & STR_T; // param - is const
var->value = val;
s_put_var(s, (struct NilT *)var);
}
inline void s_put_str(struct State *s, char *val) {
struct StrT *var = (struct StrT *)alloc(sizeof(struct StrT));
var->data_header = 1 & STR_T; // param - is not const
var->value = val;
s_put_var(s, (struct NilT *)var);
}
inline void s_put_array(struct State *s, int sz) {
struct ArrayT *var = (struct ArrayT *)alloc(sizeof(struct ArrayT));
if (sz < 0) {
failure("array size < 0");
}
if (sz > MAX_ARRAY_SIZE) {
failure("too big array size");
}
var->data_header = sz & ARRAY_T;
var->values = (struct NilT **)alloc(sizeof(struct NilT *) * sz);
for (size_t i = 0; i < sz; ++i) {
var->values[i] = NULL;
}
s_put_var(s, (struct NilT *)var);
}
inline union VarT *s_take_var(struct State *s);
inline void s_put_sexp(struct State *s, const char *tag, int sz) {
struct SExpT *var = (struct SExpT *)alloc(sizeof(struct SExpT));
if (sz < 0) {
failure("array size < 0");
}
if (sz > MAX_ARRAY_SIZE) {
failure("too big array size");
}
var->data_header = sz & SEXP_T;
var->values = (struct NilT **)alloc(sizeof(struct NilT *) * sz);
var->tag = tag;
for (size_t i = 0; i < sz; ++i) {
var->values[i] = (struct NilT *)s_take_var(s);
}
s_put_var(s, (struct NilT *)var);
}
// inline void s_put_empty_list(struct State *s, struct NilT *first_elem) {
// struct ListT *var = (ListT *)alloc(sizeof(ListT));
// var->data_header = LIST_T; // no param
// var->value = first_elem;
// var->next = NULL;
// s_put_var(s, (struct NilT *)var);
// *first_elem = clear_var();
// }
// ------ take from stack ------
inline union VarT *s_take_var(struct State *s) {
if (s->vp == s->stack || (s->fp != NULL && s->vp == s->fp->end)) {
failure("take: no var");
}
--s->vp;
union VarT *ret = (union VarT *)*s->vp;
*s->vp = NULL; // clear top var
return ret;
}
inline int s_take_i(struct State *s) {
union VarT *v = s_take_var(s);
if (dh_type(v->nil.data_header) != INT_T) {
failure("take int: not int");
}
return v->int_t.value;
}
inline void s_drop_var(struct State *s) {
if (s->vp == s->stack || (s->fp != NULL && s->vp == s->fp->end)) {
failure("drop: no var");
}
--s->vp;
free_var_ptr((union VarT *)*s->vp);
*s->vp = NULL;
}
inline void s_dropn_var(struct State *s, size_t n) {
for (size_t i = 0; i < n; ++i) {
s_drop_var(s);
}
}
// ------ functions ------
// |> param_0 ... param_n | frame[ ret rp prev_fp &params &locals &end ]
// |> local_0 ... local_m |> | ...
//
// where |> defines corresponding frame pointer, | is stack pointer location
// before / after new frame added
inline void s_enter_f(struct State *s, char *func_ip, size_t params_sz,
size_t locals_sz) {
if (params_sz > s->vp - s->stack ||
(s->fp != NULL && params_sz > s->vp - s->fp->end)) {
failure("not enough parameters in stack");
}
size_t frame_sz_in_ptr = sizeof(struct Frame) / sizeof(void *);
struct Frame frame = {
.ret = NULL, // field in frame itself
.rp = s->ip,
.prev_fp = s->fp,
.params = s->vp - params_sz,
.locals = s->vp + frame_sz_in_ptr,
.end = s->vp + frame_sz_in_ptr + locals_sz,
};
// put frame on stack
s->fp = (struct Frame *)s->vp;
(*s->fp) = frame;
// update stack pointer
s->vp = frame.end;
// go to function body
s->ip = func_ip;
}
inline void s_exit_f(struct State *s) {
if (s->fp == NULL) {
failure("exit: no func");
}
// drop stack entities and locals
s_dropn_var(s, s->vp - s->fp->locals);
// drop params
s->vp = (void **)s->fp;
s_dropn_var(s, s->vp - s->fp->params);
// s->vp = s->fp->params; // done automatically
// save ret_val;
if (s->fp->ret != NULL) {
(*s->vp) = s->fp->ret;
++s->vp;
}
s->ip = s->fp->rp;
s->fp = s->fp->prev_fp;
}
inline union VarT **var_by_category(struct State *s, enum VarCategory category,
int id) {
union VarT **var = NULL;
switch (category) {
case VAR_GLOBAL:
// TODO: FIXME
break;
case VAR_LOCAL:
if (s->fp == NULL) {
failure("can't read local outside of function");
}
if (id < 0) {
failure("can't read local: negative id %i", id);
}
if (frame_locals_sz(s->fp) <= id) {
failure("can't read local: too big id, %i >= %ul", frame_locals_sz(s->fp),
id);
}
var = (union VarT **)&s->fp->locals[id];
break;
case VAR_A:
// TODO
break;
case VAR_C:
// TODO
break;
}
return var;
}

21
byterun/include/parser.h
View file

@ -2,26 +2,7 @@
#include <stdio.h>
/* The unpacked representation of bytecode file */
typedef struct {
char *string_ptr; /* A pointer to the beginning of the string table */
int *public_ptr; /* A pointer to the beginning of publics table */
char *code_ptr; /* A pointer to the bytecode itself */
int *global_ptr; /* A pointer to the global area */
int stringtab_size; /* The size (in bytes) of the string table */
int global_area_size; /* The size (in words) of global area */
int public_symbols_number; /* The number of public symbols */
char buffer[0];
} bytefile;
/* Gets a string from a string table by an index */
char *get_string(bytefile *f, int pos);
/* Gets a name for a public symbol */
char *get_public_name(bytefile *f, int i);
/* Gets an offset for a publie symbol */
int get_public_offset(bytefile *f, int i);
#include "utils.h"
bytefile *read_file(char *fname);

29
byterun/include/runtime.h
View file

@ -1,29 +0,0 @@
#pragma once
#include <assert.h>
#include <ctype.h>
#include <errno.h>
#include <limits.h>
#include <regex.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <sys/mman.h>
#include <time.h>
#define WORD_SIZE (CHAR_BIT * sizeof(int))
inline void vfailure(char *s, va_list args) {
fprintf(stderr, "*** FAILURE: ");
vfprintf(stderr, s,
args); // vprintf (char *, va_list) <-> printf (char *, ...)
exit(255);
}
inline void failure(char *s, ...) {
va_list args;
va_start(args, s);
vfailure(s, args);
}

73
byterun/include/runtime_common.h
View file

@ -1,73 +0,0 @@
#ifndef __LAMA_RUNTIME_COMMON__
#define __LAMA_RUNTIME_COMMON__
#include <stddef.h>
// this flag makes GC behavior a bit different for testing purposes.
//#define DEBUG_VERSION
//#define FULL_INVARIANT_CHECKS
#define STRING_TAG 0x00000001
#define ARRAY_TAG 0x00000003
#define SEXP_TAG 0x00000005
#define CLOSURE_TAG 0x00000007
#define UNBOXED_TAG 0x00000009 // Not actually a data_header; used to return from LkindOf
#define LEN(x) ((x & 0xFFFFFFF8) >> 3)
#define TAG(x) (x & 0x00000007)
#define SEXP_ONLY_HEADER_SZ (sizeof(int))
#ifndef DEBUG_VERSION
# define DATA_HEADER_SZ (sizeof(size_t) + sizeof(int))
#else
# define DATA_HEADER_SZ (sizeof(size_t) + sizeof(size_t) + sizeof(int))
#endif
#define MEMBER_SIZE sizeof(int)
#define TO_DATA(x) ((data *)((char *)(x) - DATA_HEADER_SZ))
#define TO_SEXP(x) ((sexp *)((char *)(x) - DATA_HEADER_SZ))
#define UNBOXED(x) (((int)(x)) & 0x0001)
#define UNBOX(x) (((int)(x)) >> 1)
#define BOX(x) ((((int)(x)) << 1) | 0x0001)
#define BYTES_TO_WORDS(bytes) (((bytes) - 1) / sizeof(size_t) + 1)
#define WORDS_TO_BYTES(words) ((words) * sizeof(size_t))
// CAREFUL WITH DOUBLE EVALUATION!
#define MAX(x, y) (((x) > (y)) ? (x) : (y))
#define MIN(x, y) (((x) < (y)) ? (x) : (y))
typedef struct {
// store tag in the last three bits to understand what structure this is, other bits are filled with
// other utility info (i.e., size for array, number of fields for s-expression)
int data_header;
#ifdef DEBUG_VERSION
size_t id;
#endif
// last bit is used as MARK-BIT, the rest are used to store address where object should move
// last bit can be used because due to alignment we can assume that last two bits are always 0's
size_t forward_address;
char contents[0];
} data;
typedef struct {
// store tag in the last three bits to understand what structure this is, other bits are filled with
// other utility info (i.e., size for array, number of fields for s-expression)
int data_header;
#ifdef DEBUG_VERSION
size_t id;
#endif
// last bit is used as MARK-BIT, the rest are used to store address where object should move
// last bit can be used because due to alignment we can assume that last two bits are always 0's
size_t forward_address;
int tag;
int contents[0];
} sexp;
#endif

168
byterun/include/runtime_externs.h Normal file
View file

@ -0,0 +1,168 @@
#include <assert.h>
#include <ctype.h>
#include <errno.h>
#include <limits.h>
#include <regex.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <sys/mman.h>
#include <time.h>
#include "../../runtime/runtime_common.h"
#define WORD_SIZE (CHAR_BIT * sizeof(int))
// ---
void *Bsexp(int n, ...);
int LtagHash(char *);
// Gets a raw data_header
int LkindOf(void *p);
// Compare s-exprs tags
int LcompareTags(void *p, void *q);
// Functional synonym for built-in operator ":";
void *Ls__Infix_58(void *p, void *q);
// Functional synonym for built-in operator "!!";
int Ls__Infix_3333(void *p, void *q);
// Functional synonym for built-in operator "&&";
int Ls__Infix_3838(void *p, void *q);
// Functional synonym for built-in operator "==";
int Ls__Infix_6161(void *p, void *q);
// Functional synonym for built-in operator "!=";
int Ls__Infix_3361(void *p, void *q);
// Functional synonym for built-in operator "<=";
int Ls__Infix_6061(void *p, void *q);
// Functional synonym for built-in operator "<";
int Ls__Infix_60(void *p, void *q);
// Functional synonym for built-in operator ">=";
int Ls__Infix_6261(void *p, void *q);
// Functional synonym for built-in operator ">";
int Ls__Infix_62(void *p, void *q);
// Functional synonym for built-in operator "+";
int Ls__Infix_43(void *p, void *q);
// Functional synonym for built-in operator "-";
int Ls__Infix_45(void *p, void *q);
// Functional synonym for built-in operator "*";
int Ls__Infix_42(void *p, void *q);
// Functional synonym for built-in operator "/";
int Ls__Infix_47(void *p, void *q);
// Functional synonym for built-in operator "%";
int Ls__Infix_37(void *p, void *q);
int Llength(void *p);
int LtagHash(char *s);
char *de_hash(int n);
int Luppercase(void *v);
int Llowercase(void *v);
int LmatchSubString(char *subj, char *patt, int pos);
void *Lsubstring(void *subj, int p, int l);
struct re_pattern_buffer *Lregexp(char *regexp);
int LregexpMatch(struct re_pattern_buffer *b, char *s, int pos);
void *Bstring(void *);
void *Lclone(void *p);
int inner_hash(int depth, unsigned acc, void *p);
void *LstringInt(char *b);
int Lhash(void *p);
int LflatCompare(void *p, void *q);
int Lcompare(void *p, void *q);
void *Belem(void *p, int i);
void *LmakeArray(int length);
void *LmakeString(int length);
void *Bstring(void *p);
void *Lstringcat(void *p);
void *Lstring(void *p);
void *Bclosure(int bn, void *entry, ...);
void *Barray(int bn, ...);
void *Bsexp(int bn, ...);
int Btag(void *d, int t, int n);
int get_tag(data *d);
int get_len(data *d);
int Barray_patt(void *d, int n);
int Bstring_patt(void *x, void *y);
int Bclosure_tag_patt(void *x);
int Bboxed_patt(void *x);
int Bunboxed_patt(void *x);
int Barray_tag_patt(void *x);
int Bstring_tag_patt(void *x);
int Bsexp_tag_patt(void *x);
void *Bsta(void *v, int i, void *x);
void Lfailure(char *s, ...);
void LprintfPerror(char *s, ...);
void Bmatch_failure(void *v, char *fname, int line, int col);
void * /*Lstrcat*/ Li__Infix_4343(void *a, void *b);
void *Lsprintf(char *fmt, ...);
void *LgetEnv(char *var);
int Lsystem(char *cmd);
void Lfprintf(FILE *f, char *s, ...);
void Lprintf(char *s, ...);
FILE *Lfopen(char *f, char *m);
void Lfclose(FILE *f);
void *LreadLine();
void *Lfread(char *fname);
void Lfwrite(char *fname, char *contents);
void *Lfexists(char *fname);
void *Lfst(void *v);
void *Lsnd(void *v);
void *Lhd(void *v);
void *Ltl(void *v);
/* Lread is an implementation of the "read" construct */
int Lread();
int Lbinoperror(void);
int Lbinoperror2(void);
/* Lwrite is an implementation of the "write" construct */
int Lwrite(int n);
int Lrandom(int n);
int Ltime();
void set_args(int argc, char *argv[]);

34
byterun/include/stack.h Normal file
View file

@ -0,0 +1,34 @@
#pragma once
#include "../../runtime/gc.h"
#include "runtime_externs.h"
#include "types.h"
#include "utils.h"
#include "stdlib.h"
void s_push(struct State *s, void *val);
void s_push_nil(struct State *s);
void s_pushn_nil(struct State *s, size_t n);
void *s_pop(struct State *s);
void s_popn(struct State *s, size_t n);
// ------ functions ------
// |> param_0 ... param_n | frame[ ret rp prev_fp &params &locals &end
// ]
// |> local_0 ... local_m |> | ...
//
// where |> defines corresponding frame pointer, | is stack pointer
// location before / after new frame added
void s_enter_f(struct State *s, char *func_ip, size_t params_sz,
size_t locals_sz);
void s_exit_f(struct State *s);
union VarT **var_by_category(struct State *s, enum VarCategory category,
int id);

27
byterun/include/types.h
View file

@ -1,7 +1,7 @@
#pragma once
#include "../../runtime/runtime.h"
#include "parser.h"
#include "runtime.h"
#include <stdint.h>
// ------ Var ------
@ -52,7 +52,7 @@ struct ArrayT {
uint32_t data_header;
struct NilT **values;
};
const size_t MAX_ARRAY_SIZE = 0x11111110;
static const size_t MAX_ARRAY_SIZE = 0x11111110;
struct SExpT {
uint32_t data_header;
@ -78,17 +78,20 @@ union VarT {
};
// same to TAG in runtime
inline enum Type dh_type(int data_header) {
static inline enum Type dh_type(int data_header) {
return (enum Type)(data_header & 0x00000007);
}
// same to LEN in runtime
inline int dh_param(int data_header) { return (data_header & 0xFFFFFFF8) >> 3; }
static inline int dh_param(int data_header) {
return (data_header & 0xFFFFFFF8) >> 3;
}
inline union VarT *to_var(struct NilT *var) { return (union VarT *)var; }
static inline union VarT *to_var(struct NilT *var) { return (union VarT *)var; }
// ------ Frame ------
// TODO: store boxed offsets instead
struct Frame {
struct NilT *ret; // store returned value
char *rp; // ret instruction pointer
@ -98,10 +101,10 @@ struct Frame {
void **end; // store locals
};
inline uint64_t frame_locals_sz(struct Frame *frame) {
static inline uint64_t frame_locals_sz(struct Frame *frame) {
return frame->locals - frame->params;
}
inline uint64_t frame_params_sz(struct Frame *frame) {
static inline uint64_t frame_params_sz(struct Frame *frame) {
return frame->end - frame->locals;
}
@ -114,7 +117,7 @@ union StackValue {
char *addr;
};
// inline StackValue *to_sv(void *var) { return (StackValue *)var; }
// static inline StackValue *to_sv(void *var) { return (StackValue *)var; }
struct State {
void **stack; // vaid**
@ -126,18 +129,18 @@ struct State {
};
struct State init_state(bytefile *bf);
void destruct_state(struct State *state);
void cleanup_state(struct State *state);
// ------ VarCategory ------
enum VarCategory {
VAR_GLOBAL = 0,
VAR_LOCAL = 1,
VAR_A = 2, // TODO: ??
VAR_C = 3 // TODO: ??
VAR_ARGUMENT = 2,
VAR_C = 3 // TODO: constant ??
};
inline enum VarCategory to_var_category(uint8_t category) {
static inline enum VarCategory to_var_category(uint8_t category) {
if (category > 3) {
failure("unexpected variable category");
}

26
byterun/include/utils.h Normal file
View file

@ -0,0 +1,26 @@
#pragma once
#include <stdarg.h>
/* The unpacked representation of bytecode file */
typedef struct {
char *string_ptr; /* A pointer to the beginning of the string table */
int *public_ptr; /* A pointer to the beginning of publics table */
char *code_ptr; /* A pointer to the bytecode itself */
int *global_ptr; /* A pointer to the global area */
int stringtab_size; /* The size (in bytes) of the string table */
int global_area_size; /* The size (in words) of global area */
int public_symbols_number; /* The number of public symbols */
char buffer[0];
} bytefile;
/* Gets a string from a string table by an index */
char *get_string(bytefile *f, int pos);
/* Gets a name for a public symbol */
char *get_public_name(bytefile *f, int i);
/* Gets an offset for a public symbol */
int get_public_offset(bytefile *f, int i);
// ---