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:
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:
