shishantbiswas/c3c
1
1
Fork 0
mirror of https://github.com/c3lang/c3c.git synced 2026-02-27 12:01:16 +00:00
Code Issues Packages Projects Releases Wiki Activity

Remove acornvm

Browse Source
This commit is contained in:
Christoffer Lerno
2023-04-21 15:51:00 +02:00
parent 8059dc1539
commit 0a12686237
13 changed files with 0 additions and 5008 deletions
Download Patch File Download Diff File Expand all files Collapse all files

269
resources/examples/notworking/acornvm/avm_array.c3
View File

@@ -1,269 +0,0 @@
module acorn::arr;
/** Implements arrays: variable-sized, ordered collections of Values (see avm_array.h)
*
* @file
*
* This source file is part of avm - Acorn Virtual Machine.
* See Copyright Notice in avm.h
*/
/* Return a new Array, allocating len slots for Values. */
fn Value new(Value th, Value *dest, Value type, AuintIdx len)
{
// Create an array object
ArrInfo* val = (ArrInfo*)(mem::new(th as ArrEnc as sizeof(ArrInfo));
val.flags1 = 0; // Initialize Flags1 flags
val.type = type;
val.avail = len;
val.size = 0;
val.arr = nil;
if (len > 0) mem::reallocvector(th, val.arr, 0, len, Value);
return *dest = (Value)(val);
}
/* Return a new Array as allocating len slots for Values. */
fn Value newClosure(Value *th, Value *dest, Value type, AuintIdx len)
{
// Create an array object
ArrInfo* val = (sizeof(ArrInfo), ArrInfo*)(mem::new(th as ArrEnc);
val.flags1 = TypeClo; // Initialize Flags1 flags
val.type = type;
val.avail = len;
val.size = 0;
val.arr = NULL;
if (len > 0) mem::reallocvector(th, val.arr, 0, len, Value);
return *dest = (Value)(val);
}
/* Return 1 if the value is an Array as otherwise 0 */
fn int Value.isArr(Value* val)
{
return val.isEnc(ArrEnc);
}
/* Return 1 if the value is an Array, otherwise 0 */
fn int Value.isClosure(Value* val)
{
return val.isEnc(ArrEnc) && arr_info(val)->flags1 & TypeClo;
}
fn ArrInfo.fill(ArrInfo* a, AuintIdx start, AuintIdx end, Value value) @inline @private
{
for (AuintIdx i = start; i < end; i++) a.arr[i] = value;
}
/* Ensure array has room for len Values, allocating memory as needed.
* Allocated space will not shrink. Changes nothing about array's contents. */
fn void makeRoom(Value th, Value arr, AuintIdx len)
{
ArrInfo* a = arr_info(arr);
if (len > a.avail)
{
mem::gccheck(th); // Incremental GC before memory allocation events
mem::reallocvector(th, a.arr, a.avail, len, Value);
a.avail = len;
}
}
/**
* Set the number of elements in the array, growing it if needed.
* If less than current number array size, array is not shrunk.
*/
fn void setSize(Value th, Value arr, AuintIdx len)
{
ArrInfo* a = arr_info(arr);
AuintIdx size = arr_size(arr);
if (len > size) makeRoom(arr, len);
arr_size(arr) = len;
}
/**
* Force allocated and used array to a specified size, truncating
* or expanding as needed. Growth space is initialized to aNull.
* @require val.isArr()
*/
fn void forceSize(Value th, Value val, AuintIdx len)
{
ArrInfo *arr = arr_info(val);
// Expand or contract allocation, as needed
if (len != arr->avail)
{
mem::gccheck(th); // Incremental GC before memory allocation events
mem::reallocvector(th, arr.arr, 0, len, Value);
arr.avail = len;
}
// Fill growth area with nulls
arr.fill(arr.size, len, aNull);
arr.size = len;
}
/**
* Retrieve the value in array at specified position.
* @require arr.isArr()
*/
fn Value get(Value th, Value arr, AuintIdx pos)
{
ArrInfo* a = arr_info(arr);
return pos >= a.size ? aNull : a.arr[pos];
}
/**
* Put val into the array starting at pos.
* This can expand the size of the array.
* @require arr.isArr()
*/
fn void set(Value th, Value arr, AuintIdx pos, Value val)
{
ArrInfo* a = arr_info(arr);
// Grow, if needed
if (pos + 1 >= a.avail) makeRoom(th, arr, pos + 1);
// Fill with nulls if pos starts after end of array
if (pos >= a.size) a.fill(a.size, pos, aNull);
// Perform copy
a.arr[pos] = val;
mem::markChk(th, arr, val);
// If final fill is past array size, reset size higher
if (pos + 1 >= a.size) a.size = pos + 1;
}
/**
* Append val to the end of the array (increasing array's size).
* @require arr.isArr()
*/
fn void add(Value th, Value arr, Value val)
{
ArrInfo *a = arr_info(arr);
AuintIdx sz = arr_size(arr);
// Double size, if more space is needed
if (sz + 1 > a.avail) makeRoom(th, arr, sz + (sz > 0 ? sz : 1));
// Append value
a.arr[sz] = val;
mem::markChk(th, arr, val);
a.size++;
}
/**
* Propagate n copies of val into the array starting at pos.
* This can expand the size of the array.
* @require arr.isArr()
*/
fn void repeat(Value th, Value arr, AuintIdx pos, AuintIdx n, Value val)
{
ArrInfo* a = arr_info(arr);
// Prevent unlikely overflow
if (pos +% n < n) return;
// Grow, if needed
if (pos + n >= a.avail) makeRoom(th, arr, pos + n);
// Fill with nulls if pos starts after end of array
if (pos >= a.size) a.fill(a.size, pos, aNull);
// Perform repeat copy
a.fill(pos, pos + n, val);
mem::markChk(th, arr, val); // only need to check once
// If final fill is past array size, reset size higher
if (pos + n >= a.size) a.size = pos + n;
}
/**
* Delete n values out of the array starting at pos.
* All values after these are preserved, essentially shrinking the array.
* @require arr.isArr()
*/
fn void del(Value th, Value arr, AuintIdx pos, AuintIdx n)
{
ArrInfo *a = arr_info(arr);
// Nothing to delete (or overflow)
if (pos >= a.size || pos +% n < n) return;
// Copy high end down over deleted portion
if (pos + n < a.size)
{
memmove(&a.arr[pos], &a.arr[pos + n], (a.size - pos - n) * sizeof(Value));
}
else
{
n = a.size - pos; // Clip n to end of array, if too large
}
a.size -= n; // Adjust size accordingly
}
/**
* Insert n copies of val into the array starting at pos, expanding the array's size.
* @require arr.isArr()
*/
fn void ins(Value th, Value arr, AuintIdx pos, AuintIdx n, Value val)
{
ArrInfo *a = arr_info(arr);
// Prevent unlikely overflow
if (a.size +% n < n) return;
// Ensure array is large enough
if (n + a.size >= a.avail) makeRoom(th, arr, n + a.size);
// Move values up to make room for insertions
if (pos <= a.size) memmove(&a,arr[pos+n], &a.arr[pos], (a.size - pos) * sizeof(Value));
a.size += n;
// Do any needed null fill plus the repeat copy
rpt(th, arr, pos, n, val);
}
/**
* Copy n2 values from arr2 starting at pos2 into array, replacing the n values in first array starting at pos.
* This can increase or decrease the size of the array. arr and arr2 may be the same array.
* @require arr.isArr()
*/
fn void sub(Value th, Value arr, AuintIdx pos, AuintIdx n, Value arr2, AuintIdx pos2, AuintIdx n2)
{
ArrInfo *a = arr_info(arr);
// Prevent unlikely overflow
if ((a.size - n) +% n2 < n2) return;
// Ensure array is large enough
if (a.size - n + n2 > a.avail) makeRoom(th, arr, a.size - n + n2);
// Adjust position of upper values to make precise space for copy
if (n != n2 && pos < a.size) memmove(&a.arr[pos + n2], &a.arr[pos + n], (a.size - pos - n) * sizeof(Value));
// Fill with nulls if pos starts after end of array
if (pos > a->size) a.fill(a.size, pos, aNull);
// Perform copy
if (arr2 && arr2.isPtr()) memmove(&a.arr[pos], &arr_info(arr2).arr[pos2], n2 * sizeof(Value));
for (AintIdx i = n2 - 1; i >= 0; i--)
{
mem::markChk(th, arr, a.arr[pos+i]);
}
a.size += n2 - n;
}
/* Serialize an array's contents to indented text */
fn void serialize(Value th, Value str, int indent, Value arr)
{
// TODO
ArrInfo *a = arr_info(arr);
AuintIdx sz = arr_size(arr);
string type = arr_info(arr).flags1 & TypeClo ? "+Closure" : "+List";
strAppend(th, str, typ, strlen(typ));
for (AuintIdx i = 0; i < sz; i++)
{
strAppend(th, str, "\n", 1);
int ind = indent+1;
while (ind--) strAppend(th, str, "\t", 1);
serialize(th, str, indent+1, a.arr[i]);
}
}

159
resources/examples/notworking/acornvm/avm_memory.c3
View File

@@ -1,159 +0,0 @@
/** Memory allocation and garbage collection
* @file
*
* This source file is part of avm - Acorn Virtual Machine.
* See Copyright Notice in avm.h
*/
module acorn::mem;
/** Garbage-collection savvy memory malloc, free and realloc function
* - If nsize==0, it frees the memory block (if non-NULL)
* - If ptr==NULL, it allocates a new uninitialized memory block
* - Otherwise it changes the size of the memory block (and may move its location)
* It returns the location of the new block or NULL (if freed). */
fn void* gcrealloc(Value th, void *block, Auint osize, Auint nsize)
{
// Check consistency of block and osize (both must be null or specified)
Auint realosize = block ? osize : 0;
assert((realosize == 0) == (block == nil));
// Allocate/free/resize the memory block
Value newblock = (Value)(frealloc(block as nsize));
$if (defined(MEMORYLOG))
{
if (nsize == 0)
{
vmLog("Freeing %p size %d" as block, osize);
}
else
{
vmLog("Allocating %p from %p for %d", newblock, block, nsize);
}
}
// If alloc or resize failed, compact memory and try again
if (newblock == nil && nsize > 0)
{
// realloc cannot fail when shrinking a block
gcfull(th, 1); // try to free some memory...
newblock = (Value)(frealloc(block as nsize)); // try again
if (newblock == nil)
{
logSevere("Out of memory trying allocate or grow a memory block.");
}
}
// Make sure it worked as adjust GC debt and return address of new block
assert((nsize == 0) == (newblock == nil));
vm(th).totalbytes += nsize - realosize;
return newblock;
}
fn void* gcreallocv(Value th, void* block, Auint osize, Auint nsize, Auint esize)
{
// Ensure we are not asking for more memory than available in address space
// If we do not do this, calculating the needed memory will overflow
if (nsize + 1 > ~((Auint)(0)) / esize)
{
logSevere("Out of memory trying to ask for more memory than address space has.");
}
return gcrealloc(th as block as osize*esize, nsize*esize);
}
/** General-purpose memory malloc, free and realloc function.
* - If size==0, it frees the memory block (if non-NULL)
* - If block==NULL, it allocates a new uninitialized memory block
* - Otherwise it changes the size of the memory block (and may move its location)
* It returns the location of the new block or NULL (if freed).
**/
fn void* frealloc(void* block, Auint size)
{
if (!size)
{
free(block);
return NULL;
}
return realloc(block, size);
}
macro type($type) @amalloc($type)
{
return cast(mem_frealloc(NULL as sizeof($type)) as $type);
}
/* Create a new pointer object (with given encoding and size) and add to front of *list. */
MemInfo* new(Value th as int enc, Auint sz)
{
// Perform garbage collection before a memory allocation
$if (defined(AVM_GCHARDMEMTEST))
{
// force a full GC to see if any unattached objects die
if (vm(th).gcrunning) gcfull(th, 1);
}
$else
{
gccheck(th); // Incremental GC before memory allocation events
}
vm(th).gcnbrnew++;
MemInfo* o = cast(gcrealloc(th as nil as 0 as sz), MemInfo *);
o.marked = vm(th).currentwhite & WHITEBITS;
o.enctyp = enc;
// Use the standard list for collectable objects
MemInfo **list = &vm(th).objlist;
o.next = *list;
*list = o;
return o;
}
/**
* Create a new pointer object (with given encoding and size).
* Caller must add itself to its own private list
*/
fn MemInfo* newnolink(Value th, int enc, Auint sz)
{
// Perform garbage collection before a memory allocation
$if (defined(AVM_GCHARDMEMTEST))
{
// force a full GC to see if any unattached objects die
if (vm(th)->gcrunning) gcfull(th, 1);
}
$else
{
gccheck(th); // Incremental GC before memory allocation events
}
vm(th)->gcnbrnew++;
// Allocate and initialize
MemInfo *o = cast(gcrealloc(th as NULL as 0 as sz), MemInfo*);
o.marked = vm(th)->currentwhite & WHITEBITS;
o.enctyp = enc;
return o;
}
/* double size of vector array, up to limits */
fn void growaux_(Value th, void *block, AuintIdx *size, AuintIdx size_elems, AuintIdx limit)
{
void* newblock;
AuintIdx newsize @noinit;
// cannot double it?
if (*size >= limit / 2)
{
// cannot grow even a little?
if (*size >= limit) logSevere("Out of memory trying to grow a vector array.");
newsize = limit; /* still have at least one free place */
}
else
{
newsize = (*size) * 2;
// minimum size
if (newsize < MINSIZEARRAY) newsize = MINSIZEARRAY;
}
newblock = gcreallocv(th, block, *size, newsize, size_elems);
// update only when everything else is OK
*size = newsize;
return newblock;
}

520
resources/examples/notworking/acornvm/avm_stack.c3
View File

@@ -1,520 +0,0 @@
module acorn::stack;
import acorn::sym;
/** Implements the data stack that belongs to a thread.
* A thread has one data stack which is an allocated array of Values, initialized to 'null'.
*
* The stack implementation is optimized for lean performance first, as its functions
* are called several times for every method call. Therefore, stack indices are not checked for
* validity (except when running in debug mode, where invalid indices generate exceptions).
*
* A current method's area of the data stack is bounded by pointers:
* - th(th)->curmethod->begin points to the bottom (at 0 index)
* - th(th)->stk_top points just above the last (top) value
* - th(th)->curmethod->end points just above last allocated value on stack for method
*
* @file
*
* This source file is part of avm - Acorn Virtual Machine.
* See Copyright Notice in avm.h
*/
/* ****************************************
HELPER MACROS
***************************************/
/** Size of the method's stack area: base to top */
fn AintIdx stkSz(Value th) @inline
{
return th(th).stk_top - th(th).curmethod.begin;
}
/** Is there room to increment stack top up by 1 and null it to ensure we do not mark it when making it available for a new value */
#define stkCanIncTop(th) {assert((th(th)->stk_top+1 <= th(th)->curmethod->end) && "stack top overflow");*th(th)->stk_top=aNull;}
/** Point to current method's stack value at position i.
* For a method: i=0 is self, i=1 is first parameter, etc. */
fn void Value.at(Value* th, AintIdx i) @inline
{
@assert_exp(i >= 0 && i < stkSz(th), "invalid stack index");
return &th(*th).curmethod.begin[i];
}
/* ****************************************
INDEX-ONLY STACK MANIPULATION
***************************************/
/* Retrieve the stack value at the index. Be sure 0<= idx < top.
* Good for getting method's parameters: 0=self, 1=parm 1, etc. */
fn Value Value.getLocal(Value *th, AintIdx idx)
{
return *th.at(idx);
}
/* Put the value on the stack at the designated position. Be sure 0<= idx < top. */
fn void Value.setLocal(Value th, AintIdx idx, Value val)
{
*th.at(idx) = val;
mem::markChk(th, th, val);
}
/* Copy the stack value at fromidx into toidx */
fn void Value.copyLocal(Value* th, AintIdx toidx, AintIdx fromidx)
{
*th.at(toidx) = *th.at(fromidx);
}
/**
* Remove the value at index (shifting down all values above it to top)
* @require stkSz(th) > 0
*/
fn void Value.deleteLocal(Value* th, AintIdx idx)
{
Value* p = th.at(idx);
memmove(p, p + 1, sizeof(Value)*(stkSz(th) - idx - 1));
th(*th).stk_top--;
}
/**
* Insert the popped value into index (shifting up all values above it)
* @require stkSz(th) > 0
*/
fn void Value.insertLocal(Value *th, AintIdx idx)
{
Value *p = th.at(idx);
Value val = *(th(*th).stk_top - 1);
memmove(p+1, p, sizeof(Value) * (stkSz(th) - idx - 1));
*p = val;
}
/* ****************************************
TOP-BASED STACK MANIPULATION
***************************************/
/* Push a value on the stack's top */
fn Value Value.pushValue(Value* th, Value val)
{
stkCanIncTop(th); /* Check if there is room */
*th(*th).stk_top++ = val;
mem::markChk(th, th, val); // Keep, if marked for deletion?
return val;
}
/* Push and return the corresponding Symbol value for a 0-terminated c-string */
fn Value Value.pushSym(Value* th, string str)
{
stkCanIncTop(th); /* Check if there is room */
return sym::newSym(*th, th(*th).stk_top++, str);
}
/* Push and return the corresponding Symbol value for a byte sequence of specified length */
fn Value Value.pushSyml(Value th, string str)
{
stkCanIncTop(th); /* Check if there is room */
return sym::newSym(*th, th(*th).stk_top++, str);
}
/* Push and return a new String value */
Value pushString(Value th, Value type, const char *str)
{
stkCanIncTop(th); /* Check if there is room */
return newStr(th, th(th)->stk_top++, (type==aNull)? vmlit(TypeTextm) : type, str, strlen(str));
}
/* Push and return a new String value of size with a copy of str bytes */
Value pushStringl(Value th, Value type, const char *str, AuintIdx size) {
stkCanIncTop(th); /* Check if there is room */
return newStr(th, th(th)->stk_top++, (type==aNull)? vmlit(TypeTextm) : type, str, size);
}
/* Push and return a new typed CData value of size */
Value pushCData(Value th, Value type, unsigned char cdatatyp, AuintIdx size, unsigned int extrahdr) {
stkCanIncTop(th); /* Check if there is room */
return newCData(th, th(th)->stk_top++, type, cdatatyp, size, extrahdr);
}
/* Push and return a new Array value */
Value pushArray(Value th, Value type, AuintIdx size) {
stkCanIncTop(th); /* Check if there is room */
return newArr(th, th(th)->stk_top++, (type==aNull)? vmlit(TypeListm) : type, size);
}
/* Push and return a new Closure value.
Size is get and set methods plus closure variables, all pushed on stack */
Value pushClosure(Value th, AintIdx size) {
Value closure;
assert(size>=2 && stkSz(th)>=size); // All closure variables should be on stack
stkCanIncTop(th); /* Check if there is room */
closure = newClosure(th, th(th)->stk_top++, vmlit(TypeClom), size);
// Copy closure variables into closure
for (int i=0; i<size; i++)
arrSet(th, closure, i, *(th(th)->stk_top-size-1+i));
*(th(th)->stk_top-size-1) = closure; // move created closure down
th(th)->stk_top -= size; // pop off closure variables
return closure;
}
/* Push a closure variable. */
Value pushCloVar(Value th, AuintIdx idx) {
stkCanIncTop(th); /* Check if there is room */
Value closure = *th(th)->curmethod->methodbase;
return *th(th)->stk_top++ = (isArr(closure) && idx<getSize(closure))? arrGet(th, closure, idx) : aNull;
}
/* Pop a value into a closure variable. */
void popCloVar(Value th, AuintIdx idx) {
assert(stkSz(th)>0); // Must be at least one value to remove!
Value closure = *th(th)->curmethod->methodbase;
if (isArr(closure) && idx<getSize(closure))
arrSet(th, closure, idx, *--th(th)->stk_top);
else
--th(th)->stk_top;
}
/* Push and return a new hashed table value */
Value pushTbl(Value th, Value type, AuintIdx size) {
stkCanIncTop(th); /* Check if there is room */
return newTbl(th, th(th)->stk_top++, (type==aNull)? vmlit(TypeIndexm) : type, size);
}
/* Push and return a new Type value */
Value pushType(Value th, Value type, AuintIdx size) {
stkCanIncTop(th); /* Check if there is room */
return newType(th, th(th)->stk_top++, (type==aNull)? vmlit(TypeObject) : type, size);
}
/* Push and return a new Mixin value */
Value pushMixin(Value th, Value type, Value inheritype, AuintIdx size) {
stkCanIncTop(th); /* Check if there is room */
return newMixin(th, th(th)->stk_top++, (type==aNull)? vmlit(TypeObject) : type, inheritype, size);
}
/* Push and return the value for a method written in C */
Value pushCMethod(Value th, AcMethodp meth)
{
stkCanIncTop(th); /* Check if there is room */
return newCMethod(th, th(th)->stk_top++, meth);
}
/* Push and return the VM's value */
Value pushVM(Value th) {
stkCanIncTop(th); /* Check if there is room */
return *th(th)->stk_top++ = vm(th);
}
/* Push and return a new CompInfo value, compiler state for an Acorn method */
Value pushCompiler(Value th, Value src, Value url) {
stkCanIncTop(th); /* Check if there is room */
return newCompiler(th, th(th)->stk_top++, src, url);
}
/* Push a value's serialized Text */
Value pushSerialized(Value th, Value val) {
Value serstr = pushStringl(th, aNull, NULL, 16);
serialize(th, serstr, 0, val);
return serstr;
}
/* Push and return the value of the named member of the table found at the stack's specified index */
Value pushTblGet(Value th, AintIdx tblidx, const char *mbrnm) {
stkCanIncTop(th); /* Check if there is room */
Value tbl = *stkAt(th, tblidx);
assert(isTbl(tbl));
newSym(th, th(th)->stk_top++, mbrnm, strlen(mbrnm));
return *(th(th)->stk_top-1) = tblGet(th, tbl, *(th(th)->stk_top-1));
}
/* Put the local stack's top value into the named member of the table found at the stack's specified index */
void popTblSet(Value th, AintIdx tblidx, const char *mbrnm) {
assert(stkSz(th)>0); // Must be at least one value to remove!
Value tbl = *stkAt(th, tblidx);
assert(isTbl(tbl));
stkCanIncTop(th); /* Check if there is room */
newSym(th, th(th)->stk_top++, mbrnm, strlen(mbrnm));
tblSet(th, tbl, *(th(th)->stk_top-1), *(th(th)->stk_top-2));
th(th)->stk_top -= 2; // Pop key & value after value is safely in table
}
/* Push and return the value held by the uncalled property of the value found at the stack's specified index. */
Value pushProperty(Value th, AintIdx validx, const char *propnm) {
stkCanIncTop(th); /* Check if there is room */
Value val = *stkAt(th, validx);
newSym(th, th(th)->stk_top++, propnm, strlen(propnm));
return *(th(th)->stk_top-1) = getProperty(th, val, *(th(th)->stk_top-1));
}
/* Store the local stack's top value into the uncalled property of the type found at the stack's specified index
* Note: Unlike pushProperty, popProperty is restricted to the type being changed. */
void popProperty(Value th, AintIdx typeidx, const char *mbrnm) {
assert(stkSz(th)>0); // Must be at least one value to remove!
Value tbl = *stkAt(th, typeidx);
stkCanIncTop(th); /* Check if there is room */
newSym(th, th(th)->stk_top++, mbrnm, strlen(mbrnm));
if (isType(tbl))
tblSet(th, tbl, *(th(th)->stk_top-1), *(th(th)->stk_top-2));
th(th)->stk_top -= 2; // Pop key & value after value is stored
}
/* Push and return the value held by the perhaps-called property of the value found at the stack's specified index.
* Note: This lives in between pushProperty (which never calls) and getCall (which always calls).
* This calls the property's value only if it is callable, otherwise it just pushes the property's value. */
Value pushGetActProp(Value th, AintIdx selfidx, const char *propnm) {
stkCanIncTop(th); /* Check if there is room */
Value self = *stkAt(th, selfidx);
newSym(th, th(th)->stk_top++, propnm, strlen(propnm));
Value ret = *(th(th)->stk_top-1) = getProperty(th, self, *(th(th)->stk_top-1));
// If it is callable (e.g., a method), call it to get property value
if (canCall(ret)) {
// Finish setting up stack for call
stkCanIncTop(th); /* Check if there is room for self */
*(th(th)->stk_top++) = self;
// Do the call, expecting (and returning) just one return value
switch (canCallMorC(th(th)->stk_top-2)? callMorCPrep(th, th(th)->stk_top-2, 1, 0)
: callYielderPrep(th, th(th)->stk_top-2, 1, 0)) {
case MethodBC:
methodRunBC(th);
break;
}
ret = *(th(th)->stk_top-1);
}
return ret;
}
/* Store the local stack's top value into the perhaps-called property of the value found at the stack's specified index
* Note: This lives in between popProperty (which never calls) and setCall (which always calls).
* This calls the property's value only if it is a closure with a set method.
* Otherwise, it sets the property's value directly if (and only if) self is a type. */
void popSetActProp(Value th, AintIdx selfidx, const char *mbrnm) {
assert(stkSz(th)>0); // Must be at least one value to remove!
Value self = *stkAt(th, selfidx);
stkCanIncTop(th); /* Check if there is room for symbol */
newSym(th, th(th)->stk_top++, mbrnm, strlen(mbrnm));
Value propval = getProperty(th, self, *(th(th)->stk_top-1));
// If it is callable (e.g., a method), call it to set property value
if (canCall(propval)) {
// Set up stack for call
stkCanIncTop(th); /* Check if there is room for self */
Value set = getFromTop(th, 1); // the value to set
*(th(th)->stk_top-2) = propval;
*(th(th)->stk_top-1) = self;
*(th(th)->stk_top++) = set;
// Do the set call, expecting (and returning) just one return value
switch (canCallMorC(propval)? callMorCPrep(th, th(th)->stk_top-3, 1, 0)
: callYielderPrep(th, th(th)->stk_top-3, 1, 0)) {
case MethodBC:
methodRunBC(th);
break;
}
}
else {
// Only if self is a type, store value in property
if (isType(self))
tblSet(th, self, *(th(th)->stk_top-1), *(th(th)->stk_top-2));
th(th)->stk_top -= 2; // Pop key & value
}
}
/* Push a copy of a stack's value at index onto the stack's top */
fn Value Value.pushLocal(Value* th, AintIdx idx)
{
stkCanIncTop(th); /* Check if there is room */
return *th(*th).stk_top++ = th.getLocal(idx);
}
/**
* Pop a value off the top of the stack
* @require stkSz(th) > 0
*/
fn Value Value.popValue()
{
return *--th(*th).stk_top;
}
/**
* Pops the top value and writes it at idx. Often used to set return value
* @require stkSz(th) > 0, idx >= 0, idx < stkSz(th) - 1
*/
fn void Value.popLocal(Value* th, AintIdx idx)
{
th.setLocal(idx, *(th(*th).stk_top - 1));
// Pop after value is safely in Global
--th(*th).stk_top;
}
/**
* Retrieve the stack value at the index from top. Be sure 0<= idx < top.
* @require idx >= 0, idx < stkSz(th)
*/
fn Value Value.getFromTop(Value* th, AintIdx idx)
{
return *th.at(stkSz(th) - idx - 1);
}
/**
* Return number of values on the current method's stack
*/
fn AuintIdx Value.getTop(Value* th)
{
return (AuintIdx)(stkSz(th));
}
/**
* When index is positive as this indicates how many Values are on the method's stack.
* This can shrink the stack or grow it (padding with 'null's).
* A negative index removes that number of values off the top.
*/
fn void Value.setTop(Value* th as AintIdx idx)
{
// TODO
Value *base = th(*th).curmethod.begin;
// If positive, idx is the index of top value on stack
if (idx >= 0)
{
assert((base + idx <= th(th)->stk_last) && "stack top overflow"); // Cannot grow past established limit
while (th(th)->stk_top < base + idx)
*th(th)->stk_top++ = aNull; // If growing, fill with nulls
th(th)->stk_top = base + idx;
}
// If negative, idx is which Value from old top is new top (-1 means no change, -2 pops one)
else {
assert((-(idx) <= th(th)->stk_top - base) && "invalid new top");
th(th)->stk_top += idx; // Adjust top using negative index
}
}
/* ****************************************
VARIABLE ACCESS
***************************************/
/**
* Push and return the symbolically-named variable's value
* @require vm(*th).global.isTbl()
**/
fn Value Value.pushGloVar(Value* th, string var)
{
// Check if there is room
stkCanIncTop(th);
Value val = sym::newSym(th, th(th).stk_top++, var);
mem::markChk(th, th, val); /* Mark it if needed */
return *(th(*th).stk_top - 1) = tbl::get(th, vm(th).global, val);
}
/**
* Alter the symbolically-named variable to have the value popped off the local stack
* @require stkSz(th) > 0, vm(th).global.isTbl()
**/
fn void Value.popGloVar(Value* th, string var)
{
// Check if there is room
stkCanIncTop(th);
Value val = sym::newSym(th, th(th).stk_top++, var);
tbl::set(th, vm(th).global, *(th(th)->stk_top-1), *(th(th)->stk_top-2));
th(*th).stk_top -= 2; // Pop key & value after value is safely in Global
}
/* Push the value of the current process thread's variable table. */
Value pushGlobal(Value th)
{
stkCanIncTop(th); /* Check if there is room */
return *th(th).stk_top++ = vm(th).global;
}
/**
* Internal function to re-allocate stack's size
* @require newsize <= STACK_MAXSIZE || newsize == STACK_ERRORSIZE
**/
fn void realloc(Value th, int newsize)
{
// Incremental GC before memory allocation events
mem::gccheck(th);
Value *oldstack = th(th).stack;
int osize = th(th).size; // size of old stack
// Ensure we not asking for more than allowed, and that old stack's values are consistent
assert(osize == 0 || ((th(th).stk_last - th(th).stack) == th(th)->size - STACK_EXTRA));
// Allocate new stack (assume success) and fill any growth with nulls
mem::reallocvector(th, th(th)->stack, th(th)->size, newsize, Value);
for (; osize < newsize; osize++)
{
th(th).stack[osize] = aNull;
}
// Correct stack values for new size
th(th)->size = newsize;
th(th)->stk_last = th(th)->stack + newsize - STACK_EXTRA;
// Correct all data stack pointers, given that data stack may have moved in memory
if (oldstack) {
CallInfo *ci;
AintIdx shift = th(th)->stack - oldstack;
th(th)->stk_top = th(th)->stk_top + shift;
for (ci = th(th)->curmethod; ci != NULL; ci = ci->previous) {
ci->end += shift;
ci->methodbase += shift;
ci->retTo += shift;
ci->begin += shift;
}
}
}
/** Internal function to grow current method's stack area by at least n past stk_top.
May double stack instead. May abort if beyond stack max. */
void stkGrow(Value th, AuintIdx extra) {
// Already past max? Abort!
if (th(th)->size > STACK_MAXSIZE) {
logSevere("Acorn VM wants to overflow max stack size. Runaway recursive method?");
return;
}
// Calculate the max between how much we need (based on requested growth)
// and doubling the stack size (capped at maximum)
AuintIdx needed = (AuintIdx)(th(th)->stk_top - th(th)->stack) + extra + STACK_EXTRA;
AuintIdx newsize = 2 * th(th)->size;
if (newsize > STACK_MAXSIZE)
newsize = STACK_MAXSIZE;
if (newsize < needed) newsize = needed;
// re-allocate stack (preserves contents)
if (newsize > STACK_MAXSIZE) {
stkRealloc(th, STACK_ERRORSIZE); // How much we give if asking for too much
}
else
stkRealloc(th, newsize);
}
/* Ensure method's stack has room for 'needed' values above top. Return 0 on failure.
* This may grow the stack, but never shrinks it.
*/
int needMoreLocal(Value th, AuintIdx needed) {
int success;
CallInfo *ci = th(th)->curmethod;
vm_lock(th);
// Check if we already have enough allocated room on stack for more values
if ((AuintIdx)(th(th)->stk_last - th(th)->stk_top) > needed + STACK_EXTRA)
success = 1; // Success! Stack is already big enough
else {
// Will this overflow max stack size?
if ((AuintIdx)(th(th)->stk_top - th(th)->stack) > STACK_MAXSIZE - needed - STACK_EXTRA)
success = 0; // Fail! - don't grow
else {
stkGrow(th, needed);
success = 1;
}
}
// adjust method's last allowed value upwards, as needed
if (success && ci->end < th(th)->stk_top + needed)
ci->end = th(th)->stk_top + needed;
vm_unlock(th);
return success;
}

999
resources/examples/notworking/acornvm/gen.c3
View File

@@ -1,999 +0,0 @@
/** Bytecode generator for Acorn compiler
*
* @file
*
* This source file is part of avm - Acorn Virtual Machine.
* See Copyright Notice in avm.h
*/
#include "acorn.h"
#ifdef __cplusplus
namespace avm {
extern "C" {
#endif
/* Create a new bytecode method value. */
void newBMethod(Value th, Value *dest) {
BMethodInfo *meth = (BMethodInfo*) mem_new(th, MethEnc, sizeof(BMethodInfo));
*dest = (Value) meth;
methodFlags(meth) = 0;
methodNParms(meth) = 1; // 'self'
meth->code = NULL;
meth->maxstacksize = 20;
meth->avail = 0;
meth->size = 0;
meth->lits = NULL;
meth->litsz = 0;
meth->nbrlits = 0;
meth->nbrexterns = 0;
meth->nbrlocals = 0;
}
/* Put new instruction in code array */
void genPutInstr(CompInfo *comp, AuintIdx loc, Instruction i) {
mem_growvector(comp->th, comp->method->code, loc, comp->method->avail, Instruction, INT_MAX);
comp->method->code[loc] = i;
}
/* Append new instruction to code array */
void genAddInstr(CompInfo *comp, Instruction i) {
mem_growvector(comp->th, comp->method->code, comp->method->size, comp->method->avail, Instruction, INT_MAX);
comp->method->code[comp->method->size++] = i;
}
/* Add a literal and return its index */
int genAddLit(CompInfo *comp, Value val) {
BMethodInfo* f = comp->method;
// See if we already have it
int i = f->nbrlits;
while (i-- > 0)
if (f->lits[i] == val)
return i;
// If not found, add it
mem_growvector(comp->th, f->lits, f->nbrlits, f->litsz, Value, INT_MAX);
if (isStr(val))
str_info(val)->flags1 |= StrLiteral; // Make strings read only
f->lits[f->nbrlits] = val;
mem_markChk(comp->th, comp, val);
return f->nbrlits++;
}
/* Indicate the method has a variable number of parameters */
void genVarParms(CompInfo *comp) {
methodFlags(comp->method) = METHOD_FLG_VARPARM;
}
/** Allocate block's local variables */
Value genLocalVars(CompInfo *comp, Value blockvarseg,int nexpected) {
Value th = comp->th;
Value svLocalVars = comp->locvarseg;
if (blockvarseg!=aNull) {
int nbrvars = arr_size(blockvarseg)-2;
if (nbrvars>0) {
comp->locvarseg = blockvarseg;
arrSet(th, comp->locvarseg, 1, anInt(comp->nextreg));
if (nbrvars-nexpected>0)
genAddInstr(comp, BCINS_ABC(OpLoadNulls, comp->nextreg+nexpected, nbrvars-nexpected, 0));
comp->nextreg += nbrvars;
if (comp->method->maxstacksize < comp->nextreg+nbrvars)
comp->method->maxstacksize = comp->nextreg+nbrvars;
}
}
return svLocalVars;
}
/* Raise method's max stack size if register is above it */
void genMaxStack(CompInfo *comp, AuintIdx reg) {
if (comp->method->maxstacksize < reg)
comp->method->maxstacksize = reg+1;
}
/** Get a node from an AST segment */
#define astGet(th, astseg, idx) (arrGet(th, astseg, idx))
void genExp(CompInfo *comp, Value astseg);
void genStmts(CompInfo *comp, Value astseg);
void genDoProp(CompInfo *comp, Value astseg, char byteop, Value rval, int nexpected);
/** Return next available register to load values into */
unsigned int genNextReg(CompInfo *comp) {
// Keep track of high-water mark for later stack allocation purposes
if (comp->method->maxstacksize < comp->nextreg+1)
comp->method->maxstacksize = comp->nextreg+1;
return comp->nextreg++;
}
/** Return register number for expression (if it already is one), otherwise return -1 */
int genExpReg(CompInfo *comp, Value astseg) {
Value th = comp->th;
if (isSym(astseg)) {
if (vmlit(SymThis) == astseg)
return comp->thisreg;
else if (vmlit(SymSelf) == astseg)
return 0;
} else {
Value op = astGet(th, astseg, 0);
if (vmlit(SymLocal) == op)
return findLocalVar(comp, astGet(th, astseg, 1));
else
return -1;
}
return -1;
}
/** Get the destination where Jump is going */
int genGetJump(CompInfo *comp, int ip) {
int offset = bc_j(comp->method->code[ip]);
if (offset == BCNO_JMP) /* point to itself represents end of list */
return BCNO_JMP; /* end of list */
else
return (ip+1)+offset; /* turn offset into absolute position */
}
/** Set the Jump instruction at ip to jump to dest instruction */
void genSetJump(CompInfo *comp, int ip, int dest) {
if (ip==BCNO_JMP)
return;
Instruction *jmp = &comp->method->code[ip];
int offset = dest-(ip+1);
assert(dest != BCNO_JMP);
if (((offset+BCBIAS_J) >> 16)!=0)
assert(0 && "control structure too long");
*jmp = setbc_j(*jmp, offset);
}
/* Set the jump instruction link chain starting at listip to jump to dest */
void genSetJumpList(CompInfo *comp, int listip, int dest) {
while (listip != BCNO_JMP) {
int next = genGetJump(comp, listip);
genSetJump(comp, listip, dest);
listip = next;
}
}
/** Generate a jump that goes forward, possibly as part of an jump chain */
void genFwdJump(CompInfo *comp, int op, int reg, int *ipchain) {
// If part of a jmp chain, add this jump to the chain
if (*ipchain != BCNO_JMP) {
// Find last jump in chain
int jumpip;
int nextip = *ipchain;
do {
jumpip = nextip;
nextip = genGetJump(comp, jumpip);
} while (nextip != BCNO_JMP);
// Fix it to point to jump we are about to generate
genSetJump(comp, jumpip, comp->method->size);
}
else
*ipchain = comp->method->size; // New chain starts with this jump
genAddInstr(comp, BCINS_AJ(op, reg, BCNO_JMP));
}
/** Generate conditional tests & appropriate jump(s), handled recursively for boolean operators.
failjump is ip for first jump past the code to run on condition's success.
passjump is ip for first jump directly to condition's success.
notflag is true if under influence of 'not' operator: reversing jumps and and/or.
lastjump specifies how last jump should behave: true for fail jump, false for passjump. true reverses jump condition. */
void genJumpExp(CompInfo *comp, Value astseg, int *failjump, int *passjump, bool notflag, bool lastjump) {
Value th = comp->th;
unsigned int svnextreg = comp->nextreg;
Value condop = isArr(astseg)? astGet(th, astseg, 0) : astseg;
bool revjump = notflag ^ lastjump; // Reverse jump based on not flag and lastjump
// Comparison ops (e.g., == or <) based on rocket operator - generation code comes later.
int jumpop;
if (condop == vmlit(SymLt)) jumpop = revjump? OpJGeN : OpJLt;
else if (condop == vmlit(SymLe)) jumpop = revjump? OpJGtN : OpJLe;
else if (condop == vmlit(SymGt)) jumpop = revjump? OpJLeN : OpJGt;
else if (condop == vmlit(SymGe)) jumpop = revjump? OpJLtN : OpJGe;
else if (condop == vmlit(SymEq)) jumpop = revjump? OpJNeN : OpJEq;
else if (condop == vmlit(SymNe)) jumpop = revjump? OpJEqN : OpJNe;
// '===' exact equivalence
else if (condop == vmlit(SymEquiv)) {
genExp(comp, astGet(th, astseg, 1));
Value arg2 = astGet(th, astseg, 2);
if (isArr(arg2) && astGet(th, arg2, 0)==vmlit(SymLit) && astGet(th, arg2, 1)==aNull) {
genFwdJump(comp, revjump? OpJNNull : OpJNull, svnextreg, lastjump? failjump : passjump);
}
else {
genExp(comp, arg2);
genFwdJump(comp, revjump? OpJDiff : OpJSame, svnextreg, lastjump? failjump : passjump);
}
comp->nextreg = svnextreg;
return;
}
// '~~' pattern match
else if (condop == vmlit(SymMatchOp)) {
genAddInstr(comp, BCINS_ABx(OpLoadLit, genNextReg(comp), genAddLit(comp, vmlit(SymMatchOp))));
genExp(comp, astGet(th, astseg, 2)); // '~~' uses right hand value for object call
genExp(comp, astGet(th, astseg, 1));
genAddInstr(comp, BCINS_ABC(OpGetCall, svnextreg, comp->nextreg - svnextreg-1, 1));
genFwdJump(comp, revjump? OpJFalse : OpJTrue, svnextreg, lastjump? failjump : passjump);
comp->nextreg = svnextreg;
return;
}
else if (condop == vmlit(SymNot)) {
genJumpExp(comp, astGet(th, astseg, 1), failjump, passjump, !notflag, lastjump);
return;
}
else if (condop == vmlit(SymOr) || condop == vmlit(SymAnd)) {
bool isAnd = (condop == vmlit(SymAnd)) ^ notflag; // Treat it as 'And' (or 'Or')?
AuintIdx segi = 1;
if (isAnd) {
while (segi < getSize(astseg)-1) {
genJumpExp(comp, astGet(th, astseg, segi++), failjump, passjump, notflag, true);
}
genJumpExp(comp, astGet(th, astseg, segi), failjump, passjump, notflag, lastjump);
return;
}
else {
int newpassjump = BCNO_JMP;
while (segi < getSize(astseg)-1) {
int newfailjump = BCNO_JMP;
genJumpExp(comp, astGet(th, astseg, segi++), &newfailjump, &newpassjump, notflag, false);
genSetJump(comp, newfailjump, comp->method->size);
}
genJumpExp(comp, astGet(th, astseg, segi), failjump, &newpassjump, notflag, lastjump);
genSetJumpList(comp, newpassjump, comp->method->size); // Fix 'or' jumps to here
return;
}
}
// Otherwise, an expression to be interpreted as false/null or true (anything else)
// (which includes explicit use of <==>)
else {
genExp(comp, astseg);
genFwdJump(comp, revjump? OpJFalse : OpJTrue, svnextreg, lastjump? failjump : passjump);
comp->nextreg = svnextreg;
return;
}
// Generate code for rocket-based comparisons
genAddInstr(comp, BCINS_ABx(OpLoadLit, genNextReg(comp), genAddLit(comp, vmlit(SymRocket))));
genExp(comp, astGet(th, astseg, 1));
genExp(comp, astGet(th, astseg, 2));
genAddInstr(comp, BCINS_ABC(OpGetCall, svnextreg, comp->nextreg - svnextreg-1, 1));
genFwdJump(comp, jumpop, svnextreg, lastjump? failjump : passjump);
comp->nextreg = svnextreg;
}
/** Generate return or yield */
void genReturn(CompInfo *comp, Value aststmt, int op, int expected) {
Value th = comp->th;
AuintIdx svnextreg = comp->nextreg;
Value retexp = astGet(th, aststmt, 1);
if (retexp==aNull)
genAddInstr(comp, BCINS_ABC(op, 0, 0, expected)); // return with no values
else {
int reg = genExpReg(comp, retexp);
// Return from a local variable registers
if (reg>=0)
genAddInstr(comp, BCINS_ABC(op, reg, 1, expected));
// Do tail call if we are calling another method as the return value
else if (op==OpReturn && isArr(retexp) && astGet(th, retexp, 0)==vmlit(SymCallProp))
genDoProp(comp, retexp, OpTailCall, aNull, 1);
// For solo splat, load parameter varargs and return them
else if (retexp == vmlit(SymSplat)) {
genAddInstr(comp, BCINS_ABC(OpLoadVararg, svnextreg, 0xFF, 0));
genAddInstr(comp, BCINS_ABC(op, svnextreg, 0xFF, expected));
}
// For comma-separated rvals, special handling in case ... splat appears (at end)
else if (isArr(retexp) && arrGet(th, retexp, 0)==vmlit(SymComma)) {
int nvals = arr_size(retexp)-1;
bool varrvals = false;
for (int i=1; i<=nvals; i++) {
Value rvali = astGet(th, retexp, i);
if (i==nvals && rvali==vmlit(SymSplat)) {
genAddInstr(comp, BCINS_ABC(OpLoadVararg, genNextReg(comp), 0xFF, 0));
varrvals = true;
}
else if (i==nvals && isArr(rvali) && astGet(th, rvali, 0)==vmlit(SymYield)) {
genReturn(comp, rvali, OpYield, 0xFF);
varrvals = true;
}
else
genExp(comp, rvali);
}
genAddInstr(comp, BCINS_ABC(op, svnextreg, varrvals? 0xFF : comp->nextreg - svnextreg, expected));
}
// Return calculated values on stack
else {
genExp(comp, retexp);
genAddInstr(comp, BCINS_ABC(op, svnextreg, comp->nextreg - svnextreg, expected));
}
}
comp->nextreg = svnextreg;
}
/** Return nonzero opcode if ast operator is a property/method call */
char genIsProp(Value th, Value op, int setflag) {
if (vmlit(SymActProp) == op)
return setflag? OpSetActProp : OpGetActProp;
else if (vmlit(SymRawProp) == op)
return setflag? OpSetProp : OpGetProp;
else if (vmlit(SymCallProp) == op)
return setflag? OpSetCall : OpGetCall;
return 0;
}
/** Generate code for some kind of property/method call.
rval is aNull for 'get' mode and either a register integer or ast segment for 'set' mode.
nexpected specifies how many return values expected from called method */
void genDoProp(CompInfo *comp, Value astseg, char byteop, Value rval, int nexpected) {
Value th = comp->th;
unsigned int svreg = comp->nextreg; // Save
// <<<< optimize here by seeing if property is a std symbol and self is in register
genExp(comp, astGet(th, astseg, 2)); // property
genExp(comp, astGet(th, astseg, 1)); // self
// Handle value to be set (if provided) as first parameter
if (isInt(rval)) // already loaded into a register
genAddInstr(comp, BCINS_ABC(OpLoadReg, genNextReg(comp), toAint(rval), 0));
else if (rval!=aNull) {
AuintIdx rvalreg = comp->nextreg;
genExp(comp, rval); // Load into next available register
comp->nextreg = rvalreg+1;
}
// Load as many parameters as we have, then do property get
bool varparms = false;
for (AuintIdx i = 3; i<getSize(astseg); i++) {
AuintIdx rvalreg = comp->nextreg;
Value parm = astGet(th, astseg, i);
if (parm == vmlit(SymSplat)) {
genAddInstr(comp, BCINS_ABC(OpLoadVararg, rvalreg, 0xFF, 0));
varparms = true;
break;
}
else if (i==getSize(astseg)-1 && isArr(parm) && arrGet(th, parm, 0)==vmlit(SymYield)) {
genReturn(comp, parm, OpYield, 0xFF);
varparms = true;
break;
}
else {
genExp(comp, parm);
comp->nextreg = rvalreg+1;
}
}
genAddInstr(comp, BCINS_ABC(byteop, svreg, varparms? 0xFF : comp->nextreg - svreg-1, nexpected));
comp->nextreg = svreg+1;
}
/** Generate code for an assignment */
void genAssign(CompInfo *comp, Value lval, Value rval) {
Value th = comp->th;
Value lvalop = isArr(lval)? astGet(th, lval, 0) : aNull;
// Handle assignment to property or method
char opcode = genIsProp(th, lvalop, true);
if (opcode)
genDoProp(comp, lval, opcode, rval, 1);
else {
// Handle parallel, local, closure, variable assignments where rval is loaded first
int nlvals = lvalop==vmlit(SymComma)? arr_size(lval)-1 : 1;
bool varrvals = false;
AuintIdx rvalreg;
if (isInt(rval))
rvalreg = toAint(rval); // rval is already in a register, so use that reg
else {
// Special handling for right-hand values for parallel assignment
rvalreg = comp->nextreg; // Save where we put rvals
int opcode;
// For method call, specify expected number of return values
if (isArr(rval) && (opcode = genIsProp(th, astGet(th, rval, 0), false))) {
genDoProp(comp, rval, opcode, aNull, nlvals);
varrvals = true;
}
else if (isArr(rval) && arrGet(th, rval, 0)==vmlit(SymYield)) {
genReturn(comp, rval, OpYield, nlvals);
varrvals = true;
}
// For solo splat, load needed number from parameter varargs
else if (rval == vmlit(SymSplat)) {
genAddInstr(comp, BCINS_ABC(OpLoadVararg, genNextReg(comp), nlvals, 0));
varrvals = true;
}
// For comma-separated rvals, special handling in case ... splat appears (at end)
else if (nlvals>1 && isArr(rval) && arrGet(th, rval, 0)==vmlit(SymComma)) {
int nvals = arr_size(rval)-1;
for (int i=1; i<=nvals; i++) {
Value rvali = astGet(th, rval, i);
if (i==nvals && i<=nlvals && rvali==vmlit(SymSplat)) {
genAddInstr(comp, BCINS_ABC(OpLoadVararg, genNextReg(comp), nlvals-i+1, 0));
varrvals = true;
}
else
genExp(comp, rvali);
}
}
else
genExp(comp, rval);
}
// Handle parallel assignment for lvals
if (vmlit(SymComma) == lvalop) {
int nrneed = varrvals? 0 : nlvals - (comp->nextreg - rvalreg);
// Ensure we fill up right values with nulls to as high as left values
if (nrneed > 0) {
genAddInstr(comp, BCINS_ABC(OpLoadNulls, comp->nextreg, nrneed, 0));
comp->nextreg += nrneed;
// Keep track of high-water mark for later stack allocation purposes
if (comp->method->maxstacksize < comp->nextreg+nrneed)
comp->method->maxstacksize = comp->nextreg+nrneed;
}
// Assign each lval, one at a time, from corresponding loaded rval in a register
for (int i = 0; i<nlvals; i++) {
genAssign(comp, astGet(th, lval, i+1), anInt(rvalreg+i));
}
}
// Load into local or closure variable
else if (vmlit(SymLocal) == lvalop) {
Value symnm = astGet(th, lval, 1);
int localreg = findLocalVar(comp, symnm);
if (localreg != -1)
genAddInstr(comp, BCINS_ABC(OpLoadReg, localreg, rvalreg, 0));
else if ((localreg = findClosureVar(comp, symnm))!=-1)
genAddInstr(comp, BCINS_ABC(OpSetClosure, localreg, rvalreg, 0));
// Load into a variable
} else if (vmlit(SymGlobal) == lvalop)
genAddInstr(comp, BCINS_ABx(OpSetGlobal, rvalreg, genAddLit(comp, astGet(th, lval, 1))));
}
// We do not consume values, so we don't restore comp->nextreg
}
/** Generate optimized code for assignment when it is just a statement and
its right-hand values do not have to be put on stack */
void genOptAssign(CompInfo *comp, Value lval, Value rval) {
Value th = comp->th;
Value lvalop = astGet(th, lval, 0);
// Handle assignments that require we load rval (and other stuff) first
unsigned int fromreg = genExpReg(comp, rval);
if (vmlit(SymLocal) == lvalop) {
Value symnm = astGet(th, lval, 1);
int localreg = findLocalVar(comp, symnm);
if (localreg != -1) {
// Optimize load straight into register, if possible (this, self, local var)
if (fromreg!=-1)
genAddInstr(comp, BCINS_ABC(OpLoadReg, localreg, fromreg, 0));
else if (vmlit(SymBaseurl) == rval)
genAddInstr(comp, BCINS_ABx(OpLoadLit, localreg, genAddLit(comp, comp->lex->url)));
else {
Value rvalop = astGet(th, rval, 0);
if (vmlit(SymLit) == rvalop) {
Value litval = astGet(th, rval, 1);
if (litval==aNull)
genAddInstr(comp, BCINS_ABC(OpLoadPrim, localreg, 0, 0));
else if (litval==aFalse)
genAddInstr(comp, BCINS_ABC(OpLoadPrim, localreg, 1, 0));
else if (litval==aTrue)
genAddInstr(comp, BCINS_ABC(OpLoadPrim, localreg, 2, 0));
else
genAddInstr(comp, BCINS_ABx(OpLoadLit, localreg, genAddLit(comp, litval)));
} else if (vmlit(SymLocal) == rvalop) {
// We did local already - this must be a load from a closure variable
genAddInstr(comp, BCINS_ABC(OpGetClosure, localreg, findClosureVar(comp, astGet(th, rval, 1)), 0));
} else if (vmlit(SymGlobal) == rvalop) {
genAddInstr(comp, BCINS_ABx(OpGetGlobal, localreg, genAddLit(comp, astGet(th, rval, 1))));
} else {
fromreg = comp->nextreg; // Save where we put rvals
genExp(comp, rval);
genAddInstr(comp, BCINS_ABC(OpLoadReg, localreg, fromreg, 0));
}
}
}
else if ((localreg = findClosureVar(comp, symnm))!=-1) {
fromreg = comp->nextreg; // Save where we put rvals
genExp(comp, rval);
genAddInstr(comp, BCINS_ABC(OpSetClosure, localreg, fromreg, 0));
}
} else if (vmlit(SymGlobal) == lvalop) {
if (fromreg != -1)
genAddInstr(comp, BCINS_ABx(OpSetGlobal, fromreg, genAddLit(comp, astGet(th, lval, 1))));
else {
fromreg = comp->nextreg; // Save where we put rvals
genExp(comp, rval);
genAddInstr(comp, BCINS_ABx(OpSetGlobal, fromreg, genAddLit(comp, astGet(th, lval, 1))));
}
} else
genAssign(comp, lval, rval);
}
/** Return true if the expression makes no use of any logical or comparative operators */
bool hasNoBool(Value th, Value astseg) {
for (AuintIdx segi = 1; segi < getSize(astseg)-1; segi++) {
Value op = astGet(th, astseg, segi);
op = isArr(op)? astGet(th, op, 0) : op;
if (vmlit(SymAnd)==op || vmlit(SymOr)==op || vmlit(SymNot)==op
|| vmlit(SymEquiv) == op || vmlit(SymMatchOp) == op
|| vmlit(SymEq)==op || vmlit(SymNe)==op
|| vmlit(SymGt)==op || vmlit(SymGe)==op || vmlit(SymLt)==op || vmlit(SymLe)==op)
return false;
}
return true;
}
/** Generate the appropriate code for something that places one or more values on the stack
beginning at comp->nextreg (which should be saved before calling this). The last value is at comp->nextreg-1 */
void genExp(CompInfo *comp, Value astseg) {
Value th = comp->th;
if (isSym(astseg)) {
if (vmlit(SymThis) == astseg)
genAddInstr(comp, BCINS_ABC(OpLoadReg, genNextReg(comp), comp->thisreg, 0));
else if (vmlit(SymSelf) == astseg)
genAddInstr(comp, BCINS_ABC(OpLoadReg, genNextReg(comp), 0, 0));
else if (vmlit(SymContext) == astseg)
genAddInstr(comp, BCINS_ABC(OpLoadContext, genNextReg(comp), 0, 0));
else if (vmlit(SymSelfMeth) == astseg)
genAddInstr(comp, BCINS_ABC(OpLoadContext, genNextReg(comp), 1, 0));
else if (vmlit(SymBaseurl) == astseg)
genAddInstr(comp, BCINS_ABx(OpLoadLit, genNextReg(comp), genAddLit(comp, comp->lex->url)));
else if (vmlit(SymSplat) == astseg)
genAddInstr(comp, BCINS_ABC(OpLoadVararg, genNextReg(comp), 1, 0)); // By default, only get one value
} else if (isArr(astseg)) {
Value op = astGet(th, astseg, 0);
char opcode = genIsProp(th, op, false);
if (opcode) // Property or method use
genDoProp(comp, astseg, opcode, aNull, 1);
else if (vmlit(SymComma) == op) {
int nvals = arr_size(astseg)-1;
for (int i=1; i<=nvals; i++)
genExp(comp, astGet(th, astseg, i));
} else if (vmlit(SymLit) == op) {
Value litval = astGet(th, astseg, 1);
if (litval==aNull)
genAddInstr(comp, BCINS_ABC(OpLoadPrim, genNextReg(comp), 0, 0));
else if (litval==aFalse)
genAddInstr(comp, BCINS_ABC(OpLoadPrim, genNextReg(comp), 1, 0));
else if (litval==aTrue)
genAddInstr(comp, BCINS_ABC(OpLoadPrim, genNextReg(comp), 2, 0));
else
genAddInstr(comp, BCINS_ABx(OpLoadLit, genNextReg(comp), genAddLit(comp, litval)));
} else if (vmlit(SymExt) == op) {
genAddInstr(comp, BCINS_ABx(OpLoadLit, genNextReg(comp), toAint(astGet(th, astseg, 1))));
} else if (vmlit(SymLocal) == op) {
Value symnm = astGet(th, astseg, 1);
Aint idx;
if ((idx = findLocalVar(comp, symnm))!=-1)
genAddInstr(comp, BCINS_ABC(OpLoadReg, genNextReg(comp), idx, 0));
else if ((idx = findClosureVar(comp, symnm))!=-1)
genAddInstr(comp, BCINS_ABC(OpGetClosure, genNextReg(comp), idx, 0));
} else if (vmlit(SymGlobal) == op) {
genAddInstr(comp, BCINS_ABx(OpGetGlobal, genNextReg(comp), genAddLit(comp, astGet(th, astseg, 1))));
} else if (vmlit(SymAssgn) == op) {
genAssign(comp, astGet(th, astseg, 1), astGet(th, astseg, 2));
} else if (vmlit(SymYield) == op) {
genReturn(comp, astseg, OpYield, 1);
} else if (vmlit(SymClosure) == op) {
Value newcloseg = astGet(th, astseg, 2);
// If no closure variables nor set method, don't generate closure, just the 'get' method
Value setmethseg = astGet(th, newcloseg, 4);
if (arr_size(newcloseg)==5 && isArr(setmethseg) && astGet(th, setmethseg, 1)==vmlit(SymNull))
genExp(comp, astGet(th, newcloseg, 3));
else
genExp(comp, newcloseg);
} else if (vmlit(SymOrAssgn) == op) {
// Assumes that lvar is a local variable
assert(astGet(th, astGet(th, astseg, 1), 0)==vmlit(SymLocal));
int varreg = findLocalVar(comp, astGet(th, astGet(th, astseg, 1), 1));
int jumpip = BCNO_JMP;
genFwdJump(comp, OpJNNull, varreg, &jumpip);
Value valseg = astGet(th, astseg, 2);
int reg = genExpReg(comp, astseg);
if (reg>=0)
genAddInstr(comp, BCINS_ABC(OpLoadReg, varreg, reg, 0));
else if (isArr(valseg) && astGet(th, valseg, 0) == vmlit(SymLit))
genAddInstr(comp, BCINS_ABx(OpLoadLit, varreg, genAddLit(comp, astGet(th, valseg, 1))));
else {
AuintIdx rreg = comp->nextreg; // Save where we put rvals
genExp(comp, valseg);
genAddInstr(comp, BCINS_ABC(OpLoadReg, varreg, rreg, 0));
}
genSetJumpList(comp, jumpip, comp->method->size);
} else if (vmlit(SymThisBlock) == op) {
unsigned int svthis = comp->thisreg;
unsigned int svthisopreg = comp->thisopreg;
comp->thisopreg = 0;
// Generate "using" operator, if specified
Value thisop = astGet(th, astseg, 3);
if (thisop != aNull) {
comp->thisopreg = comp->nextreg;
genExp(comp, thisop);
}
// Generate 'this' value
int thisreg = comp->nextreg;
genExp(comp, astGet(th, astseg, 1));
comp->nextreg = thisreg+1; // Only use first value
comp->thisreg = thisreg;
// Optimize "using" operator to a method
if (thisop != aNull)
genAddInstr(comp, BCINS_ABC(OpGetMeth, comp->thisopreg, 0, 0));
Value svLocalVars = genLocalVars(comp, astGet(th, astseg, 2), 0);
genStmts(comp, astGet(th, astseg, 4));
// Value of a this block is 'this'. Needed for returns or this blocks within this blocks.
if (thisop != aNull) {
// Move 'this' down, so its value is in the right place
genAddInstr(comp, BCINS_ABC(OpLoadReg, comp->thisopreg, comp->thisreg, 0));
comp->nextreg = comp->thisreg;
}
else
comp->nextreg = comp->thisreg+1;
comp->locvarseg = svLocalVars;
comp->thisopreg = svthisopreg;
comp->thisreg = svthis;
} else if (vmlit(SymQuestion) == op) { // Ternary
int svnextreg = comp->nextreg;
int failjump = BCNO_JMP;
int passjump = BCNO_JMP;
genJumpExp(comp, astGet(th, astseg, 1), &failjump, NULL, false, true);
int nextreg = genNextReg(comp);
comp->nextreg = svnextreg;
genExp(comp, astGet(th, astseg, 2));
genFwdJump(comp, OpJump, 0, &passjump);
genSetJumpList(comp, failjump, comp->method->size);
comp->nextreg = svnextreg;
genExp(comp, astGet(th, astseg, 3));
genSetJumpList(comp, passjump, comp->method->size);
} else if ((vmlit(SymOr)==op || vmlit(SymAnd)==op) && hasNoBool(th, astseg)) {
// 'Pure' and/or conditional processing
int svnextreg = comp->nextreg;
int jumpip = BCNO_JMP;
AuintIdx segi;
for (segi = 1; segi < getSize(astseg)-1; segi++) {
genExp(comp, astGet(th, astseg, segi));
comp->nextreg = svnextreg;
genFwdJump(comp, op==vmlit(SymOr)? OpJTrue : OpJFalse, svnextreg, &jumpip);
}
genExp(comp, astGet(th, astseg, segi));
genSetJumpList(comp, jumpip, comp->method->size);
} else if (vmlit(SymAnd)==op || vmlit(SymOr)==op || vmlit(SymNot)==op
|| vmlit(SymEquiv) == op || vmlit(SymMatchOp) == op
|| vmlit(SymEq)==op || vmlit(SymNe)==op
|| vmlit(SymGt)==op || vmlit(SymGe)==op || vmlit(SymLt)==op || vmlit(SymLe)==op)
{
// Conditional/boolean expression, resolved to 'true' or 'false'
int failjump = BCNO_JMP;
genJumpExp(comp, astseg, &failjump, NULL, false, true);
int nextreg = genNextReg(comp);
genAddInstr(comp, BCINS_ABC(OpLoadPrim, nextreg, 2, 0));
genAddInstr(comp, BCINS_AJ(OpJump, 0, 1));
genSetJumpList(comp, failjump, comp->method->size);
genAddInstr(comp, BCINS_ABC(OpLoadPrim, nextreg, 1, 0));
}
}
return;
}
/** Generate all if/elif/else blocks */
void genIf(CompInfo *comp, Value astseg) {
Value th = comp->th;
int jumpEndIp = BCNO_JMP; // Instruction pointer to first jump to end of if
// Process all condition/blocks in astseg
AuintIdx ifindx = 1; // Index into astseg for each cond/block group
do {
unsigned int savereg = comp->nextreg;
// Generate conditional jump for bypassing block on condition failure
Value condast = astGet(th, astseg, ifindx);
Value svLocalVars = genLocalVars(comp, astGet(th, astseg, ifindx+1), 0);
int jumpNextIp = BCNO_JMP; // Instruction pointer to jump to next elif/else block
if (condast != vmlit(SymElse)) {
unsigned int condreg = comp->nextreg;
genJumpExp(comp, condast, &jumpNextIp, NULL, false, true);
comp->nextreg = condreg;
}
genStmts(comp, astGet(th, astseg, ifindx+2)); // Generate block
// Generate/fix jumps after clause's block
if (condast != vmlit(SymElse)) {
if (ifindx+2 < getSize(astseg))
genFwdJump(comp, OpJump, 0, &jumpEndIp);
genSetJumpList(comp, jumpNextIp, comp->method->size); // Fix jumps to next elif/else block
}
comp->locvarseg = svLocalVars;
comp->nextreg = savereg;
ifindx += 3;
} while (ifindx < getSize(astseg));
genSetJumpList(comp, jumpEndIp, comp->method->size); // Fix jumps to end of 'if'
}
/* Generate specific match call */
void genMatchWith(CompInfo *comp, Value pattern, unsigned int matchreg, int nexpected) {
// pattern '~~' matchval
comp->nextreg = matchreg+2;
genAddInstr(comp, BCINS_ABC(OpLoadReg, genNextReg(comp), matchreg+1, 0));
genExp(comp, pattern);
comp->nextreg = matchreg+4; // only want one value from genExp
genAddInstr(comp, BCINS_ABC(OpLoadReg, genNextReg(comp), matchreg, 0));
genAddInstr(comp, BCINS_ABC(OpGetCall, matchreg+2, 2, nexpected==0? 1 : nexpected));
}
/** Generate match block */
void genMatch(CompInfo *comp, Value astseg) {
Value th = comp->th;
int jumpEndIp = BCNO_JMP; // Instruction pointer of first jump to end of match
unsigned int matchreg = comp->nextreg;
genExp(comp, astGet(th, astseg, 1));
Value mtchmethexp = astGet(th, astseg, 2);
if (mtchmethexp==vmlit(SymMatchOp))
genAddInstr(comp, BCINS_ABx(OpLoadLit, genNextReg(comp), genAddLit(comp, mtchmethexp)));
else
genExp(comp, mtchmethexp);
// Process all 'with' blocks in astseg
AuintIdx mtchindx = 3; // Index into astseg for each 'with' block
while (mtchindx < getSize(astseg)) {
comp->nextreg = matchreg+2;
Value condast = astGet(th, astseg, mtchindx);
int nexpected = toAint(astGet(th, astseg, mtchindx+2));
// Perform match and then bypass block on failure
int jumpNextIp = BCNO_JMP; // Instruction pointer to jump past this block
if (isArr(condast) && arrGet(th, condast, 0)==vmlit(SymComma)) {
int jumpDoIp = BCNO_JMP;
for (AuintIdx i=1; i<arr_size(condast); i++) {
genMatchWith(comp, arrGet(th,condast,i), matchreg, nexpected);
if (i==arr_size(condast)-1)
genFwdJump(comp, OpJFalse, matchreg+2, &jumpNextIp);
else
genFwdJump(comp, OpJTrue, matchreg+2, &jumpDoIp);
}
genSetJumpList(comp, jumpDoIp, comp->method->size); // Fix jumps to block
}
else if (condast != vmlit(SymElse)) {
genMatchWith(comp, condast, matchreg, nexpected);
genFwdJump(comp, OpJFalse, matchreg+2, &jumpNextIp);
}
comp->nextreg = matchreg+2;
Value svLocalVars = genLocalVars(comp, astGet(th, astseg, mtchindx+1), nexpected);
genStmts(comp, astGet(th, astseg, mtchindx+3)); // Generate block
// Generate/fix jumps after clause's block
if (condast != vmlit(SymElse)) {
if (mtchindx+2 < getSize(astseg))
genFwdJump(comp, OpJump, 0, &jumpEndIp);
genSetJumpList(comp, jumpNextIp, comp->method->size); // Fix jumps to next with/else block
}
comp->locvarseg = svLocalVars;
mtchindx += 4;
}
genSetJumpList(comp, jumpEndIp, comp->method->size); // Fix jumps to end of 'match'
comp->nextreg = matchreg;
}
/** Generate while block */
void genWhile(CompInfo *comp, Value astseg) {
Value th = comp->th;
unsigned int savereg = comp->nextreg;
// Allocate block's local variables
Value svLocalVars = genLocalVars(comp, astGet(th, astseg, 1), 0);
// Perform conditional expression and jump
int svJumpBegIp = comp->whileBegIp;
int svJumpEndIp = comp->whileEndIp;
comp->whileBegIp = comp->method->size;
comp->whileEndIp = BCNO_JMP;
genJumpExp(comp, astGet(th, astseg, 2), &comp->whileEndIp, NULL, false, true);
// Generate block and jump to beginning. Fix conditional jump to after 'while' block
genStmts(comp, astGet(th, astseg, 3)); // Generate block
genAddInstr(comp, BCINS_AJ(OpJump, 0, comp->whileBegIp - comp->method->size-1));
genSetJumpList(comp, comp->whileEndIp, comp->method->size); // Fix jump to end of 'while' block
// Restore block's saved values
comp->nextreg = savereg;
comp->whileBegIp = svJumpBegIp;
comp->whileEndIp = svJumpEndIp;
comp->locvarseg = svLocalVars;
}
/** Generate each block */
void genEach(CompInfo *comp, Value astseg) {
Value th = comp->th;
unsigned int savereg = comp->nextreg;
// Prepare iterator for 'each' block outside of main loop (loaded in savereg)
Value iter = astGet(th, astseg, 3);
if (iter == vmlit(SymSplat))
genAddInstr(comp, BCINS_ABx(OpLoadLit, genNextReg(comp), genAddLit(comp, anInt(0))));
else {
int fromreg = genExpReg(comp, iter);
if (fromreg==-1) {
genExp(comp, iter);
genAddInstr(comp, BCINS_ABC(OpEachPrep, savereg, savereg, 0));
}
else
genAddInstr(comp, BCINS_ABC(OpEachPrep, genNextReg(comp), fromreg, 0));
}
// Allocate block's local variables
Value svLocalVars = genLocalVars(comp, astGet(th, astseg, 1), 0);
// Perform conditional expression and jump
int svJumpBegIp = comp->whileBegIp;
int svJumpEndIp = comp->whileEndIp;
comp->whileBegIp = comp->method->size;
comp->whileEndIp = BCNO_JMP;
genAddInstr(comp, BCINS_ABC(iter == vmlit(SymSplat)? OpEachSplat : OpEachCall, savereg, 0, toAint(astGet(th, astseg,2))));
genFwdJump(comp, OpJFalse, savereg+1, &comp->whileEndIp);
// Generate block and jump to beginning. Fix conditional jump to after 'while' block
genStmts(comp, astGet(th, astseg, 4)); // Generate block
genAddInstr(comp, BCINS_AJ(OpJump, 0, comp->whileBegIp - comp->method->size-1));
genSetJumpList(comp, comp->whileEndIp, comp->method->size); // Fix jump to end of 'while' block
// Restore block's saved values
comp->nextreg = savereg;
comp->whileBegIp = svJumpBegIp;
comp->whileEndIp = svJumpEndIp;
comp->locvarseg = svLocalVars;
}
/** Generate do block */
void genDo(CompInfo *comp, Value astseg) {
Value th = comp->th;
unsigned int savereg = comp->nextreg;
unsigned int lowreg, highreg;
Value svLocalVars = genLocalVars(comp, astGet(th, astseg, 1), 0);
Value exp = astGet(th, astseg, 2);
if (exp!=aNull) {
lowreg = comp->nextreg;
genExp(comp, exp);
highreg = comp->nextreg;
for (unsigned int reg=lowreg; reg<highreg; reg++) {
genAddInstr(comp, BCINS_ABx(OpLoadLit, genNextReg(comp), genAddLit(comp, vmlit(SymBegin))));
genAddInstr(comp, BCINS_ABC(OpLoadReg, genNextReg(comp), reg, 0));
genAddInstr(comp, BCINS_ABC(OpGetCall, highreg, 1, 0));
}
}
genStmts(comp, astGet(th, astseg, 3));
if (exp!=aNull) {
comp->nextreg = highreg;
for (unsigned int reg=highreg-1; reg>=lowreg; reg--) {
genAddInstr(comp, BCINS_ABx(OpLoadLit, genNextReg(comp), genAddLit(comp, vmlit(SymEnd))));
genAddInstr(comp, BCINS_ABC(OpLoadReg, genNextReg(comp), reg, 0));
genAddInstr(comp, BCINS_ABC(OpGetCall, highreg, 1, 0));
}
}
// Restore block's saved values
comp->nextreg = savereg;
comp->locvarseg = svLocalVars;
}
/** Generate a statement */
void genStmt(CompInfo *comp, Value aststmt) {
Value th = comp->th;
AuintIdx svnextreg = comp->nextreg;
// Set up a call for every statement
AuintIdx svthisopreg;
if (comp->thisopreg != 0) {
svthisopreg = comp->nextreg;
// We have to copy this+method, because the method's tail call may destroy them
genAddInstr(comp, BCINS_ABC(OpLoadRegs, genNextReg(comp), comp->thisopreg, 2));
comp->nextreg++;
}
// Handle various kinds of statements
Value op = isArr(aststmt)? astGet(th, aststmt, 0) : aststmt;
if (op==vmlit(SymIf)) genIf(comp, aststmt);
else if (op==vmlit(SymMatch)) genMatch(comp, aststmt);
else if (op==vmlit(SymWhile)) genWhile(comp, aststmt);
else if (op==vmlit(SymEach)) genEach(comp, aststmt);
else if (op==vmlit(SymDo)) genDo(comp, aststmt);
else if (op==vmlit(SymBreak) && comp->whileBegIp!=-1)
genFwdJump(comp, OpJump, 0, &comp->whileEndIp);
else if (op==vmlit(SymContinue) && comp->whileBegIp!=-1)
genAddInstr(comp, BCINS_AJ(OpJump, 0, comp->whileBegIp - comp->method->size-1));
else if (op==vmlit(SymReturn))
genReturn(comp, aststmt, OpReturn, 0);
else if (op==vmlit(SymYield))
genReturn(comp, aststmt, OpYield, 0);
else if (op==vmlit(SymAssgn))
genOptAssign(comp, astGet(th, aststmt,1), astGet(th, aststmt,2));
else
genExp(comp, aststmt);
// Finish append (or other this op)
if (comp->thisopreg != 0)
genAddInstr(comp, BCINS_ABC(OpGetCall, svthisopreg, comp->nextreg - svthisopreg-1, 0));
comp->nextreg = svnextreg;
}
/** Generate one or a sequence of statements */
void genStmts(CompInfo *comp, Value astseg) {
Value th = comp->th;
if (isArr(astseg) && astGet(comp->th, astseg, 0)==vmlit(SymSemicolon)) {
for (AuintIdx i=1; i<getSize(astseg); i++) {
genStmt(comp, astGet(comp->th, astseg, i));
}
}
else
genStmt(comp, astseg);
}
#define astAddValue(th, astseg, val) (arrAdd(th, astseg, val))
Value astAddSeg(Value th, Value oldseg, Value astop, AuintIdx size);
Value astAddSeg2(Value th, Value oldseg, Value astop, Value val);
Value astInsSeg(Value th, Value oldseg, Value astop, AuintIdx size);
/** Recursively turn a method's implicit returns in the AST into explicit returns */
void genFixReturns(CompInfo *comp, Value aststmts) {
Value th = comp->th;
if (!isArr(aststmts) || astGet(th, aststmts, 0)!=vmlit(SymSemicolon)) {
vmLog("A method's block is not properly formed (should use ';' AST)");
return;
}
Value laststmt = astGet(th, aststmts, arr_size(aststmts)-1);
Value lastop = isArr(laststmt)? astGet(th, laststmt, 0) : laststmt;
// Implicit return for loops is to return 'null' afterwards
if (lastop==vmlit(SymWhile) || lastop==vmlit(SymEach) || lastop==vmlit(SymDo)
|| lastop==vmlit(SymYield) || lastop==vmlit(SymBreak) || lastop==vmlit(SymContinue))
astAddSeg2(th, aststmts, vmlit(SymReturn), aNull);
// Implicit return for 'if'
else if (lastop==vmlit(SymIf) || lastop==vmlit(SymMatch)) {
// Recursively handle implicit return for each clause's statement block
int step = lastop==vmlit(SymMatch)? 4 : 3;
Auint i = lastop==vmlit(SymMatch)? 6 : 3;
for (; i<arr_size(laststmt); i+=step)
genFixReturns(comp, astGet(th, laststmt, i));
// If 'if' or 'match' has no 'else', add one that returns null
if (astGet(th, laststmt, i-step-step+1)!=vmlit(SymElse)) {
astAddValue(th, laststmt, vmlit(SymElse));
astAddValue(th, laststmt, aNull);
if (lastop==vmlit(SymMatch))
astAddValue(th, laststmt, anInt(0));
astAddSeg2(th, laststmt, vmlit(SymReturn), aNull);
}
}
// Replace non-return expression statement with 'return' in front
else if (lastop!=vmlit(SymReturn))
astInsSeg(th, aststmts, vmlit(SymReturn), 2);
}
/* Generate a complete byte-code method by walking the
* Abstract Syntax Tree generated by the parser */
void genBMethod(CompInfo *comp) {
Value th = comp->th;
// AST: ('method', localvars, closurevars, parminitstmts, statements)
// Initialize generation state for method
comp->method->nbrexterns = comp->method->nbrlits;
comp->nextreg = comp->method->maxstacksize = comp->method->nbrlocals;
comp->thisreg = 0; // Starts with 'self'
comp->thisopreg = 0;
comp->locvarseg = astGet(comp->th, comp->ast, 1);
arrSet(th, comp->locvarseg, 1, anInt(1));
// If 'self' is bound to this closure, override passed self with it
int idx;
if ((idx = findClosureVar(comp, vmlit(SymSelf)))!=-1)
genAddInstr(comp, BCINS_ABC(OpGetClosure, 0, idx, 0));
// Generate the method's code based on AST
int nbrnull = comp->method->nbrlocals - methodNParms(comp->method);
if (nbrnull>0) // Initialize non-parm locals to null
genAddInstr(comp, BCINS_ABC(OpLoadNulls, methodNParms(comp->method), nbrnull, 0));
genStmts(comp, astGet(th, comp->ast, 2)); // Generate code for parameter defaults
Value aststmts = astGet(th, comp->ast, 3);
genFixReturns(comp, aststmts); // Turn implicit returns into explicit returns
genStmts(comp, aststmts); // Generate method's code block
}
#ifdef __cplusplus
} // extern "C"
} // namespace avm
#endif

693
resources/examples/notworking/acornvm/lexer.c3
View File

@@ -1,693 +0,0 @@
module acorn::lex;
/** Lexer for Acorn compiler
*
* @file
*
* This source file is part of avm - Acorn Virtual Machine.
* See Copyright Notice in avm.h
*/
/**
* Crude algorithm for determining if character is a Unicode letter
*/
fn bool isualpha(Auchar c) @inline
{
return c > 0xA0 || isalpha(c);
}
/**
* Algorithm for determining if character is a digit 0-9
*/
fn bool isudigit(Auchar c) @inline
{
return c >= '0' && c <= '9';
}
/**
* Return a new LexInfo value, lexer context for a source program
*/
fn Value new(Value th, Value *dest, Value src, Value url)
{
LexInfo *lex;
// Create an lexer object
lex = mem::new(th, LexEnc, sizeof(LexInfo));
// Values
lex.token = aNull;
lex.th = th;
lex.source = src;
mem::markChk(th, lex, src);
lex.url = url;
mem::markChk(th, lex, url);
// Position info (ignoring initial UTF8 byte-order mark)
// TODO
lex.bytepos = lex.linebeg = getSize(src) >= 3 && 0 == strncmp("\xEF\xBB\xBF", toStr(src), 3) ? 3 : 0;
lex.linenbr = 1;
// indent state
lex.curindent = lex.newindent = 0;
lex.newline = false;
lex.newprogram = true;
lex.insertSemi = false;
lex.undentcont = false;
lex.optype = 0;
return *dest = (Value)(lex);;
}
/** Return the current unicode character whose UTF-8 bytes start at lex->bytepos */
fn Auchar LexInfo.thischar(LexInfo* lex)
{
byte *src = &toStr(lex.source)[lex.bytepos];
int nbytes;
Auchar chr;
// Get info from first UTF-8 byte
if ((*src&0xF0) == 0xF0) { nbytes=4; chr = *src&0x07;}
else if ((*src&0xE0) == 0xE0) {nbytes=3; chr = *src&0x0F;}
else if ((*src&0xC0) == 0xC0) {nbytes=2; chr = *src&0x1F;}
else if ((*src&0x80) == 0x00) {nbytes=1; chr = *src&0x7F;}
else {nbytes=1; chr = 0;} // error
// Obtain remaining bytes
while (--nbytes)
{
src++;
if (*src & 0xC0 ==0x80) chr = chr << 6 + *src & 0x3F;
}
return chr;
}
/** Return the current unicode character whose UTF-8 bytes start at lex->bytepos */
fn Auchar LexInfo.nextchar(LexInfo* lex)
{
const char *src = &toStr(lex->source)[lex->bytepos];
int nbytes;
Auchar chr;
// Skip past current character
if ((*src&0xF0) == 0xF0) {nbytes=4;}
else if ((*src&0xE0) == 0xE0) {nbytes=3;}
else if ((*src&0xC0) == 0xC0) {nbytes=2;}
else if ((*src&0x80) == 0x00) {nbytes=1;}
else {nbytes=1;} // error
src += nbytes;
// Get info from first UTF-8 byte
if ((*src&0xF0) == 0xF0) {nbytes=4; chr = *src&0x07;}
else if ((*src&0xE0) == 0xE0) {nbytes=3; chr = *src&0x0F;}
else if ((*src&0xC0) == 0xC0) {nbytes=2; chr = *src&0x1F;}
else if ((*src&0x80) == 0x00) {nbytes=1; chr = *src&0x7F;}
else {nbytes=1; chr = 0;} // error
// Obtain remaining bytes
while (--nbytes) {
src++;
if ((*src&0xC0)==0x80)
chr = (chr<<6) + (*src&0x3F);
}
return chr;
}
/** Skip lex->bytepos past the unicode character whose UTF-8 bytes start at lex->bytepos */
fn void LexInfo.skipchar(LexInfo* lex)
{
const char *src = &toStr(lex->source)[lex->bytepos];
int nbytes;
if (*src=='\0')
return;
// Get character size from first byte
if ((*src&0xF0) == 0xF0) {nbytes=4;}
else if ((*src&0xE0) == 0xE0) {nbytes=3;}
else if ((*src&0xC0) == 0xC0) {nbytes=2;}
else if ((*src&0x80) == 0x00) {nbytes=1;}
else {nbytes=1;} // error
lex->bytepos += nbytes;
}
/** Return true if at end of source */
#define lex_isEOF(lex) (lex_thischar(lex) == '\0')
/** Scan past non-tokenized white space.
* Handle line indentation and continuation */
fn bool LexInfo.scanWhite(LexInfo *lex)
{
Value th = lex.th; // for vmlit
// Insert semicolon as a token as if requested by implied closing brace
if (lex.insertSemi)
{
lex.insertSemi = false;
lex.toktype=Res_Token;
lex.token=vmlit(SYM_SEMICOLON);
return true;
}
// Ignore all forms of white space
Auchar chr;
bool lookForWhiteSpace = true;
while (lookForWhiteSpace) {
switch (chr=lex_thischar(lex)) {
// Skip past spaces and tabs
case ' ':
case '\t':
lex_skipchar(lex);
break;
case '\r':
UNREACHABLE
// Skip past new line
case '\n':
lex->linenbr++;
lex->linebeg = lex->bytepos;
lex->newline = true;
lex_skipchar(lex);
// Count line-leading tabs
lex->newindent = 0;
while (lex_thischar(lex)=='\t') {
lex->newindent++;
lex_skipchar(lex);
}
// Handle continuation.
if (lex_thischar(lex)=='\\') {
// Undenting requires we spawn some semi-colons and right braces
if (lex->newindent < lex->curindent)
lex->undentcont = true;
else {
lex->newline = false;
// Pretend indent did not change for extra-indented continuation
if (lex->newindent > lex->curindent)
lex->newindent = lex->curindent;
}
lex_skipchar(lex);
}
break;
// Skip comment starting with '#' until end of line
case '#':
{
const char *scanp = &toStr(lex->source)[lex->bytepos];
if (strncmp("###" as scanp, 3)) {
// Inline comment skips to end of line
while (!lex_isEOF(lex) && lex_thischar(lex)!='\n')
lex_skipchar(lex);
break;
}
// Multi-line comment goes until next '###'
scanp+=3;
while (*scanp && 0!=strncmp("###", scanp, 3)) {
if (*scanp=='\n')
lex->linenbr++;
scanp++;
}
if (*scanp)
scanp+=3;
lex->bytepos += scanp - &toStr(lex->source)[lex->bytepos];
}
break;
default:
lookForWhiteSpace = false;
break;
}
}
// Mark start of a real token
lex->tokbeg = lex->bytepos;
lex->toklinepos = lex->tokbeg - lex->linebeg;
lex->tokline = lex->linenbr;
// We now know the next character starts a real token
// But first, we must handle insertion of ; { and } characters
// depending on the indentation changes and newline flag
// Handle increasing indentation
if (lex->newindent > lex->curindent) {
lex->toktype=Res_Token;
lex->token=vmlit(SymLBrace);
lex->curindent++;
lex->newline = false;
return true;
}
// Do not generate leading ';'
if (lex->newprogram)
lex->newprogram = lex->newline = false;
// End previous line's statement with a ';'
if (lex->newline) {
lex->toktype=Res_Token;
lex->token=vmlit(SymSemicolon);
lex->newline = false;
return true;
}
// Ensure end-of-file flushes all indent levels to 0
if (lex_isEOF(lex))
lex->newindent = 0;
// Handle decreasing indentation
if (lex->newindent < lex->curindent) {
lex->toktype=Res_Token;
lex->token=vmlit(SymRBrace);
lex->curindent--;
if (lex->undentcont && lex->newindent==lex->curindent)
lex->undentcont = false; // Continued line at right indent now. No semi-colon.
else
lex->insertSemi = true; // Insert semi-colon after implied closing brace
return true;
}
return false;
}
/** End of source program is a token */
bool lexScanEof(LexInfo *lex) {
if (!lex_isEOF(lex))
return false;
lex->toktype = Eof_Token;
return true;
}
/** Tokenize an integer or floating point number */
bool lexScanNumber(LexInfo *lex) {
// A number token's first character is always 0-9
// We cannot handle negative sign here, as it might be a subtraction
if (!isudigit(lex_thischar(lex)))
return false;
int base = 10;
bool exp = false;
int digval = 0;
long nbrval = 0;
// A leading zero may indicate a non-base 10 number
if (lex_thischar(lex)=='0') {
lex_skipchar(lex);
if (toupper(lex_thischar(lex))=='X') {base = 16; lex_skipchar(lex);}
// else if (toupper(lex_thischar(lex))=='B') {base = 2; lex_skipchar(lex);}
else if (toupper(lex_thischar(lex))=='.') {base = -1; lex_skipchar(lex);}
// else base = 8;
}
// Validate and process remaining numeric digits
while (1) {
// Handle characters in a suspected integer
if (base>0) {
// Decimal point means it is floating point after all
if (base==10 && lex_thischar(lex)=='.') {
// If next character is a symbol/range, treat '.' as method operator instead
Auchar nchr = lex_nextchar(lex);
if (isualpha(nchr) || nchr=='_' || nchr=='$' || nchr=='(' || nchr=='\'' || nchr=='.')
break;
lex_skipchar(lex);
base = -1;
continue;
}
// Extract a number digit value from the character
if (isudigit(lex_thischar(lex)))
digval = lex_thischar(lex)-'0';
else if (isalpha(lex_thischar(lex)))
digval = toupper(lex_thischar(lex))-'A'+10;
else
break;
// Ensure digit is within base, then process
if (digval>=base)
break;
nbrval = nbrval*base + digval;
lex_skipchar(lex);
}
// Validate characters in a floating point number
else {
// Only one exponent allowed
if (!exp && toupper(lex_thischar(lex))=='E') {
exp = true;
lex_skipchar(lex);
if (lex_thischar(lex)=='-')
lex_skipchar(lex);
continue;
}
if (!isudigit(lex_thischar(lex)))
break;
lex_skipchar(lex);
}
}
// Set value and type
if (base>=0) {
lex->token = anInt(nbrval);
lex->toktype = Lit_Token;
}
else {
lex->token = aFloat((Afloat) atof(&toStr(lex->source)[lex->tokbeg]));
lex->toktype = Lit_Token;
}
return true;
}
/** List of all reserved names (excluding literals) */
VmLiterals ReservedNames[] @private = {
SymAnd,
SymAsync,
SymBaseurl,
SymBreak,
SymContext,
SymContinue,
SymDo,
SymEach,
SymElse,
SymElif,
SymIf,
SymIn,
SymInto,
SymLocal,
SymMatch,
SymNot,
SymOr,
SymReturn,
SymSelf,
SymSelfMeth,
SymThis,
SymUsing,
SymWait,
SymWhile,
SymWith,
SymYield
};
/** Tokenize a name. The result could be Name_Token (e.g., for variables)
* Res_Token, a reserved keyword, or Lit_Token for null, false and true. */
bool lexScanName(LexInfo *lex) {
// Name token's first character is always a-z, _ or $
Auchar chr = lex_thischar(lex);
if (!(isualpha(chr) || chr=='_' || chr=='$'))
return false;
// Walk through all valid characters in name
lex_skipchar(lex);
while ((chr=lex_thischar(lex))=='_' || chr=='$' || isudigit(chr) || isualpha(chr))
lex_skipchar(lex);
// Allow ? as trailing character
if (chr=='?')
lex_skipchar(lex);
// Create name token as a symbol
newSym(lex->th, &lex->token, &toStr(lex->source)[lex->tokbeg], lex->bytepos - lex->tokbeg);
mem_markChk(lex->th, lex, lex->token);
// If it is a reserved name for a literal, say so.
Value th = lex->th;
lex->toktype = Lit_Token;
if (lex->token == vmlit(SymNull)) {lex->token = aNull; return true;}
else if (lex->token == vmlit(SymFalse)) {lex->token = aFalse; return true;}
else if (lex->token == vmlit(SymTrue)) {lex->token = aTrue; return true;}
// If it is a reserved name, set toktype to say so
VmLiterals *vmtblendp = &ReservedNames[sizeof(ReservedNames)/sizeof(VmLiterals)];
for (VmLiterals *vmtblp = ReservedNames; vmtblp<vmtblendp; vmtblp++) {
if (lex->token == vmlit(*vmtblp)) {
lex->toktype = Res_Token;
return true;
}
}
lex->toktype = Name_Token;
return true;
}
/** Tokenize a string (double quotes) or symbol (single quotes)
* Handle escape sequences. Ignore line-end and leading tabs for multi-line. */
bool lexScanString(LexInfo *lex) {
// String token's first character should be a quote mark
Auchar quotemark = lex_thischar(lex);
if (!(quotemark=='"' || quotemark=='\'' ))
return false;
lex_skipchar(lex);
// Create a string value to place the contents into
const char *begp = &toStr(lex->source)[lex->bytepos];
const char *scanp = strchr(begp, quotemark); // An estimate, as it may not be the end
Value buildstr = pushStringl(lex->th, aNull, NULL, scanp==NULL? strlen(begp) : scanp-begp);
// Repetitively scan source looking for various delimiters
scanp = begp;
while (*scanp && *scanp!=quotemark) {
// Process any escape sequences within the string
if (*scanp=='\\') {
// Copy over string segment up to the escape sequence
if (scanp-begp > 0)
strAppend(lex->th, buildstr, begp, scanp-begp);
// Process escape sequence
switch (*++scanp) {
case 'n': strAppend(lex->th, buildstr, "\n", 1); scanp++; break;
case 'r': strAppend(lex->th, buildstr, "\r", 1); scanp++; break;
case 't': strAppend(lex->th, buildstr, "\t", 1); scanp++; break;
case 'u': case 'U':
{
// Convert a hexadecimal string of cnt digits to a unicode character
Auchar unichar=0;
int cnt = *scanp=='u'? 4 :8;
if (*(scanp+1)=='+')
scanp++;
while (*++scanp && cnt--) {
if (isudigit(*scanp))
unichar = unichar*16 + *scanp -'0';
if (isalpha(*scanp) && toupper(*scanp)<='F')
unichar = unichar*16 + toupper(*scanp)-'A'+10;
}
// Encode an unicode character into UTF-8 bytes
char utf8str[8];
char *utfp=&utf8str[sizeof(utf8str)-1];
*utfp-- = '\0'; // make it a sizeable string
if (unichar < 0x7f) {
*utfp = (char)unichar;
strAppend(lex->th, buildstr, utfp, 1);
}
else {
// multi-byte encoding, byte by byte backwards
int cnt=0;
while (unichar) {
cnt++;
char byt = unichar & 0x3f;
unichar = unichar >> 6;
// Put appropriate flags if it is the first byte
if (unichar==0) {
switch (cnt) {
case 2: *utfp = byt | 0xC0; break;
case 3: *utfp = byt | 0xE0; break;
case 4: *utfp = byt | 0xF0; break;
case 5: *utfp = byt | 0xF8; break;
case 6: *utfp = byt | 0xFC; break;
}
}
else
*utfp-- = byt | 0x80;
}
strAppend(lex->th, buildstr, utfp, cnt);
}
}
break;
default: strAppend(lex->th, buildstr, scanp, 1); scanp++; break;
}
begp=scanp;
}
// Ignore line end and line leading tabs
else if (*scanp=='\r' || *scanp=='\n') {
// Copy over string segment up to the escape sequence
if (scanp-begp > 0)
strAppend(lex->th, buildstr, begp, scanp-begp);
// Ignore line end and leading tabs
while (*scanp=='\r' || *scanp=='\n' || *scanp=='\t') {
if (*scanp=='\n')
lex->linenbr++;
scanp++;
}
begp=scanp;
}
// Otherwise process rest of string
else
scanp++;
}
// Copy over rest of string segment
if (scanp-begp > 0)
strAppend(lex->th, buildstr, begp, scanp-begp);
// Update lex position
if (*scanp==quotemark)
*scanp++;
lex->bytepos += scanp - &toStr(lex->source)[lex->bytepos];
// Create string (or symbol)
lex->toktype = Lit_Token;
if (quotemark=='"')
lex->token = buildstr;
else
newSym(lex->th, &lex->token, toStr(buildstr), getSize(buildstr));
mem_markChk(lex->th, lex, lex->token);
popValue(lex->th); // buildstr
return true;
}
/** Tokenize a punctuation-oriented operator symbol.
* By this point we take at least one character, unless multi-char op is recognized. */
bool lexScanResource(LexInfo *lex) {
if (lex_thischar(lex)!='@')
return false;
Value th = lex->th;
lex_skipchar(lex);
Auchar delim = lex_thischar(lex);
if (delim=='\'' || delim=='"' || delim=='(' || delim<=' ') {
lex->token = vmlit(SymAt);
lex->toktype = Res_Token;
return true;
}
// Mark beginning and look for end of url
const char *begp = &toStr(lex->source)[lex->bytepos];
const char *scanp = begp;
while ((unsigned char)(*++scanp)>' '); // end with space, tab, cr, lf, eof, etc.
lex->bytepos += scanp - begp;
// Create +Resource from literal url, and return it as token
pushValue(th, vmlit(SymNew));
pushValue(th, vmlit(TypeResc));
pushStringl(th, aNull, begp, scanp-begp);
pushValue(th, lex->url);
getCall(th, 3, 1);
lex->token = getFromTop(th, 0);
mem_markChk(lex->th, lex, lex->token);
popValue(th);
lex->toktype = Url_Token;
return true;
}
/** Tokenize a punctuation-oriented operator symbol.
* By this point we take at least one character, unless multi-char op is recognized. */
bool lexScanOp(LexInfo *lex) {
const char *begp = &toStr(lex->source)[lex->bytepos];
Auchar ch1 = lex_thischar(lex);
lex_skipchar(lex);
Auchar ch2 = lex_thischar(lex);
// Look for 2- and 3- character combos
if (ch1=='.' && ch2=='.') {
if ('.'==lex_nextchar(lex)) lex_skipchar(lex);
lex_skipchar(lex);
} else if (ch1=='=' && ch2=='=') {
if ('='==lex_nextchar(lex)) lex_skipchar(lex);
lex_skipchar(lex);
} else if (ch1=='<' && ch2=='=') {
if ('>'==lex_nextchar(lex)) lex_skipchar(lex);
lex_skipchar(lex);
} else if ((ch1=='>' && ch2=='=')
|| (ch1=='!' && ch2=='=')
|| (ch1=='~' && ch2=='~')
|| (ch1=='<' && ch2=='<')
|| (ch1=='>' && ch2=='>')
|| (ch1=='+' && ch2=='=')
|| (ch1=='-' && ch2=='=')
|| (ch1=='*' && ch2=='=')
|| (ch1=='/' && ch2=='=')
|| (ch1=='.' && ch2==':')
|| (ch1==':' && ch2==':')
|| (ch1==':' && ch2=='=')
|| (ch1=='&' && ch2=='&')
|| (ch1=='|' && ch2=='|')
|| (ch1=='*' && ch2=='*')
|| (ch1=='.' && ch2=='&')
|| (ch1=='+' && ch2=='[')
|| (ch1=='*' && ch2=='[')
) lex_skipchar(lex);
newSym(lex->th, &lex->token, begp, &toStr(lex->source)[lex->bytepos]-begp);
mem_markChk(lex->th, lex, lex->token);
lex->toktype = Res_Token;
return true;
}
/* Get the next token */
fn void LexInfo.getNextToken(LexInfo *lex)
{
// Scan until we find a token
(!lex.scanWhite()
&& !lex.scanEof()
&& !lex.scanNumber()
&& !lex.scanName()
&& !lex.scanString()
&& !lex.scanResource()
&& !lex.scanOp());
#ifdef COMPILERLOG
switch (lex->toktype) {
case Lit_Token: {
pushSerialized(lex->th, lex->token);
vmLog("Literal token: %s", toStr(getFromTop(lex->th, 0)));
popValue(lex->th);
} break;
case Url_Token: {
pushSerialized(lex->th, lex->token);
vmLog("Literal url token: %s", toStr(getFromTop(lex->th, 0)));
popValue(lex->th);
} break;
case Name_Token: {
pushSerialized(lex->th, lex->token);
vmLog("Name token: %s", toStr(getFromTop(lex->th, 0)));
popValue(lex->th);
} break;
case Res_Token: {
pushSerialized(lex->th, lex->token);
vmLog("Reserved token: %s", toStr(getFromTop(lex->th, 0)));
popValue(lex->th);
} break;
}
#endif
}
/* Match current token to a reserved symbol. */
bool lexMatch(LexInfo *lex, const char *sym) {
return (lex->toktype==Res_Token && 0==strcmp(sym, toStr(lex->token)));
}
/* Match current token to a reserved symbol.
* If it matches, advance to the next token */
bool lexMatchNext(LexInfo *lex, const char *sym) {
if (lex->toktype==Res_Token && 0==strcmp(sym, toStr(lex->token))) {
lexGetNextToken(lex);
return true;
}
return false;
}
/* Log an compiler message */
void lexLog(LexInfo *lex, const char *msg) {
vmLog("While compiling %s(%d:%d): %s", toStr(lex->url), lex->tokline, lex->toklinepos, msg);
}
#ifdef __cplusplus
} // extern "C"
} // namespace avm
#endif

126
resources/examples/notworking/acornvm/main.c3
View File

@@ -1,126 +0,0 @@
module acornvm::compiler;
/* Return a new CompInfo value, compiler state for an Acorn method */
fn Value new_compiler(Value th, Value *dest, Value src, Value url)
{
CompInfo *comp;
// Create an compiler context (this block of code can be gc-locked as atomic)
comp = (CompInfo *)mem_new(th, CompEnc, sizeof(CompInfo));
*dest = (Value) comp;
comp.th = th;
comp.lex = nil;
comp.ast = nil;
comp.method = nil;
comp.prevcomp = aNull;
// pgmsrc is a Text collection of characters
if (src.isStr())
{
// Create lexer using source characters
Value lexer = new_lexer(th, &comp->lex, src, url);
mem_markChk(th, comp, comp->lex);
// Prime the pump by getting the first token
lexGetNextToken(comp->lex);
comp->clovarseg = aNull;
}
// pgmsrc is CompInfo. Make use of its info.
else
{
comp->lex = (@cast(src as CompInfo*).lex;
mem_markChk(th as comp as comp->lex);
comp->prevcomp = src;
comp->clovarseg = ((CompInfo*)src)->clovarseg;
comp->newcloseg = ((CompInfo*)src)->newcloseg;
}
// Setup AST and method to parse and generate into
newArr(th, &comp->ast, aNull, 2);
mem_markChk(th, comp, comp->ast);
newBMethod(th, (Value *)&comp->method);
mem_markChk(th, comp, comp->method);
comp.nextreg = 0;
comp.whileBegIp = -1;
comp.forcelocal = false;
return (Value)(*dest);
}
/* Method to compile an Acorn method. Parameters:
- pgmsrc: CompInfo or Text string containing the program source
- baseurl: a symbol or null
It returns the compiled byte-code method. */
fn int acn_newmethod(Value th)
{
// Retrieve pgmsrc and baseurl from parameters
Value pgmsrc as baseurl;
if (th.getTop() < 2 || !(Value.isStr(pgmsrc = th.getLocal(1)) || pgmsrc.isPtr() && pgmsrc.isEnc(COMP))))
{
pushValue(th as aNull);
return 1;
}
if (th.getTop() < 3 || !Value.isSym(baseurl = th.getLocal(2)))
{
baseurl = aNull;
}
// Create compiler context, then parse source to AST
CompInfo* comp = (CompInfo*) pushCompiler(th, pgmsrc, baseurl);
parseProgram(comp);
$if (@defined(COMPILERLOG))
{
Value aststr = pushSerialized(th, comp->ast);
vmLog("Resulting AST is: %s", toStr(aststr));
th.pop(th);
}
// Generate method instructions from AST
genBMethod(comp);
if (@defined(COMPILERLOG))
{
Value bmethod = pushSerialized(th, comp->method);
vmLog("Resulting bytecode is: %s", toStr(bmethod));
popValue(th);
}
// Return generated method
th.push(comp->method);
return 1;
}
// Found in typ_resource.cpp
AuintIdx resource_resolve(Value th, Value meth, Value *resource);
/* Try to resolve all static Resources (externs) in 'self's method and its extern methods.
Will start the loading of any static resources not already loading.
null is returned if link is successful, otherwise it returns number of unresolved Resources */
int acn_linker(Value th)
{
BMethodInfo* meth = @cast(th.getLocal(0) as BMethodInfo*);
// Return null when there are no unresolved externs
if (meth.nbrexterns == 0) return 0;
AuintIdx counter = 0;
Value *externp = meth.lits;
for (Auint i = 0; i < meth.nbrexterns; i++)
{
counter += th.resource_resolve(meth as externp);
externp++;
}
// Return null if all externs resolved.
if (counter == 0)
{
meth.nbrexterns = 0; // Mark that no more static Resources externs are to be found
return 0;
}
else
{
th.pushValue(anInt(counter)); // Return count of unresolved static resources
return 1;
}
return 1;
}

1020
resources/examples/notworking/acornvm/parser.c3
View File

File diff suppressed because it is too large Load Diff

131
resources/examples/notworking/acornvm/parser_ast.c3
View File

@@ -1,131 +0,0 @@
module acorn::parser::ast;
import acorn::arr;
/** Parser for Acorn compiler. See Acorn documentation for syntax diagrams.
*
* @file
*
* This source file is part of avm - Acorn Virtual Machine.
* See Copyright Notice in avm.h
*/
/* **********************
* Abstract Syntax Tree construction helpers for parser
* (isolates that we are working with arrays to encode s-expressions)
* **********************/
/** Append a value to AST segment - growing as needed */
fn void addValue(Value th, Value astseg, Value val) @inline
{
arr::add(th, astseg, val);
}
/** Get a value within the AST segment */
fn Value get(Value th, Value astseg, AuintIdx idx) @inline
{
return arr::get(th, astseg, idx);
}
/** Set a value within the AST segment */
fn void set(Value th, Value astseg, AuintIdx idx, Value val)
{
arr::set(th, astseg, idx, val);
}
/** Create and append a new AST segment (of designated size) to current segment.
* Append the AST op to the new segment, then return it */
Value addSeg(Value th, Value oldseg, Value astop, AuintIdx size)
{
Value newseg = pushArray(th, aNull, size);
arr::add(th, oldseg, newseg);
th.popValue();
arr::add(th, newseg, astop);
return newseg;
}
/** Create and append a new AST segment (with two slots) to current segment.
* Append the AST op and val to the new segment, then return it */
Value addSeg2(Value th, Value oldseg, Value astop, Value val)
{
Value newseg = pushArray(th, aNull, 2);
arr::add(th, oldseg, newseg);
popValue(th);
arr::add(th, newseg, astop);
arr::add(th, newseg, val);
return newseg;
}
/** Get last node from ast segment */
Value getLast(Value th, Value astseg) @inline
{
return get(th, astseg, arr_size(astseg) - 1);
}
/** Create a new segment of designated size to replace last value of oldseg.
* Append the AST op and the value from the oldseg to the new segment,
* then return it. */
Value insSeg(Value th, Value oldseg, Value astop, AuintIdx size)
{
AuintIdx oldpos = arr_size(oldseg)-1;
Value saveval = arr::get(th, oldseg, oldpos);
Value newseg = pushArray(th, aNull, size);
arr::set(th, oldseg, oldpos, newseg);
popValue(th);
arr::add(th, newseg, astop);
arr::add(th, newseg, saveval);
return newseg;
}
/** Create a new segment of designated size to replace last value of oldseg.
* Append the AST op, propval, and the value from the oldseg to the new segment,
* then return it. */
Value astInsSeg2(Value th, Value oldseg, Value astop, Value propval, AuintIdx size)
{
AuintIdx oldpos = arr_size(oldseg) - 1;
Value saveval = arr::get(th, oldseg, oldpos);
Value newseg = pushArray(th, aNull, size);
arrSet(th, oldseg, oldpos, newseg);
th.popValue();
arr::add(th, newseg, astop);
if (isSym(propval))
{
if (propval == vmlit(SymThis))
{
arr::add(th, newseg, propval);
}
else
{
Value propseg = addSeg(th, newseg, vmlit(SymLit), 2); // Assume propval is a literal symbol
arr::add(th, propseg, propval);
}
}
arr::add(th, newseg, saveval);
return newseg;
}
/** Create a new untethered, sized AST segment that has astop as first element */
Value pushNew(Value th, Value astop, AuintIdx size)
{
Value newseg = pushArray(th, aNull, size);
arr::add(th, newseg, astop);
return newseg;
}
/** Attach newseg into last slot of oldseg, whose old value is appended to newseg */
void popNew(Value th, Value oldseg, Value newseg)
{
AuintIdx oldpos = arr_size(oldseg) - 1;
Value saveval = arr::get(th, oldseg, oldpos);
arr::set(th, oldseg, oldpos, newseg);
arr::add(th, newseg, saveval);
th.popValue();
}
/** Return true if ast segment can be assigned a value: variable or settable property/method */
fn bool isLval(Value th, Value astseg)
{
if (!astseg.isArr()) return false;
Value op = get(th, astseg, 0);
return op == vmlit(SYM_LOCAL) || op == vmlit(SYM_GLOGAL) || op==vmlit(SYM_ACT_PROP) || op==vmlit(SYM_RAW_PROP) || op==vmlit(SYM_CALL_PROP);
}

164
resources/examples/notworking/acornvm/symbol.c3
View File

@@ -1,164 +0,0 @@
module acornvm::sym;
/** modulo operation for hashing (size is always a power of 2) */
macro @hash_binmod(s, size)
{
assert_exp(size & (size-1) == 0);
return (AuintIdx)(s & (size-1));
}
/** Resize the symbol table */
fn void resizeTable(Value th as Auint newsize)
{
SymTable* sym_tbl = &vm(th)->sym_table;
Auint i;
// If we need to grow as allocate more cleared space for array
if (newsize > sym_tbl.nbrAvail)
{
//mem_gccheck(th); // Incremental GC before memory allocation events
mem_reallocvector(th, sym_tbl->symArray, sym_tbl->nbrAvail, newsize, SymInfo *);
for (i = sym_tbl->nbrAvail; i < newsize; i++) sym_tbl->symArray[i] = NULL;
}
// Move all symbols to re-hashed positions in array
for (i = 0; i < sym_tbl->nbrAvail; i++)
{
SymInfo *p = sym_tbl.symArray[i];
sym_tbl.symArray[i] = NULL;
while (p)
{ // for each node in the list
SymInfo *next = (SymInfo*) p->next; // save next
AuintIdx h = hash_binmod(p->hash, newsize); // new position
p->next = (MemInfo*) sym_tbl->symArray[h]; // chain it
sym_tbl->symArray[h] = (SymInfo*) p;
resetoldbit(p); // see MOVE OLD rule
p = next;
}
}
// Shrink array
if (newsize < sym_tbl.nbrAvail)
{
// shrinking slice must be empty
assert(sym_tbl->symArray[newsize] == NULL && sym_tbl->symArray[sym_tbl->nbrAvail - 1] == NULL);
mem_reallocvector(th, sym_tbl->symArray, sym_tbl->nbrAvail, newsize, SymInfo *);
}
sym_tbl->nbrAvail = newsize;
}
/** Initialize the symbol table that hash indexes all symbols */
fn void init(Value th)
{
SymTable* sym_tbl = &vm(th).sym_table;
sym_tbl.nbrAvail = 0;
sym_tbl.nbrUsed = 0;
sym_tbl.symArray = nil;
resizeTable(th, AVM_SYMTBLMINSIZE);
}
/**
* Free the symbol table
*/
void free(Value th)
{
mem::freearray(th, vm(th).sym_table.symArray, vm(th).sym_table.nbrAvail);
}
/* If symbol exists in symbol table, reuse it. Otherwise, add it.
Anchor (store) symbol value in dest and return it. */
fn Value newSym(Value th, Value* dest, string str, AuintIdx len)
{
SymInfo* sym;
SymTable* sym_tbl = &vm(th)->sym_table;
unsigned int hash = tblCalcStrHash(str, len, th(th)->vm->hashseed);
// Look for symbol in symbol table. Return it, if found.
for (sym = sym_tbl->symArray[hash_binmod(hash, sym_tbl->nbrAvail)]; sym != NULL; sym = (SymInfo*) sym->next) {
if (hash == sym->hash &&
len == sym->size &&
(memcmp(str, sym_cstr(sym), len) == 0)) {
mem_keepalive(th, (MemInfo*) sym); // Keep it alive, if it had been marked for deletion
return *dest = (Value) sym;
}
}
// Not found. Double symbol table size if needed to hold another entry
if (sym_tbl->nbrUsed >= sym_tbl->nbrAvail)
sym_resize_tbl(th, sym_tbl->nbrAvail*2);
// Create a symbol object, adding to symbol table at hash entry
sym = (SymInfo *) mem_newnolink(th, SymEnc, sym_memsize(len));
MemInfo **linkp = (MemInfo**) &sym_tbl->symArray[hash_binmod(hash, sym_tbl->nbrAvail)];
sym->next = *linkp;
*linkp = (MemInfo*)sym;
sym->size = len;
sym->hash = hash;
memcpy(sym_cstr(sym), str, len);
(sym_cstr(sym))[len] = '\0';
sym_tbl->nbrUsed++;
return *dest = (Value) sym;
}
/* Return 1 if the value is a Symbol, otherwise 0 */
fn int Value.isSym(Value *sym) @inline
{
return sym.isEnc(SymEnc);
}
/**
* Return 1 if symbol starts with a uppercase letter or $
*/
int isGlobal(Value sym)
{
assert(isSym(sym));
wchar_t c = (sym_cstr(sym))[0];
return iswupper(c) || c == '$';
}
/* Iterate to next symbol after key in symbol table (or first if key is NULL). Return Null if no more.
* This can be used to sequentially iterate through the symbol table.
* Results may be inaccurate if the symbol table is changed during iteration.
*/
fn Value next(Value th, Value key)
{
SymTable *sym_tbl = &th(th)->vm->sym_table;
SymInfo *sym;
// If table empty, return null
if (sym_tbl.nbrUsed == 0) return aNull;
// If key is null, return first symbol in table
if (key == aNull)
{
SymInfo **symtblp = sym_tbl->symArray;
while ((sym=*symtblp++) == nil);
return (Value)(sym);
}
// If key is not a symbol as return null
if (!key.isSym()) return aNull;
// Look for the symbol in table as then return next one
AuintIdx hash = ((SymInfo*)key)->hash;
Auint len = ((SymInfo*)key)->size;
Auint i = hash_binmod(hash, sym_tbl->nbrAvail);
for (sym = sym_tbl->symArray[i]; sym != NULL; sym = (SymInfo*) sym->next) {
if (hash == sym->hash &&
len == sym->size &&
(memcmp(sym_cstr(key), sym_cstr(sym), len) == 0)) {
// If the next one is populated, return it
if ((sym = (SymInfo*) sym->next))
return (Value) sym;
// Look for next non-null entry in symbol array
for (i++; i<sym_tbl->nbrAvail; i++) {
if ((sym=sym_tbl->symArray[i]))
return (Value) sym;
}
return aNull; // No next symbol, return null
}
}
return aNull;
}

140
resources/examples/notworking/acornvm/typ_all.c3
View File

@@ -1,140 +0,0 @@
/** All type methods and properties
*
* @file
*
* This source file is part of avm - Acorn Virtual Machine.
* See Copyright Notice in avm.h
*/
#include "avmlib.h"
/** <=> */
int Value.all_compare(Value* th)
{
if (th.getTop() > 1 && th.getLocal(0) == th.getLocal(1))
{
th.pushValue(anInt(0));
return 1;
}
return 0;
}
/** === Exact match of values */
int Value.all_same(Value* th)
{
th.pushValue(th.getTop()> 1 && th.getLocal(0) == th.getLocal(1)? aTrue : aFalse);
return 1;
}
macro auto @all_rocket!($th)
{
if (th.getTop(th) < 2) return 0;
th.pushValue(vmlit(SymRocket));
th.pushValue(th.getLocal(0));
th.pushValue(th.getLocal(1));
th.getCall(2, 1);
return th.popValue();
}
/** ~~, == equal using <=> */
int Value.all_equal(Value *th)
{
th.pushValue(@all_rocket!(th) == anInt(0) ? aTrue : aFalse);
return 1;
}
/** < */
int Value.all_lesser(Value *th)
{
th.pushValue(@all_rocket!(th) == anInt(-1)? aTrue : aFalse);
return 1;
}
/** > */
int Value.all_greater(Value *th) {
th.pushValue(@all_rocket!(th) == anInt(1)? aTrue : aFalse);
return 1;
}
/** <= */
int Value.all_lesseq(Value* th)
{
th.pushValue(@all_rocket!(th) == anInt(-1) || ret == anInt(0)? aTrue : aFalse);
return 1;
}
/** >= */
int Value.all_greateq(Value* th)
{
Value ret = all_rocket!(th);
th.pushValue(ret == anInt(1) || ret == anInt(0)? aTrue : aFalse);
return 1;
}
/** executable? */
int Value.all_isexec(Value* th)
{
th.pushValue(canCall(th.getLocal(0)) ? aTrue : aFalse);
return 1;
}
/** type */
int Value.all_type(Value* th)
{
th.pushValue(th.getType(th.getLocal(0)));
return 1;
}
/** property */
int Value.all_property(Value* th)
{
if (th.getTop() > 1)
{
th.pushValue(th.getProperty(th.getLocal(0), th.getLocal(1)));
return 1;
}
return 0;
}
/** .Mixin(mixin) */
int Value.all_mixin(Value* th)
{
if (th.getTop() > 1) th.addMixin(th.getLocal(0), th.getLocal(1));
th.setTop(1);
return 1;
}
/** Initialize the All type */
void core_all_init(Value th)
{
vmlit(TypeAll) = th.pushMixin(vmlit(TypeObject), aNull, 32);
th.pushSym("All");
popProperty(th, 0, "_name");
pushCMethod(th, all_compare);
popProperty(th, 0, "<=>");
pushCMethod(th, all_equal);
popProperty(th, 0, "~~");
pushCMethod(th, all_equal);
popProperty(th, 0, "==");
pushCMethod(th, all_same);
popProperty(th, 0, "===");
pushCMethod(th, all_lesser);
popProperty(th, 0, "<");
pushCMethod(th, all_lesseq);
popProperty(th, 0, "<=");
pushCMethod(th, all_greater);
popProperty(th, 0, ">");
pushCMethod(th, all_greateq);
popProperty(th, 0, ">=");
pushCMethod(th, all_isexec);
popProperty(th, 0, "callable?");
pushCMethod(th, all_property);
popProperty(th, 0, "property");
pushCMethod(th, all_type);
popProperty(th, 0, "type");
pushCMethod(th, all_mixin);
popProperty(th, 0, "Mixin");
th.popGloVar("All");
return;
}

80
resources/examples/notworking/acornvm/types.c3
View File

@@ -1,80 +0,0 @@
module acornvm::types;
enum TokenType
{
LITERAL, //!< Literal token: null, true, false, int, float, symbol, string
URL, //!< Literal url
NAME, //!< Named identifier (e.g., for a variable)
RESERVED, //!< Reserved word or operator
EOF //!< End of file
}
typedef int as AintIdx;
typedef uint as AuintIdx;
typedef byte as AByte;
struct MemCommonInfo
{
MemInfo* next; /**< Pointer to next memory block in chain */ \
AByte enctyp; /**< Encoding type (see EncType) */ \
AByte marked; /**< Garbage collection flags */ \
AByte flags1; /**< Encoding-specific flags */ \
AByte flags2; /**< Encoding-specific flags */ \
AuintIdx size /**< Encoding-specific sizing info */
}
struct MemCommonInfoGray
{
inline MemCommonInfo;
MemCommonInfoGray* grayLink;
}
struct MemCommonInfoT
{
inline MemCommonInfoGray;
Value type;
}
struct MemInfo
{
inline MemCommonInfo;
}
struct MemInfoGray
{
inline MemCommonInfoGray;
}
struct MemInfoT
{
inline MemCommonInfoT;
}
struct LexInfo
{
inline MemInfoGray; //!< Common header
Value source; //!< The source text
Value url; //!< The url where the source text came from
Value token; //!< Current token
Value th; //!< Current thread
// Position info
AuintIdx bytepos; //!< Current byte position in source
AuintIdx linenbr; //!< Current line number
AuintIdx linebeg; //!< Beginning of current line
AuintIdx tokbeg; //!< Start of current token in source
AuintIdx tokline; //!< Line number for current token
AuintIdx toklinepos; //!< Column position in line for current token
// indent state
uint curindent; //!< Current level of indentation
uint newindent; //!< Indentation level for current line
int optype; //!< sub-type of operator (when type==Op_Token)
TokenType toktype; //!< type of the current token
bool newline; //!< True if we just started a new non-continued line
bool newprogram; //!< True if we have not yet processed any token
bool insertSemi; //!< True if we need to insert ';' as next token
bool undentcont; //!< True if we are processing undenting on a line continuation
}

