klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

commit 0516e1be441b8e513ceba0c03f89c4896df73bc1
parent 4f00aa5516a9d1e59771438fd76ad28cbbc12ec9
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed, 23 Feb 2011 16:58:10 -0300

Added some support for errors, vm state & init and mem interface.

Diffstat:
Msrc/Makefile | 12+++++++++---
Asrc/kauxlib.c | 38++++++++++++++++++++++++++++++++++++++
Asrc/kauxlib.h | 26++++++++++++++++++++++++++
Asrc/kerror.c | 15+++++++++++++++
Asrc/kerror.h | 18++++++++++++++++++
Asrc/klimits.h | 40++++++++++++++++++++++++++++++++++++++++
Msrc/klisp.c | 53++++++++++++++++++++++++++++++++++++++++++-----------
Msrc/klisp.h | 32++++++++++++++++++++++++++++++++
Asrc/kmem.c | 51+++++++++++++++++++++++++++++++++++++++++++++++++++
Asrc/kmem.h | 29+++++++++++++++++++++++++++++
Msrc/kobject.h | 8++++++++
Asrc/kstate.c | 62++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Asrc/kstate.h | 117+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Msrc/ktoken.c | 4++++
14 files changed, 491 insertions(+), 14 deletions(-)

diff --git a/src/Makefile b/src/Makefile @@ -8,7 +8,7 @@ MYLDFLAGS= MYLIBS= CORE_O= kobject.o ktoken.o kpair.o kstring.o ksymbol.o kread.o \ - kwrite.o + kwrite.o kstate.o kmem.o kerror.o kauxlib.o KRN_T= klisp KRN_O= klisp.o @@ -32,12 +32,17 @@ clean: # list targets that do not create files (but not all makes understand .PHONY) .PHONY: all default o clean -klisp.o: klisp.c klisp.h kobject.h ktoken.h +klisp.o: klisp.c klisp.h kobject.h kread.h kwrite.h klimits.h kstate.h kmem.h \ + kerror.h kauxlib.h kobject.o: kobject.c kobject.h ktoken.o: ktoken.c ktoken.h kobject.h kpair.h kstring.h ksymbol.h kpair.o: kpair.c kpair.h kobject.h kstring.o: kstring.c kstring.h kobject.h # XXX: kpair.h because of use of list as symbol table -ksymbol.o: ksymbol.c ksymbol.h kobject.h kpair.h +ksymbol.o: ksymbol.c ksymbol.h kobject.h kpair.h kstate.h kread.o: kread.c kread.h kobject.h ktoken.h kpair.h kwrite.o: kwrite.c kwrite.h kobject.h kpair.h kstring.h +kstate.o: kstate.c kstate.h klisp.h kobject.h kmem.h +kmem.o: kmem.c kmem.h klisp.h kerror.h +kerror.o: kerror.c kerror.h klisp.h kstate.h +kauxlib.o: kauxlib.c kauxlib.h klisp.h kstate.h +\ No newline at end of file diff --git a/src/kauxlib.c b/src/kauxlib.c @@ -0,0 +1,38 @@ +/* +** kauxlib.h +** Auxiliary functions for klisp +** See Copyright Notice in klisp.h +*/ + +/* +** SOURCE NOTE: this is from lua, but is greatly reduced (for now) +*/ + +#include <stddef.h> +#include <stdlib.h> + +#include "klisp.h" +#include "kstate.h" + +/* generic alloc function */ +static void *k_alloc (void *ud, void *ptr, size_t osize, size_t nsize) { + (void)ud; + (void)osize; + if (nsize == 0) { + free(ptr); + return NULL; + } + else + return realloc(ptr, nsize); +} + +/* +** Create a new state with the default allocator +*/ +klisp_State *klispL_newstate (void) +{ + klisp_State *K = klisp_newstate(k_alloc, NULL); + /* TODO: set any panic functions or something like that... */ + return K; +} + diff --git a/src/kauxlib.h b/src/kauxlib.h @@ -0,0 +1,26 @@ +/* +** kauxlib.h +** Auxiliary functions for klisp +** See Copyright Notice in klisp.h +*/ + +/* +** SOURCE NOTE: this is from lua, but is greatly reduced (for now) +*/ + +#ifndef kauxlib_h +#define kauxlib_h + + +#include <stddef.h> +#include <stdlib.h> +#include <stdio.h> + +#include "klisp.h" + +/* +** Create a new state with the default allocator +*/ +klisp_State *klispL_newstate (void); + +#endif diff --git a/src/kerror.c b/src/kerror.c @@ -0,0 +1,15 @@ + +#include <stdio.h> +#include <stdlib.h> +#include <stdbool.h> +#include <setjmp.h> + +#include "klisp.h" +#include "kstate.h" + +void klispE_throw(klisp_State *K, char *msg, bool can_cont) +{ + fprintf(stderr, "\n*ERROR*: %s\n", msg); + K->error_can_cont = can_cont; + longjmp(K->error_jb, 1); +} diff --git a/src/kerror.h b/src/kerror.h @@ -0,0 +1,18 @@ +/* +** kerror.h +** Simple error notification and handling (TEMP) +** See Copyright Notice in klisp.h +*/ + + +#ifndef kerror_h +#define kerror_h + +#include <stdbool.h> + +#include "klisp.h" +#include "kstate.h" + +void klispE_throw(klisp_State *K, char *msg, bool can_cont); + +#endif diff --git a/src/klimits.h b/src/klimits.h @@ -0,0 +1,40 @@ +/* +** klimits.h +** Limits, basic types, and some other `installation-dependent' definitions +** See Copyright Notice in klisp.h +*/ + +/* +** SOURCE NOTE: this is from lua (greatly reduced) +*/ + +#ifndef klimits_h +#define klimits_h + +#include <limits.h> +#include <stddef.h> + +#include "klisp.h" + +/* internal assertions for in-house debugging */ +#ifdef klisp_assert + +#define check_exp(c,e) (klisp_assert(c), (e)) + +#else + +#define klisp_assert(c) ((void)0) +#define check_exp(c,e) (e) + +#endif + + +#ifndef UNUSED +#define UNUSED(x) ((void)(x)) /* to avoid warnings */ +#endif + +#ifndef cast +#define cast(t, exp) ((t)(exp)) +#endif + +#endif diff --git a/src/klisp.c b/src/klisp.c @@ -5,34 +5,65 @@ */ #include <stdio.h> +#include <stdlib.h> +#include <assert.h> -#include <inttypes.h> -#include <math.h> +#include <setjmp.h> +/* turn on assertions for internal checking */ +#define klisp_assert (assert) +#include "klimits.h" + +#include "klisp.h" #include "kobject.h" +#include "kauxlib.h" +#include "kstate.h" #include "kread.h" #include "kwrite.h" +/* +** Simple read/write loop +*/ +void main_body() +{ + TValue obj = KNIL; + + while(!ttiseof(obj)) { + obj = kread(); + kwrite(obj); + knewline(); + } +} + int main(int argc, char *argv[]) { - /* - ** Simple read/write loop - */ printf("Read/Write Test\n"); + /* TEMP: old initialization */ kread_file = stdin; kread_filename = "*STDIN*"; kwrite_file = stdout; kread_init(); kwrite_init(); - TValue obj = KNIL; + klisp_State *K = klispL_newstate(); + int ret_value = 0; + bool done = false; - while(!ttiseof(obj)) { - obj = kread(); - kwrite(obj); - knewline(); + while(!done) { + if (setjmp(K->error_jb)) { + /* error signaled */ + if (!K->error_can_cont) { + ret_value = 1; + done = true; + } + } else { + main_body(); + ret_value = 0; + done = true; + } } - return 0; + klisp_close(K); + return ret_value; } diff --git a/src/klisp.h b/src/klisp.h @@ -4,6 +4,36 @@ ** See Copyright Notice at the end of this file */ +#ifndef klisp_h +#define klisp_h + +#include <stdlib.h> + +#include "kobject.h" + +/* +** SOURCE NOTE: This is mostly from Lua. +*/ + +typedef struct klisp_State klisp_State; + +/* +** prototype for memory-allocation functions +*/ +typedef void * (*klisp_Alloc) + (void *ud, void *ptr, size_t osize, size_t nsize); + +/* +** prototype for callable c functions from the interpreter main loop: +*/ +typedef void (klisp_Ifunc) (TValue *ud, TValue val); + +/* +** state manipulation +*/ +klisp_State *klisp_newstate (klisp_Alloc f, void *ud); +void klisp_close (klisp_State *K); + /****************************************************************************** * Copyright (C) 2011 Andres Navarro. All rights reserved. * Lua parts: Copyright (C) 1994-2010 Lua.org, PUC-Rio. All rights reserved. @@ -27,3 +57,5 @@ * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ******************************************************************************/ + +#endif diff --git a/src/kmem.c b/src/kmem.c @@ -0,0 +1,51 @@ +/* +** kmem.c +** Interface to Memory Manager +** See Copyright Notice in klisp.h +*/ + + +/* +** SOURCE NOTE: This is from Lua, but greatly shortened +*/ + +#include <stddef.h> +#include <assert.h> + +#include "klisp.h" +#include "klimits.h" +#include "kmem.h" +#include "kerror.h" + +/* +** About the realloc function: +** void * frealloc (void *ud, void *ptr, size_t osize, size_t nsize); +** (`osize' is the old size, `nsize' is the new size) +** +** klisp ensures that (ptr == NULL) iff (osize == 0). +** +** * frealloc(ud, NULL, 0, x) creates a new block of size `x' +** +** * frealloc(ud, p, x, 0) frees the block `p' +** (in this specific case, frealloc must return NULL). +** particularly, frealloc(ud, NULL, 0, 0) does nothing +** (which is equivalent to free(NULL) in ANSI C) +** +** frealloc returns NULL if it cannot create or reallocate the area +** (any reallocation to an equal or smaller size cannot fail!) +*/ + + +/* +** generic allocation routine. +*/ +void *klispM_realloc_ (klisp_State *K, void *block, size_t osize, size_t nsize) { + klisp_assert((osize == 0) == (block == NULL)); + + block = (*K->frealloc)(K->ud, block, osize, nsize); + if (block == NULL && nsize > 0) + klispE_throw(K, MEMERRMSG, false); + klisp_assert((nsize == 0) == (block == NULL)); + K->totalbytes = (K->totalbytes - osize) + nsize; + return block; +} diff --git a/src/kmem.h b/src/kmem.h @@ -0,0 +1,29 @@ +/* +** kmem.h +** Interface to Memory Manager +** See Copyright Notice in klisp.h +*/ + +#ifndef kmem_h +#define kmem_h + +/* +** SOURCE NOTE: This is from Lua, but greatly shortened +*/ + +#include <stddef.h> + +#include "klisp.h" + +#define MEMERRMSG "not enough memory" + +#define klispM_freemem(L, b, s) klispM_realloc_(L, (b), (s), 0) +#define klispM_free(L, b) klispM_realloc_(L, (b), sizeof(*(b)), 0) + +#define klispM_malloc(L,t) klispM_realloc_(L, NULL, 0, (t)) +#define klispM_new(L,t) cast(t *, klispM_malloc(L, sizeof(t))) + +void *klispM_realloc_ (klisp_State *K, void *block, size_t oldsize, + size_t size); + +#endif diff --git a/src/kobject.h b/src/kobject.h @@ -209,6 +209,13 @@ typedef struct __attribute__ ((__packed__)) { TValue si; /* source code info (either () or (filename line col) */ } Pair; +typedef struct __attribute__ ((__packed__)) { + CommonHeader; + TValue name; /* cont name/type */ + TValue si; /* source code info (either () or (filename line col) */ + /* TODO */ +} Continuation; + /* XXX: Symbol should probably contain a String instead of a char buf */ typedef struct __attribute__ ((__packed__)) { CommonHeader; @@ -250,6 +257,7 @@ union GCObject { Pair pair; Symbol sym; String str; + Continuation cont; }; diff --git a/src/kstate.c b/src/kstate.c @@ -0,0 +1,62 @@ +/* +** kstate.c +** klisp vm state +** See Copyright Notice in klisp.h +*/ + +/* +** SOURCE NOTE: this is mostly from Lua. +*/ + +#include <stddef.h> + +#include "klisp.h" +#include "kstate.h" +#include "kmem.h" + +/* +** State creation and destruction +*/ +klisp_State *klisp_newstate (klisp_Alloc f, void *ud) { + klisp_State *K; + void *k = (*f)(ud, NULL, 0, state_size()); + if (k == NULL) return NULL; + void *s = (*f)(ud, NULL, 0, KS_ISSIZE * sizeof(TValue)); + if (s == NULL) { + (*f)(ud, s, KS_ISSIZE * sizeof(TValue), 0); + return NULL; + } + K = (klisp_State *) k; + + K->symbol_table = KNIL; + /* TODO: create a continuation */ + K->curr_cont = NULL; + K->ret_value = KINERT; + + K->frealloc = f; + K->ud = ud; + + /* current input and output */ + K->curr_in = stdin; + K->curr_out = stdout; + + /* TODO: more gc info */ + K->totalbytes = KS_ISSIZE + state_size(); + + /* TEMP: err */ + /* do nothing for now */ + + K->ssize = KS_ISSIZE; + K->stop = 0; /* stack is empty */ + K->sbuf = (TValue **)s; + + return K; +} + +void klisp_close (klisp_State *K) +{ + /* TODO: free memory for all objects */ + klispM_freemem(K, ks_sbuf(K), ks_ssize(K)); + /* NOTE: this needs to be done "by hand" */ + (*(K->frealloc))(K->ud, K, state_size(), 0); +} diff --git a/src/kstate.h b/src/kstate.h @@ -0,0 +1,117 @@ +/* +** kstate.h +** klisp vm state +** See Copyright Notice in klisp.h +*/ + +/* +** SOURCE NOTE: The main structure is from Lua, but because (for now) +** klisp is single threaded, only global state is provided. +*/ + +#ifndef kstate_h +#define kstate_h + +/* TEMP: for error signaling */ +#include <assert.h> + +#include <stdio.h> +#include <setjmp.h> + +#include "kobject.h" +#include "klimits.h" +#include "klisp.h" + +struct klisp_State { + TValue symbol_table; + Continuation *curr_cont; + + TValue ret_value; /* the value to be passed to the next function */ + + klisp_Alloc frealloc; /* function to reallocate memory */ + void *ud; /* auxiliary data to `frealloc' */ + + /* TODO: gc info */ + int32_t totalbytes; + + /* TEMP:error handling */ + jmp_buf error_jb; + bool error_can_cont; /* can continue after error? */ + + /* standard input and output */ + /* TODO: eventually these should be ports */ + FILE *curr_in; + FILE *curr_out; + + /* auxiliary stack */ + int32_t ssize; /* total size of array */ + int32_t stop; /* top of the stack (all elements are below this index) */ + TValue **sbuf; + }; + +/* some size related macros */ +#define KS_ISSIZE (1024) +#define state_size() (sizeof(klisp_State)) + + /* + ** TEMP: for now use inlined functions, later check output in + ** different compilers and/or profile to see if it's worthy to + ** eliminate it, change it to compiler specific or replace it + ** with defines + */ +inline void ks_spush(klisp_State *K, TValue obj); +inline TValue ks_spop(klisp_State *K); +/* this is for DISCARDING stack pop (value isn't used, avoid warning) */ +#define ks_dspop(st_) (UNUSED(ks_spop(st_))) +inline TValue ks_sget(klisp_State *K); +inline void ks_sclear(klisp_State *K); + +/* +** Stack manipulation functions +*/ + +/* Aux Stack manipulation macros */ +#define ks_ssize(st_) ((st_)->ssize) +#define ks_stop(st_) ((st_)->stop) +#define ks_sbuf(st_) ((st_)->sbuf) +#define ks_selem(st_, i_) ((*ks_sbuf(st_))[i_]) + +inline void ks_spush(klisp_State *K, TValue obj) +{ + if (ks_stop(K) == ks_ssize(K)) { + /* TODO: try realloc */ + assert(0); + } + ks_selem(K, ks_stop(K)) = obj; + ++ks_stop(K); +} + + +inline TValue ks_spop(klisp_State *K) +{ + if (ks_ssize(K) != KS_ISSIZE && ks_stop(K) < (ks_ssize(K) / 4)) { + /* NOTE: shrink can't fail */ + + /* TODO: do realloc */ + } + TValue obj = ks_selem(K, ks_stop(K) - 1); + --ks_stop(K); + return obj; +} + +inline TValue ks_sget(klisp_State *K) +{ + return ks_selem(K, ks_stop(K) - 1); +} + +inline void ks_sclear(klisp_State *K) +{ + if (ks_ssize(K) != KS_ISSIZE) { + /* NOTE: shrink can't fail */ + /* TODO do realloc */ + } + ks_ssize(K) = KS_ISSIZE; + ks_stop(K) = 0; +} + +#endif diff --git a/src/ktoken.c b/src/ktoken.c @@ -4,6 +4,10 @@ ** See Copyright Notice in klisp.h */ +/* +** Symbols should be converted to some standard case before interning +** (in this case downcase) +*/ /* ** TODO: