diff --git a/resources/examples/notworking/acornvm/avm_array.c3 b/resources/examples/notworking/acornvm/avm_array.c3 deleted file mode 100644 index 936975bf4..000000000 --- a/resources/examples/notworking/acornvm/avm_array.c3 +++ /dev/null @@ -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]); - } -} - diff --git a/resources/examples/notworking/acornvm/avm_memory.c3 b/resources/examples/notworking/acornvm/avm_memory.c3 deleted file mode 100644 index 455aaf40e..000000000 --- a/resources/examples/notworking/acornvm/avm_memory.c3 +++ /dev/null @@ -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; -} - diff --git a/resources/examples/notworking/acornvm/avm_stack.c3 b/resources/examples/notworking/acornvm/avm_stack.c3 deleted file mode 100644 index d84f3830e..000000000 --- a/resources/examples/notworking/acornvm/avm_stack.c3 +++ /dev/null @@ -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; istk_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) && idx0); // Must be at least one value to remove! - Value closure = *th(th)->curmethod->methodbase; - if (isArr(closure) && idxstk_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; -} - diff --git a/resources/examples/notworking/acornvm/gen.c3 b/resources/examples/notworking/acornvm/gen.c3 deleted file mode 100644 index fdc4a0f62..000000000 --- a/resources/examples/notworking/acornvm/gen.c3 +++ /dev/null @@ -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; inextreg; - 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; inextreg -} - -/** 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; imethod->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; regnextreg = 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; ith, 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 (; ith; - // 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 \ No newline at end of file diff --git a/resources/examples/notworking/acornvm/lexer.c3 b/resources/examples/notworking/acornvm/lexer.c3 deleted file mode 100644 index 85d588224..000000000 --- a/resources/examples/notworking/acornvm/lexer.c3 +++ /dev/null @@ -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; vmtblptoken == 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 \ No newline at end of file diff --git a/resources/examples/notworking/acornvm/main.c3 b/resources/examples/notworking/acornvm/main.c3 deleted file mode 100644 index 9cf63f8a4..000000000 --- a/resources/examples/notworking/acornvm/main.c3 +++ /dev/null @@ -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; -} - diff --git a/resources/examples/notworking/acornvm/parser.c3 b/resources/examples/notworking/acornvm/parser.c3 deleted file mode 100644 index 04b1e9806..000000000 --- a/resources/examples/notworking/acornvm/parser.c3 +++ /dev/null @@ -1,1020 +0,0 @@ -module acorn::parser; -import acorn::parser::ast; - -/** 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 - */ - -/* Add a url literal and return its index */ -bool resource_equal(Value res1, Value res2); - -int genAddUrlLit(CompInfo *comp, Value val) { - BMethodInfo* f = comp->method; - - // See if we already have resource with same url - int i = f->nbrlits; - while (i-- > 0) - if (resource_equal(f->lits[i],val)) - return i; - - // If not found, add it - mem_growvector(comp->th, f->lits, f->nbrlits, f->litsz, Value, INT_MAX); - f->lits[f->nbrlits] = val; - mem_markChk(comp->th, comp, val); - return f->nbrlits++; -} - -/* Add a method literal and return its index */ -fn int CompInfo.genAddMethodLit(CompInfo *comp, Value val) -{ - BMethodInfo* f = comp.method; - mem_growvector(comp->th, f->lits, f->nbrlits, f->litsz, Value, INT_MAX); - f.lits[f.nbrlits] = val; - mem_markChk(comp->th, comp, val); - return f.nbrlits++; -} - -/* Look for variable in locvars: return index if found, otherwise -1 */ -int findBlockVar(Value th, Value locvars, Value varnm) -{ - int nbrlocals = arr_size(locvars); - for (int idx = nbrlocals - 1; idx > 1; idx--) { - if (arrGet(th, locvars, idx) == varnm) - return idx-2+toAint(arrGet(th, locvars, 1)); // relative to base index - } - return -1; -} - -/* Look for local variable. Returns idx if found, -1 otherwise. */ -fn int CompInfo.findLocalVar(CompInfo *comp, Value varnm) throws SearchError -{ - assert(varnm.isSym()); - - Value th = comp.th; - Value locvars = comp.locvarseg; - do - { - // Look to see if variable already defined as local - // Ignore first two values (link pointer and base index number) - int nbrlocals = arr_size(locvars); - for (int idx = nbrlocals - 1; idx > 1; idx--) - { - if (arrGet(th, locvars, idx) == varnm) - return idx-2+toAint(arrGet(th, locvars, 1)); // relative to base index - } - locvars = arrGet(th, locvars, 0); // link to prior local variables - } while (locvars != aNull); - throw SearchError.NOT_FOUND; -} - -/* Look for closure variable. Returns idx if found, -1 otherwise. */ -fn int CompInfo.findClosureVar(CompInfo *comp, Value varnm) -{ - assert(varnm.isSym()); - - if (comp.clovarseg.isArr()) - { - // Look to see if variable already defined as closure - int nbrclosures = arr_size(comp->clovarseg); - for (int idx = nbrclosures - 1; idx >= 0; idx--) - { - // Adjust for position in closure array - if (arrGet(comp->th, comp->clovarseg, idx) == varnm) return idx+2; - } - } - return -1; -} - -/** If variable not declared already, declare it */ -void CompInfo.declareLocal(CompInfo *comp, Value varnm) -{ - Value th = comp->th; - // If explicit 'local' declaration, declare if not found in block list - if (comp->forcelocal) { - if (findBlockVar(th, comp->locvarseg, varnm)) - arrAdd(th, comp->locvarseg, varnm); - } - // If implicit variable, declare as local or closure, if not found in this or any outer block - else if (findLocalVar(comp, varnm)==-1 && findClosureVar(comp, varnm)==-1) - // Declare as closure var if found as local in outer method. Otherwise, declare as local - if (comp->prevcomp!=aNull && findLocalVar((CompInfo*)comp->prevcomp, varnm)!=-1) { - arrAdd(th, comp->clovarseg, varnm); - // Add initialization logic - astAddSeg2(th, comp->newcloseg, vmlit(SYM_LOCAL), varnm); // Add its initialization to new closure segment - } - else - arrAdd(th, comp->locvarseg, varnm); -} - -/** Create and return new Closure AST segment - Modifies comp->clovarseg and -> newcloseg */ -fn Value parseNewClo(CompInfo* comp, Value astseg) -{ - Value th = comp->th; - // ('Closure', clovars, ('callprop', Closure, New, getmethod, setmethod)) - Value closeg = ast::addSeg(th, astseg, vmlit(SYM_CLOSURE), 3); - comp->clovarseg = pushArray(th, aNull, 4); - arr::add(th, closeg, comp->clovarseg); - th.popValue(); - Value newcloseg = ast::addSeg(th, closeg, vmlit(SYM_CALL_PROP), 8); - ast::addSeg2(th, newcloseg, vmlit(SYM_GLOBAL), vmlit(SYM_CLOSURE)); - ast::addSeg2(th, newcloseg, vmlit(SYM_LIT), vmlit(SYM_NEW)); - ast::addSeg2(th, newcloseg, vmlit(SYM_LIT), vmlit(SYM_NULL)); - ast::addSeg2(th, newcloseg, vmlit(SYM_LIT), vmlit(SYM_NULL)); - return newcloseg; -} - -/** Parse an atomic value: literal, variable or pseudo-variable */ -void parseValue(CompInfo* comp, Value astseg) -{ - Value th = comp->th; - // Literal token (number, symbol, string, true, false, null) - if (comp->lex->toktype == Lit_Token) - { - ast::addSeg2(th, astseg, vmlit(SYM_LIT), comp.lex.token); - lexGetNextToken(comp->lex); - } - // Static unquoted @url - else if (comp->lex->toktype == Url_Token) { - astAddSeg2(th, astseg, vmlit(SYM_EXT), anInt(genAddUrlLit(comp, comp->lex->token))); - lexGetNextToken(comp->lex); - } - // Local or variable / name token - else if (comp->lex->toktype == Name_Token) { - Value symnm = pushValue(th, comp->lex->token); - lexGetNextToken(comp->lex); - const char first = (toStr(symnm))[0]; - // If followed by ":" or ":=", it is a literal symbol - if (lexMatch(comp->lex, ":") || lexMatch(comp->lex, ":=")) - astAddSeg2(th, astseg, vmlit(SymLit), symnm); - else if (first=='$' || (first>='A' && first<='Z')) - { - astAddSeg2(th, astseg, vmlit(SYM_GLOBAL), symnm); - } - else - { - comp.declareLocal(symnm); // declare local if not already declared - // We do not resolve locals to index until gen because of control clauses (declaration after use) - astAddSeg2(th, astseg, vmlit(SYM_LOCAL), symnm); - } - popValue(th); - } - // 'baseurl' pseudo-variable - else if (lexMatchNext(comp->lex, "baseurl")) { - astAddValue(th, astseg, vmlit(SYM_BASEURL)); - } - // 'this' pseudo-variable - else if (lexMatchNext(comp->lex, "this")) { - astAddValue(th, astseg, vmlit(SYM_THIS)); - } - // 'self' pseudo-variable - else if (lexMatchNext(comp->lex, "self")) { - astAddValue(th, astseg, vmlit(SYM_SELF)); - } - // 'selfmethod' pseudo-variable - else if (lexMatchNext(comp->lex, "selfmethod")) { - astAddValue(th, astseg, vmlit(SYM_SELF_METH)); - } - // 'context' pseudo-variable - else if (lexMatchNext(comp->lex, "context")) { - astAddValue(th, astseg, vmlit(SYM_CONTEXT)); - } - // '...' splat - else if (lexMatchNext(comp->lex, "...")) { - astAddValue(th, astseg, vmlit(SymSplat)); - } - // 'yield' expression - else if (lexMatchNext(comp->lex, "yield")) { - Value newseg = astAddSeg(th, astseg, vmlit(SymYield), 2); - parseThisExp(comp, newseg); - } - // parenthetically-enclosed expression - else if (lexMatchNext(comp->lex, "(")) { - parseExp(comp, astseg); - if (!lexMatchNext(comp->lex, ")")) - lexLog(comp->lex, "Expected ')'."); - } - // Method definition - else if (lexMatch(comp->lex, "[") || lexMatch(comp->lex, "*[")) { - Value svclovars = comp->clovarseg; - Value svnewcloseg = comp->newcloseg; - Value newcloseg = astseg; - // Create closure segment just in case, if we are not already inside one... - // ('Closure', clovars, ('callprop', Closure, New, getmethod, setmethod)) - if (!comp->explicitclo) - newcloseg = comp->newcloseg = parseNewClo(comp,astseg); - // Go compile method parms and code block using new compiler context but same lexer - pushValue(th, vmlit(SymNew)); - pushGloVar(th, "Method"); - pushValue(th, comp); - getCall(th, 2, 1); - // Stick returned compiled method reference in extern section of this method's literals - astAddSeg2(th, newcloseg, vmlit(SymExt), anInt(genAddMethodLit(comp, getFromTop(th, 0)))); - popValue(th); - // Move method to its rightful place in closure segment - if (!comp->explicitclo) { - AuintIdx last = arr_size(newcloseg)-1; - arrSet(th, newcloseg, 3, arrGet(th, newcloseg, last)); - arrSetSize(th, newcloseg, last); - } - comp->newcloseg = svnewcloseg; - comp->clovarseg = svclovars; - } - // Explicit closure definition - else if (lexMatchNext(comp->lex, "+[")) { - Value svclovars = comp->clovarseg; - Value svnewcloseg = comp->newcloseg; - bool svexplicitclo = comp->explicitclo; - - Value newcloseg = parseNewClo(comp,astseg); - - // Process explicit closure variable declarations - if (!lexMatch(comp->lex, "]")) { - do { - if (comp->lex->toktype == Name_Token || lexMatch(comp->lex, "self")) { - // Closure variable name - Value symnm = comp->lex->token; - const char first = (toStr(symnm))[0]; - if (first=='$' || (first>='A' && first<='Z')) - lexLog(comp->lex, "A name may not be a closure variable"); - arrAdd(th, comp->clovarseg, symnm); - lexGetNextToken(comp->lex); - - // Handle specified initializer expression - if (lexMatchNext(comp->lex, "=")) { - parseAppendExp(comp, newcloseg); - } - // No initializer expression? Initialize it using same named 'local' variable - else if (symnm == vmlit(SymSelf)) - astAddValue(th, newcloseg, symnm); - else - astAddSeg2(th, newcloseg, vmlit(SymLocal), symnm); - } - } while (lexMatchNext(comp->lex, ",")); - } - if (!lexMatchNext(comp->lex, "]")) - lexLog(comp->lex, "Expected ']'."); - - comp->explicitclo = true; - comp->newcloseg = newcloseg; - // For get/set explicit closure, look for both - if (lexMatchNext(comp->lex, "{")) { - for (int i=0; i<2; i++) { - parseExp(comp, newcloseg); - AuintIdx last = arr_size(newcloseg)-1; - arrSet(th, newcloseg, 3+i, arrGet(th, newcloseg, last)); - arrSetSize(th, newcloseg, last); - lexMatchNext(comp->lex, ";"); - } - lexMatchNext(comp->lex, "}"); - } - // Not get/set? Get method, then move to its rightful place in closure segment - else { - parseValue(comp, newcloseg); - AuintIdx last = arr_size(newcloseg)-1; - arrSet(th, newcloseg, 3, arrGet(th, newcloseg, last)); - arrSetSize(th, newcloseg, last); - } - - // Restore saved values - comp->explicitclo = svexplicitclo; - comp->newcloseg = svnewcloseg; - comp->clovarseg = svclovars; - } - return; -} - -/** Add a list of parameters to a AST propseg */ -fn void CompInfo.parseParams(CompInfo* comp, Value propseg, const char *closeparen) -{ - bool saveforcelocal = comp->forcelocal; - comp->forcelocal = false; - - parseAppendExp(comp, propseg); - while (lexMatchNext(comp->lex, ",")) - parseAppendExp(comp, propseg); - - if (!lexMatchNext(comp->lex, closeparen)) - lexLog(comp->lex, "Expected ')' or ']' at end of parameter/index list."); - - comp->forcelocal = saveforcelocal; -} - -/** Determine if token is '.' '.:' or '::' */ -#define isdots(token) ((token)==vmlit(SymDot) || (token)==vmlit(SymColons) || (token)==vmlit(SymDotColon)) - -/** Parse a compound term, handling new and suffixes */ -void parseTerm(CompInfo* comp, Value astseg) { - Value th = comp->th; - // Capture whether term began with a "+" prefix - bool newflag = lexMatchNext(comp->lex, "+"); - // Obtain base value (dots as prefix implies 'this' as base value) - if (!newflag && isdots(comp->lex->token)) - astAddValue(th, astseg, vmlit(SymThis)); - else - parseValue(comp, astseg); - // Handle suffix chains - while (newflag || isdots(comp->lex->token) || lexMatch(comp->lex, "(") || lexMatch(comp->lex, "[")) { - bool getparms = true; - Value propseg = astInsSeg(th, astseg, vmlit(SymActProp), 4); // may adjust op later - // Treat '+' as calling .New - if (newflag) { - astAddSeg2(th, propseg, vmlit(SymLit), vmlit(SymNew)); - newflag = false; // only works once - } - // For pure method call, adjust to be: self.method - else if (lexMatch(comp->lex, "(")) { - arrSet(th, propseg, 2, arrGet(th, propseg, 1)); - arrSet(th, propseg, 1, vmlit(SymSelf)); - } - // For indexing, adjust to: base.'[]' - else if (lexMatchNext(comp->lex, "[")) { - astSetValue(th, propseg, 0, vmlit(SymCallProp)); // adjust because of parms - astAddSeg2(th, propseg, vmlit(SymLit), vmlit(SymBrackets)); - comp.parseParams(propseg, "]"); - getparms = false; - } - // Handle '.', '.:', and '::' - else { - if (lexMatch(comp->lex, ".:")) { - astSetValue(th, propseg, 0, vmlit(SymRawProp)); - getparms = false; - } - else if (lexMatch(comp->lex, "::")) { - astSetValue(th, propseg, 0, vmlit(SymCallProp)); - astAddSeg2(th, propseg, vmlit(SymLit), vmlit(SymBrackets)); - getparms = false; - } - lexGetNextToken(comp->lex); // scan past dot(s) operator - - // Retrieve the property specified after the dot(s) operator - if (comp->lex->toktype == Name_Token || comp->lex->toktype == Lit_Token) { - astAddSeg2(th, propseg, vmlit(SymLit), comp->lex->token); - lexGetNextToken(comp->lex); - } - // Calculated property symbol/method value - else if (lexMatchNext(comp->lex, "(")) { - parseExp(comp, propseg); - if (!lexMatchNext(comp->lex, ")")) - lexLog(comp->lex, "Expected ')' at end of property expression."); - } - else { - astAddSeg2(th, propseg, vmlit(SymLit), aNull); - lexLog(comp->lex, "Expected property expression after '.', '.:', or '::'"); - } - } - - // Process parameter list, if appropriate for this term suffix - if (getparms) { - if (lexMatchNext(comp->lex, "(")) { - astSetValue(th, propseg, 0, vmlit(SymCallProp)); // adjust because of parms - comp.parseParams(propseg, ")"); - } - // Treat Text or Symbol literal as a single parameter to pass - else if (comp->lex->toktype == Lit_Token && (isStr(comp->lex->token) || isSym(comp->lex->token))) { - astSetValue(th, propseg, 0, vmlit(SymCallProp)); // adjust because of parm - astAddSeg2(th, propseg, vmlit(SymLit), comp->lex->token); - lexGetNextToken(comp->lex); - } - } - } -} - -/** Parse a prefix operator */ -void parsePrefixExp(CompInfo* comp, Value astseg) { - Value th = comp->th; - if (lexMatchNext(comp->lex, "-")) { - parsePrefixExp(comp, astseg); - - // Optimize taking the negative of a literal number - Value selfseg = astGetLast(th, astseg); - if (astGet(th, selfseg, 0)==vmlit(SymLit) && isFloat(astGet(th, selfseg, 1))) - astSetValue(th, selfseg, 1, aFloat(-toAfloat(astGet(th, selfseg, 1)))); - else if (astGet(th, selfseg, 0)==vmlit(SymLit) && isInt(astGet(th, selfseg, 1))) - astSetValue(th, selfseg, 1, anInt(-toAint(astGet(th, selfseg, 1)))); - else { // Not a literal number? Do the property call - astseg = astInsSeg(th, astseg, vmlit(SymCallProp), 3); - Value litseg = astAddSeg(th, astseg, vmlit(SymLit), 2); - astAddValue(th, litseg, vmlit(SYM_NEG)); - } - } - // '@' + symbol, text or '('exp')' - else if (lexMatchNext(comp->lex, "@")) { - // Symbol or text: treat as static, unquoted url - if (comp->lex->toktype == Lit_Token) { - assert(isStr(comp->lex->token) || isSym(comp->lex->token)); - // +Resource(token,baseurl) - pushValue(th, vmlit(SymNew)); - pushValue(th, vmlit(TypeResc)); - pushValue(th, comp->lex->token); - pushValue(th, comp->lex->url); - getCall(th, 3, 1); - // ('lit', resource) - astAddSeg2(th, astseg, vmlit(SymExt), anInt(genAddUrlLit(comp, getFromTop(th, 0)))); - popValue(th); - lexGetNextToken(comp->lex); - } - else { - // ('callprop', ('callprop', glo'Resource', lit'New', parsed-value, 'baseurl'), 'Load') - Value loadseg = astAddSeg(th, astseg, vmlit(SymCallProp), 3); - Value newseg = astAddSeg(th, loadseg, vmlit(SymCallProp), 5); - astAddSeg2(th, newseg, vmlit(SymGlobal), vmlit(SymResource)); - astAddSeg2(th, newseg, vmlit(SymLit), vmlit(SymNew)); - parsePrefixExp(comp, newseg); - astAddValue(th, newseg, vmlit(SymBaseurl)); - astAddSeg2(th, loadseg, vmlit(SymLit), vmlit(SymLoad)); - } - } - else - parseTerm(comp, astseg); -} - -/** Parse the '**' operator */ -fn void CompInfo.parsePowerExp(CompInfo* comp, Value astseg) -{ - Value th = comp.th; - comp.parsePrefixExp(astseg); - Value op = comp.lex.token; - while (comp.matchNext("**")) - { - Value newseg = ast::insSeg(th, astseg, vmlit(SymCallProp), 4); - ast::addSeg2(th, newseg, vmlit(SymLit), op); - comp.parsePrefixExp(newseg); - } -} - -/** Parse the '*', '/' or '%' binary operator */ -fn void CompInfo.parseMultDivExp(CompInfo* comp inline, Value astseg) -{ - Value th = comp.th; - parsePowerExp(astseg); - while (Value op = lex.token, matchNext("*") || matchNext("/") || matchNext("%")) - { - Value newseg = ast::insSeg(th, astseg, vmlit(SYM_CALL_PROP), 4); - ast::addSeg2(th, newseg, vmlit(SYM_LIT), op); - parsePowerExp(newseg); - } -} - -/** Parse the '+' or '-' binary operator */ -fn void CompInfo.parseAddSubExp(CompInfo* comp, Value astseg) -{ - Value th = comp.th; - comp.parseMultDivExp(astseg); - while (int isAdd; (isAdd = comp.matchNext"+") || comp.matchNextcomp->lex, "-")) - { - Value newseg = ast::insSeg(th, astseg, vmlit(SYM_CALL_PROP), 4); - ast::addSeg2(th, newseg, vmlit(SymLit), isAdd ? vmlit(SYM_PLUS) : vmlit(SYM_MINUS)); - comp.parseMultDivExp(newseg); - } -} - -/** Parse the range .. constructor operator */ -fn void CompInfo.parseRangeExp(CompInfo* comp, Value astseg) -{ - Value th = comp.th; - comp.parseAddSubExp(astseg); - if (comp.matchNext("..")) - { - // ('CallProp', 'Range', 'New', from, to, step) - Value newseg = ast::insSeg(th, astseg, vmlit(SYM_CALL_PROP), 4); - Value from = th.pushValue(arr::get(th, newseg, 1)); - arr::del(th, newseg, 1, 1); - ast::addSeg2(th, newseg, vmlit(SYM_GLOBAL), vmlit(SymRange)); - ast::addSeg2(th, newseg, vmlit(SymLit), vmlit(SymNew)); - ast::addValue(th, newseg, from); - th.popValue(); - comp.parseAddSubExp(newseg); - if (lexMatchNext(comp->lex, "..")) comp.parseAddSubExp(newseg); - } -} - -/** Parse the comparison operators */ -fn void CompInfo.parseCompExp(CompInfo* comp, Value astseg) { - Value th = comp.th; - comp.parseRangeExp(astseg); - Value op = comp.lex->token; - if (lexMatchNext(comp.lex, "<=>")) - { - Value newseg = ast::insSeg(th, astseg, vmlit(SymCallProp), 4); - ast::addSeg2(th, newseg, vmlit(SymLit), op); - comp.parseRangeExp(newseg); - } - else if (lexMatchNext(comp->lex, "===") || lexMatchNext(comp->lex, "~~") - || lexMatchNext(comp->lex, "==") || lexMatchNext(comp->lex, "!=") - || lexMatchNext(comp->lex, "<=") || lexMatchNext(comp->lex, ">=") - || lexMatchNext(comp->lex, "<") || lexMatchNext(comp->lex, ">")) { - Value newseg = ast::insSeg(th, astseg, op, 3); - comp.parseRangeExp(newseg); - } -} - -/* Parse 'not' conditional logic operator */ -fn void CompInfo.parseNotExp(CompInfo* comp, Value astseg) -{ - Value th = comp.th; - bool takenot = false; - while ((lexMatchNext(comp->lex, "!")) || lexMatchNext(comp->lex, "not")) takenot = !takenot; - if (takenot) - { - Value newseg = astAddSeg(th, astseg, vmlit(SymNot), 2); - parseCompExp(comp, newseg); - } - else - { - comp.parseCompExp(astseg); - } -} - -fn bool CompInfo.matchNext(CompInfo *comp, string s) @inline -{ - return comp.lex.matchNext(s); -} - -/* Parse 'and' conditional logic operator */ -fn void CompInfo.parseAndExp(CompInfo* comp, Value astseg) -{ - Value th = comp.th; - comp.parseNotExp(astseg); - if (comp.matchNext("&&") || comp.matchNext("and") - { - Value newseg = ast::insSeg(th, astseg, vmlit(SymAnd), 3); - do - { - comp.parseNotExp(newseg); - } - while (comp.matchNext("&&") || comp.matchNext("and")); - } -} - -/** Parse 'or' conditional logic operator */ -void parseLogicExp(CompInfo* comp, Value astseg) -{ - Value th = comp->th; - parseAndExp(comp, astseg); - if ((lexMatchNext(comp->lex, "||")) || lexMatchNext(comp->lex, "or")) { - Value newseg = astInsSeg(th, astseg, vmlit(SymOr), 3); - do { - parseAndExp(comp, newseg); - } while ((lexMatchNext(comp->lex, "||")) || lexMatchNext(comp->lex, "or")); - } -} - -/** Parse '?' 'else' ternary operator */ -void parseTernaryExp(CompInfo* comp, Value astseg) { - Value th = comp->th; - parseLogicExp(comp, astseg); - if ((lexMatchNext(comp->lex, "?"))) { - Value newseg = astInsSeg(th, astseg, vmlit(SymQuestion), 4); - parseLogicExp(comp, newseg); - if (lexMatchNext(comp->lex, "else")) - parseLogicExp(comp, newseg); - else { - astAddSeg2(th, newseg, vmlit(SymLit), aNull); - lexLog(comp->lex, "Expected 'else' in ternary expression"); - } - } -} - -/** Parse append and prepend operators */ -void parseAppendExp(CompInfo* comp, Value astseg) { - Value th = comp->th; - // If prefix, assume 'this'. Otherwise get left hand value - if (lexMatch(comp->lex, "<<") || lexMatch(comp->lex, ">>")) - astAddValue(th, astseg, vmlit(SymThis)); - else - parseTernaryExp(comp, astseg); - - Value op; - while ((op=comp->lex->token) && lexMatchNext(comp->lex, "<<") || lexMatchNext(comp->lex, ">>")) { - Value newseg = astInsSeg(th, astseg, vmlit(SymCallProp), 4); - astAddSeg2(th, newseg, vmlit(SymLit), op); - parseTernaryExp(comp, newseg); - } -} - -/** Parse comma separated expressions */ -void parseCommaExp(CompInfo* comp, Value astseg) { - Value th = comp->th; - parseAppendExp(comp, astseg); - if (lexMatch(comp->lex, ",")) { - Value commaseg = astInsSeg(th, astseg, vmlit(SymComma), 4); - while (lexMatchNext(comp->lex, ",")) { - parseAppendExp(comp, commaseg); - } - } -} - -/** Parse an assignment or property setting expression */ -void parseAssgnExp(CompInfo* comp, Value astseg) { - Value th = comp->th; - bool isColonEq; - - // Get lvals (could be rvals if no assignment operator is found) - // Presence of 'local' ensures unknown locals are declared as locals vs. closure vars - bool saveforcelocal = comp->forcelocal; - comp->forcelocal = lexMatchNext(comp->lex, "local"); - parseCommaExp(comp, astseg); - comp->forcelocal = saveforcelocal; - - // Process rvals depending on type of assignment - if (lexMatch(comp->lex, "=")) { - Value assgnseg = astInsSeg(th, astseg, vmlit(SymAssgn), 3); - // Warn about unalterable literals or pseudo-variables to the left of "=" - Value lvalseg = arrGet(th, assgnseg, 1); - if (arrGet(th, lvalseg, 0) == vmlit(SymComma)) { - Value lval; - for (Auint i = 1; ilex, "Literals/pseudo-variables/expressions cannot be altered."); - break; - } - } - } - else if (!astIsLval(th, lvalseg)) { - lexLog(comp->lex, "Literals/pseudo-variables/expressions cannot be altered."); - } - lexGetNextToken(comp->lex); // Go past assignment operator - parseAssgnExp(comp, assgnseg); // Get the values to the right - } - else if ((isColonEq = lexMatchNext(comp->lex, ":=")) || lexMatchNext(comp->lex, ":")) { - // ('=', ('activeprop'/'callprop', 'this', ('[]',) property), value) - Value assgnseg = astInsSeg(th, astseg, vmlit(SymAssgn), 3); - Value indexseg = astPushNew(th, vmlit(isColonEq? SymCallProp : SymActProp), 4); - astAddValue(th, indexseg, vmlit(SymThis)); - if (isColonEq) - astAddSeg2(th, indexseg, vmlit(SymLit), vmlit(SymBrackets)); - astPopNew(th, assgnseg, indexseg); - parseAssgnExp(comp, assgnseg); - } -} - -/** Parse an expression */ -void parseExp(CompInfo* comp, Value astseg) { - parseAssgnExp(comp, astseg); -} - -/** Set up block variable list and add it to astseg */ -Value parseNewBlockVars(CompInfo *comp, Value astseg) { - Value th = comp->th; - // Set up block variable list - Value blkvars = pushArray(th, vmlit(TypeListm), 8); - arrSet(th, blkvars, 0, comp->locvarseg); - arrSet(th, blkvars, 1, anInt(0)); - comp->locvarseg = blkvars; - astAddValue(th, astseg, blkvars); - popValue(th); // blkvars - return blkvars; -} - -/** Parse an expression statement / 'this' block */ -void parseThisExp(CompInfo* comp, Value astseg) { - Value th = comp->th; - Value svlocalvars = comp->locvarseg; - parseAssgnExp(comp, astseg); - if (lexMatchNext(comp->lex, "using")) { - Value newseg = astInsSeg(th, astseg, vmlit(SymThisBlock), 5); - parseNewBlockVars(comp, newseg); - parseAssgnExp(comp, newseg); - parseBlock(comp, newseg); - } - else if (lexMatch(comp->lex, "{")) { - Value newseg = astInsSeg(th, astseg, vmlit(SymThisBlock), 5); - parseNewBlockVars(comp, newseg); - astAddValue(th, newseg, aNull); - parseBlock(comp, newseg); - } - comp->locvarseg = svlocalvars; -} - -/** Expect ';' at this point. Error if not found, then scan to find it. */ -void parseSemi(CompInfo* comp, Value astseg) { - // Allow right curly brace and end-of-file to stand in for a semi-colon - if (!lexMatchNext(comp->lex, ";")&&!lexMatch(comp->lex, "}")&&comp->lex->toktype!=Eof_Token) { - lexLog(comp->lex, "Unexpected token in statement. Ignoring all until block or ';'."); - while (comp->lex->toktype != Eof_Token && !lexMatch(comp->lex, "}") && !lexMatchNext(comp->lex, ";")) - if (lexMatch(comp->lex, "{")) - parseBlock(comp, astseg); - else - lexGetNextToken(comp->lex); - } -} - -/** Parse the each clause: vars and iterator */ -void parseEachClause(CompInfo *comp, Value newseg) { - Value th = comp->th; - - // Set up block variable list - Value blkvars = parseNewBlockVars(comp, newseg); - - // Parse list of 'each' variables (into new variable block) - AuintIdx bvarsz=2; - do { - if (comp->lex->toktype==Name_Token) { - arrSet(th, blkvars, bvarsz++, comp->lex->token); - lexGetNextToken(comp->lex); - } - else - lexLog(comp->lex, "Expected variable name"); - // Assign null variable for "key", if none specified using ':' - if (bvarsz==3 && !lexMatch(comp->lex, ":")) { - arrSet(th, blkvars, bvarsz++, arrGet(th, blkvars, 2)); - arrSet(th, blkvars, 2, aNull); - } - } while (lexMatchNext(comp->lex, ",") || lexMatchNext(comp->lex, ":")); - astAddValue(th, newseg, anInt(bvarsz-2)); // expected number of 'each' values - - // 'in' clause - if (!lexMatchNext(comp->lex, "in")) - lexLog(comp->lex, "Expected 'in'"); - parseLogicExp(comp, newseg); -} - -/** Parse 'if', 'while' or 'each' statement clauses */ -void parseClause(CompInfo* comp, Value astseg, AuintIdx stmtvarsz) { - Value th = comp->th; - Value svlocalvars = comp->locvarseg; // Statement's local block - Value deeplocalvars = aNull; // First/deepest clause's local block - Value inslocalvars = aNull; // prior/deeper clause's local block - // Handle multiple clauses so they execute in reverse order - while (lexMatch(comp->lex, "if") || lexMatch(comp->lex, "while") || lexMatch(comp->lex, "each")) { - Value ctlseg; - Value ctltype = comp->lex->token; - if (lexMatchNext(comp->lex, "if")) { - // Wrap 'if' single statement in a block (so that fixing implicit returns works) - astInsSeg(th, astseg, vmlit(SymSemicolon), 2); - ctlseg = astPushNew(th, ctltype, 4); - parseLogicExp(comp, ctlseg); - parseNewBlockVars(comp, ctlseg); - } - else if (lexMatchNext(comp->lex, "while")) { - ctlseg = astPushNew(th, ctltype, 4); - parseNewBlockVars(comp, ctlseg); - parseLogicExp(comp, ctlseg); - } - else if (lexMatchNext(comp->lex, "each")) { - ctlseg = astPushNew(th, ctltype, 5); - parseEachClause(comp, ctlseg); // var and 'in' iterator - } - astPopNew(th, astseg, ctlseg); // swap in place of block - - // Linkage of variable scoping for clauses is intricate - if (inslocalvars != aNull) // link prior clause to current - arrSet(th, inslocalvars, 0, comp->locvarseg); - if (deeplocalvars == aNull) - deeplocalvars = comp->locvarseg; // Remember first/deepest - inslocalvars = comp->locvarseg; // Remember most recent - comp->locvarseg = svlocalvars; // Restore to statement block - } - parseSemi(comp, astseg); - - // Move any new locals declared in statement to deepest clause's block scope - if (deeplocalvars!=aNull && stmtvarszlocvarseg = deeplocalvars; - for (AuintIdx vari = arr_size(svlocalvars)-1; vari >= stmtvarsz; vari--) { - // Pop off statement's declared local, and if not found, add to deepest block - // Find check is needed to see each's declared variables, for example - Value varnm = pushValue(th, arrGet(th, svlocalvars, vari)); - arrSetSize(th, svlocalvars, vari); - if (findLocalVar(comp, varnm)==-1) - arrAdd(th, deeplocalvars, varnm); - popValue(th); - } - arrSetSize(th, svlocalvars, stmtvarsz); // Remove from outer block vars - comp->locvarseg = svlocalvars; - } -} - -/** Parse a sequence of statements, each ending with ';' */ -void parseStmts(CompInfo* comp, Value astseg) { - Value th = comp->th; - astseg = astAddSeg(th, astseg, vmlit(SymSemicolon), 16); - Value newseg; - while (comp->lex->toktype != Eof_Token && !lexMatch(comp->lex, "}")) { - Value stmt = comp->lex->token; - AuintIdx stmtvarsz = arr_size(comp->locvarseg); // Remember for clauses - // 'if' block - if (lexMatchNext(comp->lex, "if")) { - newseg = astAddSeg(th, astseg, vmlit(SymIf), 4); - Value svlocalvars = comp->locvarseg; - parseLogicExp(comp, newseg); - parseNewBlockVars(comp, newseg); - parseBlock(comp, newseg); - comp->locvarseg = svlocalvars; - parseSemi(comp, astseg); - while (lexMatchNext(comp->lex, "elif")) { - parseLogicExp(comp, newseg); - parseNewBlockVars(comp, newseg); - parseBlock(comp, newseg); - comp->locvarseg = svlocalvars; - parseSemi(comp, astseg); - } - if (lexMatchNext(comp->lex, "else")) { - astAddValue(th, newseg, vmlit(SymElse)); - parseNewBlockVars(comp, newseg); - parseBlock(comp, newseg); - comp->locvarseg = svlocalvars; - parseSemi(comp, astseg); - } - } - - // 'match' block - if (lexMatchNext(comp->lex, "match")) { - newseg = astAddSeg(th, astseg, vmlit(SymMatch), 4); - Value svlocalvars = comp->locvarseg; - parseExp(comp, newseg); - if (lexMatchNext(comp->lex, "using")) - parseAssgnExp(comp, newseg); - else - astAddValue(comp, newseg, vmlit(SymMatchOp)); - Value matchInto = aNull; - if (lexMatchNext(comp->lex, "into")) { - matchInto = pushArray(th, aNull, 4); - do { - if (comp->lex->toktype==Name_Token) { - arrAdd(th, matchInto, comp->lex->token); - lexGetNextToken(comp->lex); - } - else - lexLog(comp->lex, "Expected variable name"); - } while (lexMatchNext(comp->lex, ",")); - } - parseSemi(comp, astseg); - while (lexMatchNext(comp->lex, "with")) { - parseExp(comp, newseg); - parseNewBlockVars(comp, newseg); - AuintIdx nInto = 2; - if (lexMatchNext(comp->lex, "into")) { - do { - if (comp->lex->toktype==Name_Token) { - arrSet(th, comp->locvarseg, nInto++, comp->lex->token); - lexGetNextToken(comp->lex); - } - else - lexLog(comp->lex, "Expected variable name"); - } while (lexMatchNext(comp->lex, ",")); - } - else if (matchInto!=aNull) { - for (AuintIdx i=0; ilocvarseg, nInto, arrGet(th, matchInto, nInto-2)); - nInto++; - } - } - astAddValue(th, newseg, anInt(nInto-2)); - parseBlock(comp, newseg); - comp->locvarseg = svlocalvars; - parseSemi(comp, astseg); - } - if (lexMatchNext(comp->lex, "else")) { - astAddValue(th, newseg, vmlit(SymElse)); - parseNewBlockVars(comp, newseg); - astAddValue(th, newseg, anInt(0)); - parseBlock(comp, newseg); - comp->locvarseg = svlocalvars; - parseSemi(comp, astseg); - } - if (matchInto!=aNull) - popValue(th); - } - - // 'while' block - else if (lexMatchNext(comp->lex, "while")) { - newseg = astAddSeg(th, astseg, vmlit(SymWhile), 4); - Value svlocalvars = comp->locvarseg; - parseNewBlockVars(comp, newseg); - parseLogicExp(comp, newseg); - parseBlock(comp, newseg); - comp->locvarseg = svlocalvars; - parseSemi(comp, astseg); - } - - // 'each': ('each', localvars, nretvals, iterator, block) - else if (lexMatchNext(comp->lex, "each")) { - newseg = astAddSeg(th, astseg, vmlit(SymEach), 5); - Value svlocalvars = comp->locvarseg; - parseEachClause(comp, newseg); // vars and 'in' iterator - parseBlock(comp, newseg); - comp->locvarseg = svlocalvars; - parseSemi(comp, astseg); - } - - // 'do': ('do', local, exp, block) - else if (lexMatchNext(comp->lex, "do")) { - newseg = astAddSeg(th, astseg, vmlit(SymDo), 4); - Value svlocalvars = comp->locvarseg; - parseNewBlockVars(comp, newseg); - if (!lexMatch(comp->lex, "{")) - parseExp(comp, newseg); - else - astAddValue(th, newseg, aNull); - parseBlock(comp, newseg); - comp->locvarseg = svlocalvars; - parseSemi(comp, astseg); - } - - // 'break' or 'continue' statement - else if (lexMatchNext(comp->lex, "break") || lexMatchNext(comp->lex, "continue")) { - astAddSeg(th, astseg, stmt, 1); - parseClause(comp, astseg, stmtvarsz); - } - - // 'return' statement - else if (lexMatchNext(comp->lex, "return") || lexMatchNext(comp->lex, "yield")) { - newseg = astAddSeg(th, astseg, stmt, 2); - if (!lexMatch(comp->lex, ";") && !lexMatch(comp->lex, "if") - && !lexMatch(comp->lex, "each") && !lexMatch(comp->lex, "while")) - parseThisExp(comp, newseg); - else - astAddValue(th, newseg, aNull); - parseClause(comp, astseg, stmtvarsz); - } - - // expression or 'this' block - else { - if (stmt != vmlit(SymSemicolon)) { - parseThisExp(comp, astseg); - parseClause(comp, astseg, stmtvarsz); - } - } - } - return; -} - -/** Parse a block of statements enclosed by '{' and '}' */ -void parseBlock(CompInfo* comp, Value astseg) { - if (!lexMatchNext(comp->lex, "{")) - return; - parseStmts(comp, astseg); - if (!lexMatchNext(comp->lex, "}")) - lexLog(comp->lex, "Expected '}'"); - return; -} - -/* Parse an Acorn program */ -void parseProgram(CompInfo* comp) { - Value th = comp->th; - Value methast = comp->ast; - astAddValue(th, methast, vmlit(SymMethod)); - - // local variable list - starts with pointer to outer method's local variable list - comp->locvarseg = astAddSeg(th, methast, aNull, 16); - astAddValue(th, comp->locvarseg, anInt(1)); - - // closure variable list already retrieved from outer method - comp->explicitclo = false; - - Value parminitast = astAddSeg(th, methast, vmlit(SymSemicolon), 4); - - // process parameters as local variables - bool isYielder = false; - if (lexMatchNext(comp->lex, "[") || (isYielder = lexMatchNext(comp->lex, "*["))) { - if (isYielder) - methodFlags(comp->method) |= METHOD_FLG_YIELDER; - - // Process parameter declaration - do { - if (lexMatchNext(comp->lex, "...")) { - methodFlags(comp->method) |= METHOD_FLG_VARPARM; - break; - } - else if (comp->lex->toktype == Name_Token) { - Value symnm = comp->lex->token; - const char first = (toStr(symnm))[0]; - if (first=='$' || (first>='A' && first<='Z')) - lexLog(comp->lex, "A name may not be a method parameter"); - else { - if (findLocalVar(comp, symnm)==-1) { - arrAdd(th, comp->locvarseg, symnm); - methodNParms(comp->method)++; - } - else - lexLog(comp->lex, "Duplicate method parameter name"); - } - lexGetNextToken(comp->lex); - - // Handle any specified parameter default value - if (lexMatchNext(comp->lex, "=")) { - // Produce this ast: parm||=default-expression - Value oreqseg = astAddSeg(th, parminitast, vmlit(SymOrAssgn), 3); - astAddSeg2(th, oreqseg, vmlit(SymLocal), symnm); - parseAppendExp(comp, oreqseg); - } - } - } while (lexMatchNext(comp->lex, ",")); - lexMatchNext(comp->lex, "]"); - parseBlock(comp, methast); - } - else - parseStmts(comp, methast); - - comp->method->nbrlocals = arr_size(comp->locvarseg)-1; -} - -#ifdef __cplusplus -} // extern "C" -} // namespace avm -#endif \ No newline at end of file diff --git a/resources/examples/notworking/acornvm/parser_ast.c3 b/resources/examples/notworking/acornvm/parser_ast.c3 deleted file mode 100644 index eccabab9c..000000000 --- a/resources/examples/notworking/acornvm/parser_ast.c3 +++ /dev/null @@ -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); -} diff --git a/resources/examples/notworking/acornvm/symbol.c3 b/resources/examples/notworking/acornvm/symbol.c3 deleted file mode 100644 index c2c0b467b..000000000 --- a/resources/examples/notworking/acornvm/symbol.c3 +++ /dev/null @@ -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++; inbrAvail; i++) { - if ((sym=sym_tbl->symArray[i])) - return (Value) sym; - } - return aNull; // No next symbol, return null - } - } - return aNull; -} - - diff --git a/resources/examples/notworking/acornvm/typ_all.c3 b/resources/examples/notworking/acornvm/typ_all.c3 deleted file mode 100644 index 31024a5d8..000000000 --- a/resources/examples/notworking/acornvm/typ_all.c3 +++ /dev/null @@ -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; -} - diff --git a/resources/examples/notworking/acornvm/types.c3 b/resources/examples/notworking/acornvm/types.c3 deleted file mode 100644 index d3b922e5b..000000000 --- a/resources/examples/notworking/acornvm/types.c3 +++ /dev/null @@ -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 -} \ No newline at end of file diff --git a/resources/examples/notworking/acornvm/value.c3 b/resources/examples/notworking/acornvm/value.c3 deleted file mode 100644 index 4f09255fc..000000000 --- a/resources/examples/notworking/acornvm/value.c3 +++ /dev/null @@ -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); - diff --git a/resources/examples/notworking/acornvm/vm.c3 b/resources/examples/notworking/acornvm/vm.c3 deleted file mode 100644 index 8a592061a..000000000 --- a/resources/examples/notworking/acornvm/vm.c3 +++ /dev/null @@ -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 -/* 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(<ime)); - 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 && idxstdsym[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); -} -