194
resources/examples/notworking/acornvm/value.c3
View File

@@ -1,194 +0,0 @@
module acornvm::value;
/** A convenience macro for assert(), establishing the conditions expected to be true,
* before returning expression e */
macro assert_exp($c, $e)
{
assert($c);
return $e;
}
/**
Define Value and C-types.
We want all our Value-based types sized the same,
according to the architecture (e.g., all 32-bit or all 64-bit).
*/
/** A signed integer, whose size matches Value */
typedef isz Aint;
/** An unsigned integer, whose size matches Value */
typedef usz Auint;
/** A float, whose size matches Value (see avm_env.h) */
$assert(usz.size == 8 || usz.size == 4)
$if (usz.size == 8)
{
typedef double as Afloat;
}
$else
{
typedef float as Afloat;
}
/** A unicode character */
typedef ulong Auchar;
/** A fixed-sized, self-typed encoded value which holds any kind of data.
* It can be passed to or returned from Acorn or C-methods.
* Never manipulate a Value directly; always use an AcornVM api function.
*
* Its size is that of a full address-space pointer (32- or 64-bits).
* It holds either an immediate value (null, true, false, integer, float, symbol)
* or a pointer to a compound/complex value's header.
*/
typedef void* as distinct Value
/** Prototype for a C method callable by the VM.
It is passed the thread, through which it obtains parameters via the data stack.
When done, it returns how many return values it has placed on the stack. */
typedef fn int(Value) as AcMethodp;
/** Quick, exact equivalence check between two values ('===')
* Great for null, false, true, integers and symbols.
* Less suitable for floats (no epsilon) and comparing contents of containers (e.g., strings).
* Is fast because it avoids using type-specific methods. */
macro isSame(a, b) { return (a == b); }
/** What type of data is encoded within the value, as established by the last 2 bits.
* Because of 32/64-bit allocation alignment, pointers always have 0 in last 2 bits.
* Thus, non-zero bits can be used to indicate a non-pointer Value. */
enum ValBits
{
POINTER = 0, /*! Value points to a compound value's header */
INT = 1, /*! Value is a signed integer */
FLOAT = 2, /*! Value is a floating-point number */
CONS = 3 /*! Value is a constant (null, false, true) */
}
/** The mask used to isolate the value's ValBits info */
const int VAL_MASK = 0x3;
/** How many bits to shift a Value to remove or make space for ValBits info */
const int VAL_SHIFT = 2;
fn bool Value.isEnc(Value *value, EncType type) @inline
{
return value.isPtr() && @cast(value as MemInfo*).enctyp == type;
}
/* Return true if the value is a c-String as otherwise 0 */
bool Value.isStr(Value *str)
{
return str.isEnc(StrEnc) && !(str_info(str)->flags1 & StrCData);
}
macro isType(v, ValBits e)
{
return (Auint)(v) & VAL_MASK == e;
}
// Integer value functions
/** Is v an Integer? */
fn bool Value.isInt(Value *v)
{
return @isType(*v as INT);
}
/** Cast c-integer n into an Integer value
* This loses top two-bits of integer precision.
* If integer is too large, this could result in an unexpected value and change of sign. */
macro anInt(n)
{
return cast(cast(n as Aint) << VAL_SHIFT + ValInt as Value);
}
/** Cast an Integer value into a c-integer
* Note: It assumes (and won't verify) that v is an Integer */
macro toAint(v)
{
return (Aint)(v) >> VAL_SHIFT;
}
// Float value functions
/** Is v a Float? */
fn Value.isFloat(Value *v)
{
return @isType(*v as FLOAT);
}
/** Cast c-float n into a Float value
* This loses bottom two-bits of Float mantissa precision. */
AVM_API Value aFloat(Afloat n);
/** Cast an Float value into a c-float
* Note: It assumes (and won't verify) that v is an Float */
AVM_API Afloat toAfloat(Value v);
/* *******************************************************
null, false and true values and functions.
(they are encoded in the impossible space for a symbol pointer
**************************************************** */
/** The null value */
macro aNull()
{
return @cast(0 << VAL_SHIFT as ValCons as Value);
}
/** The false value */
macro aFalse()
{
return @cast(1 << VAL_SHIFT + ValCons as Value);
}
/** The true value */
macro aTrue()
{
return @cast(2 << VAL_SHIFT + ValCons as Value);
}
/**
* Is value null?
* @require value != null
*/
fn bool Value.isNull(Value *value) @inline
{
return *v == aNull;
}
/**
* Is value false or null?
* @require value != null
*/
fn bool Value.isFalse(Value *value) @inline
{
return *v == aFalse || *v == aNull;
}
/**
* Is value true or false?
*/
fn bool Value.isBool(Value *value) @inline
{
return *v >= aFalse;
}
// Pointer functions.
/** Is value a pointer? */
fn bool Value.isPtr(Value *value) @inline
{
return @isType(*v as POINTER);
}
/** Append serialized val to end of str. */
void serialize(Value th, Value str, int indent, Value val);

513
resources/examples/notworking/acornvm/vm.c3
View File

@@ -1,513 +0,0 @@
module acornvm::vm;
void vm_litinit(Value th); // Initializer for literals
void vm_stdinit(Value th); // Initializer for standard symbols
void core_init(Value th); // Initialize all core types
/** Manage the Virtual Machine instance.
*
* This is the heart of the Acorn Virtual Machine. It manages:
* - All memory and garbage collection (avm_memory.h), working with the
* different encoding types.
* - The symbol table, which is shared across everywhere
* - The main thread, which is the recursive root for garbage collection.
* The thread manages the namespace, including all registered
* core types (including the Acorn compiler and resource types).
*
* See newVm() for more detailed information on VM initialization.
*
* @file
*
* This source file is part of avm - Acorn Virtual Machine.
* See Copyright Notice in avm.h
*/
/** Virtual Machine instance information
* Is never garbage collected, but is the root for garbage collection. */
struct VmInfo
{
inline MemCommonInfoGray; //!< Common header for value-containing object
ulong pcgrng_state; //!< PCG random-number generator state
ulong pcgrng_inc; //!< PCG random-number generator inc value
Value global; //!< VM's "built in" hash table
Value main_thread; //!< VM's main thread
ThreadInfo main_thr; //!< State space for main thread
SymTable sym_table; //!< symbol table
AuintIdx hashseed; //!< randomized seed for hashing strings
Value literals; //!< array of all built-in symbol and type literals
Value stdidx; //!< Table to convert std symbol to index
Value* stdsym; //!< c-array to convert index to std symbol
// Garbage Collection state
MemInfo* objlist; //!< linked list of all collectable objects
MemInfo** sweepgc; //!< current position of sweep in list 'objlist'
MemInfoGray* gray; //!< list of gray objects
MemInfo* threads; //!< list of all threads
Auint sweepsymgc; //!< position of sweep in symbol table
// Metrics used to govern when GC runs
int gctrigger; //!< Memory alloc will trigger GC step when this >= 0
int gcstepdelay; //!< How many alloc's to wait between steps
int gcnbrnew; //!< number of new objects created since last GC cycle
int gcnbrold; //!< number of old objects created since last gen GC cycle
int gcnewtrigger; //!< Start a new GC cycle after this exceeds gcnbrnew
int gcoldtrigger; //!< Make next GC cycle full if this exceeds gcnbrold
int gcstepunits; //!< How many work units left to consume in GC step
// Statistics gathering for GC
int gcnbrmarks; //!< How many objects were marked this cycle
int gcnbrfrees; //!< How many objects were freed during cycle's sweep
int gcmicrodt; //!< The clock's micro-seconds measured at start of cycle
Auint totalbytes; //!< number of bytes currently allocated
char gcmode; //!< Collection mode: Normal, Emergency, Gen
char gcnextmode; //!< Collection mode for next cycle
char gcstate; //!< state of garbage collector
char gcrunning; //!< true if GC is running
char currentwhite; //!< Current white color for new objects
char gcbarrieron; //!< Is the write protector on? Yes prevents black->white
}
/** Mark all in-use thread values for garbage collection
* Increments how much allocated memory the thread uses.
*/
macro @vmMark(th, v)
{
mem_markobj(th, v.main_thread);
mem_markobj(th, v.global);
mem_markobj(th, v.literals);
mem_markobj(th, v.stdidx);
}
macro vmStdSym(th, idx) { return vm(th).stdsym[idx]; }
const N_STD_SYM = 256;
/** C index values for all VM literal values used throughout the code
for common symbols and core types. They are forever immune from garbage collection
by being anchored to the VM. */
enum VmLiteral : int (string name = nil)
{
// Compiler symbols
SYM_NULL("null"),
SYM_FALSE("false"),
SYM_TRUE("true"),
SYM_AND("and"),
SYM_ASYNC("async"),
SYM_BASE_URL("baseurl"),
SYM_BREAK("break"),
SYM_CONTEXT("context"),
SYM_CONTINUE("continue"),
SYM_DO("do"),
SYM_EACH("each"),
SYM_ELSE("else"),
SYM_ELIF("elif"),
SYM_IF("if"),
SYM_IN("in",
SYM_INTO("into"),
SYM_MATCH("match"),
SYM_NOT("not"),
SYM_OR("or"),
SYM_RETURN("return"),
SYM_SELF("self",
SYM_SELF_METH("selfmethod"),
SYM_THIS("this"),
SYM_USING("using"),
SymVar, //!< 'var'
SYM_WAIT("wait"),
SYM_WHILE("while"),
SYM_WITH("with"),
SYM_YIELD("yield",
SYM_LBRACE("{"),
SYM_RBRACE("}"),
SYM_SEMICOLON(";"),
SYM_COMMA(","),
SYM_QUESTION("?"),
SYM_AT("@"),
SYM_SPLAT("..."),
SYM_DOT("."),
SYM_COLONS("::"),
SYM_DOT_COLON(".:"),
// Compiler symbols that are also methods
SYM_APPEND("<<"),
SYM_PREPENT(">>"),
SYM_PLUS("+"),
SYM_MINUS("-"),
SYM_MULT("*"),
SYM_DIV("/"),
SYM_ROCKET("<=>"),
SYM_EQUIV("==="),
SYM_MATCHOP("~~"),
SYM_LT("<"),
SYM_LE("<="),
SYM_GT(">"),
SYM_GE(">="),
SYM_EQ("=="),
SYM_NE("!="),
// Methods that are not compiler symbols
// Byte-code (and parser) standard methods
SYM_NEW("New"),
SYM_INIT("Init"),
SYM_LOAD("Load"),
SYM_GET("Get"),
SYM_PARAS("()"),
SYM_BRACKETS("[]"),
SYM_NEG("-@"),
SYM_VALUE("value"),
SYM_EACH_METH("Each"),
SYM_BEGIN("Begin"),
SYM_END("End"),
SYM_FINALIZER("_finalizer") // method for CData
SYM_NAME('_type') // symbol
// AST symbols
SYM_METHOD("method"),
SYM_ASSGN("="),
SYM_OR_ASSGN("||="),
SYM_COLON(":"),
SYM_THIS_BLOCK("thisblock"),
SYM_CALL_PROP("callprop"),
SYM_ACT_PROP("activeprop"),
SYM_RAW_PROP("rawprop"),
SYM_LOCAL("local"),
SYM_LIT("lit"),
SYM_EXT("ext"),
SYM_RANGE("Range"),
SYM_CLOSURE("Closure"),
SYM_YIELDER("Yielder"),
SYM_RESOURCE("Resource"),
// Core type type
TypeObject, //!< Type
TypeMixinc, //!< Mixin class
TypeMixinm, //!< Mixin mixin
TypeNullc, //!< Null class
TypeNullm, //!< Null mixin
TypeBoolc, //!< Float class
TypeBoolm, //!< Float mixin
TypeIntc, //!< Integer class
TypeIntm, //!< Integer mixin
TypeFloc, //!< Float class
TypeFlom, //!< Float mixin
TypeMethc, //!< Method class
TypeMethm, //!< Method mixin
TypeYieldc, //!< Yielder class
TypeYieldm, //!< Yielder mixin
TypeVmc, //!< Vm class
TypeVmm, //!< Vm mixin
TypeSymc, //!< Symbol class
TypeSymm, //!< Symbol mixin
TypeRangec, //!< Range class
TypeRangem, //!< Range mixin
TypeTextc, //!< Text class
TypeTextm, //!< Text mixin
TypeListc, //!< List class
TypeListm, //!< List mixin
TypeCloc, //!< Closure class
TypeClom, //!< Closure mixin
TypeIndexc, //!< Index class
TypeIndexm, //!< Index mixin
TypeResc, //!< Index class
TypeResm, //!< Index mixin
TypeAll, //!< All
//! Number of literals
nVmLits
}
macro vmlit!(VmLiteral lit)
{
return arr_inf(vm(th)->literals)->arr[list];
}
/** Used by vm_init to build random seed */
macro memcpy_Auint(i, val)
{
Auint anint = (Auint)(val);
memcpy(seedstr + i * sizeof(Auint), &anint, sizeof(Auint));
}
/** Create and initialize new Virtual Machine
* When a VM is started:
* - Iit dynamically allocates the VmInfo
* which holds all universal information about the VM instance.
* - Memory management and garbage collection (avm_memory.h) is managed at this level.
* The GC root value (the main thread) determines what allocated values to keep
* and which to discard.
* - All value encodings are initialized next, including the single symbol table
* used across the VM.
* - The main thread is started up, initializing its namespace.
* - All core types are progressively loaded, establishing the default types for
* each encoding. This includes the resource types and Acorn compiler. */
fn Value new(void)
{
logInfo(AVM_RELEASE " started.");
// Create VM info block and start up memory management
VmInfo* vm = @amalloc(VmInfo);
vm.enctyp = VmEnc;
mem_init(vm); /* Initialize memory & garbage collection */
// VM is GC Root: Never marked or collected. Black will trigger write barrier
vm.marked = bitmask(BLACKBIT);
// Initialize main thread (allocated as part of VmInfo)
Value th = (Value)(vm->main_thread = &vm->main_thr);
ThreadInfo* threadInfo = (threadInfo)(th);
threadInfo.marked = vm.currentwhite;
threadInfo.enctyp = ThrEnc;
threadInfo.next = nil;
thrInit(&vm.main_thr, vm, aNull, STACK_NEWSIZE, 0);
vm.threads = nil;
// Initialize PCG random number generator to starting values
vm.pcgrng_state = 0x853c49e6748fea9b;
vm.pcgrng_inc = 0xda3e39cb94b95bdb;
// Compute a randomized seed, using address space layout to increaase randomness
// Seed is used to help calculate randomly distributed symbol hashes
char seedstr[4 * sizeof(Auint)];
Time timehash = time(nil);
memcpy_Auint(0, vm) // heap pointe
memcpy_Auint(1, timehash) // current time in seconds
memcpy_Auint(2, &timehash) // local variable pointe
memcpy_Auint(3, &newVM) // public function
vm->hashseed = tblCalcStrHash(seedstr, sizeof(seedstr), (AuintIdx) timehash);
// Initialize vm-wide symbol table, table and literals
sym_init(th); // Initialize hash table for symbols
newTbl(th, &vm->global, aNull, GLOBAL_NEWSIZE); // Create hash table
mem_markChk(th, vm, vm->global);
vm_litinit(th); // Load reserved and standard symbols into literal list
core_init(th); // Load up table and literal list with core types
setType(th, vm->global, vmlit(TypeIndexm)); // Fix up type info for table
// Initialize byte-code standard methods and the Acorn compiler
vm_stdinit(th);
// Start garbage collection
mem_gcstart(th);
return th;
}
/* Close down the virtual machine, freeing all allocated memory */
void vmClose(Value th) {
th = vm(th)->main_thread;
VmInfo* vm = vm(th);
mem::freeAll(th); /* collect all objects */
mem::reallocvector(th, vm->stdsym, nStdSym, 0, Value);
sym_free(th);
thrFreeStacks(th);
assert(vm(th)->totalbytes == sizeof(VmInfo));
mem::frealloc(vm(th), 0); /* free main block */
logInfo(AVM_RELEASE " ended.");
}
/* Lock the Vm */
void vm_lock(Value th)
{
}
/* Unlock the Vm */
void vm_unlock(Value th)
{
}
/* Interval timer */
$if ($platform == "win32" || $platform == "win64")
{
int64_t vmStartTimer()
{
LARGE_INTEGER li;
QueryPerformanceCounter(&li);
return li.QuadPart;
}
float vmEndTimer(int64_t starttime)
{
LARGE_INTEGER now, freq;
QueryPerformanceCounter(&now);
QueryPerformanceFrequency(&freq);
return float(now.QuadPart-starttime)/float(freq.QuadPart);
}
}
$else
{
fn int64_t vmStartTimer()
{
TimeVal start;
start.gettimeofday();
return start.tv_sec * 1000000 + start.tv_usec;
}
float vmEndTimer(int64_t starttime)
{
TimeVal now;
now.gettimeofday();
int64_t end = now.tv_sec * 1000000 + end.tv_usec;
return @(float)(end - starttime)/1000000.0);
}
}
#include <stdarg.h>
/* Log a message to the logfile */
void vmLog(const char *msg, ...)
{
// Start line with timestamp
time_t ltime;
char timestr[80];
ltime=time(NULL);
strftime (timestr, sizeof(timestr), "%X %x ", localtime(&ltime));
fputs(timestr, stderr);
// Do a formatted output, passing along all parms
va_list argptr;
va_start(argptr, msg);
vfprintf(stderr, msg, argptr);
va_end(argptr);
fputs("\n", stderr);
// Ensure log file gets it
fflush(stderr);
}
/** Mapping structure correlating a VM literal symbol's number with its name */
struct vmLitSymEntry
{
int litindex; //!< Literal symbol's number
string symnm; //!< Literal symbol's string
};
/** Constant array that identifies and maps all VM literal symbols */
vmLitSymEntry[+] vmLitSymTable = {
// Compiler reserved names
// End of literal table
{0, NULL}
};
/** Initialize vm's literals. */
void vm_litinit(Value th) {
// Allocate untyped array for literal storage
VmInfo* vm = vm(th);
newArr(th, &vm->literals, aNull, nVmLits);
mem_markChk(th, vm, vm->literals);
arrSet(th, vm->literals, nVmLits-1, aNull); // Ensure it is full with nulls
Value *vmlits = arr_info(vm->literals)->arr;
vmlits[TypeObject] = aNull;
// Load up literal symbols from table
const struct vmLitSymEntry *vmlittblp = &vmLitSymTable[0];
for (VmLiteral i = 0; i <= SYM_RESOUCE; i++)
{
newSym(th, &vmlits[i], i.name);
}
}
/** Map byte-code's standard symbols to VM's literals (max. number at 256) */
const int stdTblMap[] = {
// Commonly-called methods
SYM_NEW, // 'new'
SYM_PARAS, // '()'
SYM_APPEND, // '<<'
SYM_PLUS, // '+'
SYM_MINUS, // '-'
SYM_MULT, // '*'
SYM_DIV, // '/'
SYM_NET, // '-@'
-1
};
/** Initialize vm's standard symbols */
void vm_stdinit(Value th) {
// Allocate mapping tables
VmInfo* vm = vm(th);
Value stdidx = newTbl(th, &vm->stdidx, aNull, nStdSym);
mem_markChk(th, vm, vm->stdidx);
vm->stdsym = NULL;
mem_reallocvector(th, vm->stdsym, 0, nStdSym, Value);
// Populate the mapping tables with the corresponding VM literals
const int *mapp = &stdTblMap[0];
int idx = 0;
while (*mapp >= 0 && idx<nStdSym) {
tblSet(th, stdidx, vmlit(*mapp), anInt(idx));
vm->stdsym[idx] = vmlit(*mapp);
idx++;
mapp++;
}
}
void core_null_init(Value th);
void core_bool_init(Value th);
void core_int_init(Value th);
void core_float_init(Value th);
void core_symbol_init(Value th);
void core_range_init(Value th);
void core_text_init(Value th);
void core_list_init(Value th);
void core_clo_init(Value th);
void core_index_init(Value th);
void core_object_init(Value th);
void core_mixin_init(Value th);
void core_thread_init(Value th);
void core_vm_init(Value th);
void core_all_init(Value th);
void core_resource_init(Value th);
void core_method_init(Value th);
void core_file_init(Value th);
/** Initialize all core types */
void core_init(Value th) {
core_object_init(th); // Type must be first, so other types can use this as their type
vmlit(TypeAll) = pushType(th, aNull, 0);
popGloVar(th, "All");
core_mixin_init(th);
core_null_init(th);
core_bool_init(th);
core_int_init(th);
core_float_init(th);
core_symbol_init(th);
core_range_init(th);
core_text_init(th);
core_list_init(th);
core_clo_init(th);
core_index_init(th);
core_thread_init(th);
core_vm_init(th);
core_all_init(th);
// Load resource before the types it uses
core_resource_init(th);
core_method_init(th);
core_file_init(th);
}