commit 5cea8cb72e00d0e339b3951bc27473975a098cf6
parent 0516e1be441b8e513ceba0c03f89c4896df73bc1
Author: Andres Navarro <canavarro82@gmail.com>
Date: Sat, 26 Feb 2011 05:28:32 -0300
Used the vm state & error routine in tokenizer, reader and writer. Used the mem interface in all constructors.
Diffstat:
16 files changed, 700 insertions(+), 581 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -35,14 +35,15 @@ clean:
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
+ktoken.o: ktoken.c ktoken.h kobject.h kstate.h kpair.h kstring.h ksymbol.h \
+ kerror.h
+kpair.o: kpair.c kpair.h kobject.h kstate.h kmem.h
+kstring.o: kstring.c kstring.h kobject.h kstate.h kmem.h
# XXX: kpair.h because of use of list as symbol table
-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
+ksymbol.o: ksymbol.c ksymbol.h kobject.h kpair.h kstate.h kmem.h
+kread.o: kread.c kread.h kobject.h ktoken.h kpair.h kstate.h kerror.h
+kwrite.o: kwrite.c kwrite.h kobject.h kpair.h kstring.h kstate.h kerror.h
+kstate.o: kstate.c kstate.h klisp.h kobject.h kmem.h kstring.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/klisp.c b/src/klisp.c
@@ -24,14 +24,14 @@
/*
** Simple read/write loop
*/
-void main_body()
+void main_body(klisp_State *K)
{
TValue obj = KNIL;
while(!ttiseof(obj)) {
- obj = kread();
- kwrite(obj);
- knewline();
+ obj = kread(K);
+ kwrite(K, obj);
+ knewline(K);
}
}
@@ -39,13 +39,6 @@ int main(int argc, char *argv[])
{
printf("Read/Write Test\n");
- /* TEMP: old initialization */
- kread_file = stdin;
- kread_filename = "*STDIN*";
- kwrite_file = stdout;
- kread_init();
- kwrite_init();
-
klisp_State *K = klispL_newstate();
int ret_value = 0;
bool done = false;
@@ -53,12 +46,18 @@ int main(int argc, char *argv[])
while(!done) {
if (setjmp(K->error_jb)) {
/* error signaled */
- if (!K->error_can_cont) {
+ if (K->error_can_cont) {
+ /* XXX: clear stack and char buffer, clear shared dict */
+ /* TODO: put these in handlers for read-token, read and write */
+ ks_sclear(K);
+ ks_tbclear(K);
+ K->shared_dict = KNIL;
+ } else {
ret_value = 1;
done = true;
}
} else {
- main_body();
+ main_body(K);
ret_value = 0;
done = true;
}
diff --git a/src/kpair.c b/src/kpair.c
@@ -4,18 +4,15 @@
** See Copyright Notice in klisp.h
*/
-/* XXX: for malloc */
-#include <stdlib.h>
-/* TODO: use a generalized alloc function */
-
#include "kpair.h"
#include "kobject.h"
+#include "kstate.h"
+#include "kmem.h"
-/* TODO: Out of memory errors */
/* TEMP: for now all pairs are mutable */
-TValue kcons(TValue car, TValue cdr)
+TValue kcons(klisp_State *K, TValue car, TValue cdr)
{
- Pair *new_pair = malloc(sizeof(Pair));
+ Pair *new_pair = klispM_new(K, Pair);
new_pair->next = NULL;
new_pair->gct = 0;
diff --git a/src/kpair.h b/src/kpair.h
@@ -8,6 +8,7 @@
#define kpair_h
#include "kobject.h"
+#include "kstate.h"
/* TODO: add type assertions */
/* TODO: add more kc[ad]*r combinations */
@@ -17,10 +18,10 @@
#define kset_car(p_, v_) (kcar(p_) = (v_))
#define kset_cdr(p_, v_) (kcdr(p_) = (v_))
-#define kdummy_cons() (kcons(KNIL, KNIL))
+#define kdummy_cons(st_) (kcons(st_, KNIL, KNIL))
/* TEMP: for now all pairs are mutable */
-TValue kcons(TValue, TValue);
+TValue kcons(klisp_State *K, TValue car, TValue cdr);
#define kget_source_info(p_) (tv2pair(p_)->si)
#define kset_source_info(p_, si_) (kget_source_info(p_) = (si_))
diff --git a/src/kread.c b/src/kread.c
@@ -10,36 +10,28 @@
**
** - Read mutable/immutable objects (cons function should be a parameter)
** this is needed because some functions (like load) return immutable objs
-** - Decent error handling mechanism
**
*/
#include <stdio.h>
-/* XXX for malloc */
#include <stdlib.h>
-/* TODO: use a generalized alloc function */
-/* TEMP: for out of mem errors */
#include <assert.h>
#include "kread.h"
#include "kobject.h"
#include "kpair.h"
#include "ktoken.h"
-
-/* TODO: move to the global state */
-/* TODO: replace the list with a hashtable */
-TValue shared_dict = KNIL_;
-FILE *kread_file = NULL;
-char *kread_filename = NULL;
+#include "kstate.h"
+#include "kerror.h"
/*
-** Stacks for the read FSM
+** Stack for the read FSM
**
-** The state stack is never empty while read is in process and
+** There is always one state in the stack while read is in process and
** selects the action to be performed on the next read token.
**
-** The data saved in the data stack changes according to state:
+** The data saved in the stack is below the state and changes according to it:
** ST_FIRST_LIST: pair representing the first pair of the list
** with source info of the '(' token.
** ST_MIDDLE_LIST, ST_LAST_ILIST: two elements, first below, second on top:
@@ -54,70 +46,28 @@ char *kread_filename = NULL;
**
*/
-/* TODO: move to the global state */
typedef enum {
ST_READ, ST_SHARED_DEF, ST_LAST_ILIST, ST_PAST_LAST_ILIST,
ST_FIRST_LIST, ST_MIDDLE_LIST
} state_t;
-state_t *sstack;
-int sstack_size;
-int sstack_i;
-
-TValue *dstack;
-int dstack_size;
-int dstack_i;
-
-/* TEMP: for now stacks are fixed size, use asserts to check */
-#define STACK_INIT_SIZE 1024
+#define push_state(kst_, st_) (ks_spush(kst_, (i2tv((int32_t)(st_)))))
+#define get_state(kst_) ((state_t) ivalue(ks_sget(kst_)))
+#define pop_state(kst_) (ks_sdpop(kst_))
-#define push_state(st_) ({ assert(sstack_i < sstack_size); \
- sstack[sstack_i++] = (st_); })
-#define pop_state() (--sstack_i)
-#define get_state() (sstack[sstack_i-1])
-#define clear_state() (sstack_i = 0)
+#define push_data(kst_, st_) (ks_spush(kst_, st_))
+#define get_data(kst_) (ks_sget(kst_))
+#define pop_data(kst_) (ks_sdpop(kst_))
-#define push_data(data_) ({ assert(dstack_i < dstack_size); \
- dstack[dstack_i++] = (data_); })
-#define pop_data() (--dstack_i)
-#define get_data() (dstack[dstack_i-1])
-#define clear_data() (dstack_i = 0)
/*
** Error management
*/
-TValue kread_error(char *str)
+void kread_error(klisp_State *K, char *str)
{
- /* TODO: Decide on error handling mechanism for reader (& tokenizer) */
- printf("READ ERROR: %s\n", str);
- return KEOF;
-}
-
-/*
-** Reader initialization
-*/
-void kread_init()
-{
- assert(kread_file != NULL);
- assert(kread_filename != NULL);
-
- ktok_file = kread_file;
- ktok_source_info.filename = kread_filename;
- /* XXX: For now just hardcode it to 8 spaces tab-stop */
- ktok_source_info.tab_width = 8;
- ktok_init();
- ktok_reset_source_info();
-
- /* XXX: for now use a fixed size for stacks */
- sstack_size = STACK_INIT_SIZE;
- clear_state();
- sstack = malloc(STACK_INIT_SIZE*sizeof(state_t));
- assert(sstack != NULL);
-
- dstack_size = STACK_INIT_SIZE;
- clear_data();
- dstack = malloc(STACK_INIT_SIZE*sizeof(TValue));
- assert(dstack != NULL);
+ /* clear the stack */
+ ks_sclear(K);
+ klispE_throw(K, str, true);
}
/*
@@ -125,50 +75,56 @@ void kread_init()
*/
/* This is called after kread to clear the shared alist */
-void clear_shared_dict()
+void clear_shared_dict(klisp_State *K)
{
- shared_dict = KNIL;
+ K->shared_dict = KNIL;
}
-TValue try_shared_ref(TValue ref_token)
+TValue try_shared_ref(klisp_State *K, TValue ref_token)
{
/* TEMP: for now, only allow fixints in shared tokens */
int32_t ref_num = ivalue(kcdr(ref_token));
- TValue tail = shared_dict;
+ TValue tail = K->shared_dict;
while (!ttisnil(tail)) {
TValue head = kcar(tail);
if (ref_num == ivalue(kcar(head)))
return kcdr(head);
tail = kcdr(tail);
}
- return kread_error("undefined shared ref found");
+
+ kread_error(K, "undefined shared ref found");
+ /* avoid warning */
+ return KINERT;
}
-TValue try_shared_def(TValue def_token, TValue value)
+TValue try_shared_def(klisp_State *K, TValue def_token, TValue value)
{
/* TEMP: for now, only allow fixints in shared tokens */
int32_t ref_num = ivalue(kcdr(def_token));
- TValue tail = shared_dict;
+ TValue tail = K->shared_dict;
while (!ttisnil(tail)) {
TValue head = kcar(tail);
- if (ref_num == ivalue(kcar(head)))
- return kread_error("duplicate shared def found");
+ if (ref_num == ivalue(kcar(head))) {
+ kread_error(K, "duplicate shared def found");
+ /* avoid warning */
+ return KINERT;
+ }
tail = kcdr(tail);
}
- /* XXX: what happens on out of mem? & gc?(inner cons is not rooted) */
- shared_dict = kcons(kcons(kcdr(def_token), value),
- shared_dict);
+ /* XXX: what happens on out of mem? & gc? (inner cons is not rooted) */
+ K->shared_dict = kcons(K, kcons(K, kcdr(def_token), value),
+ K->shared_dict);
return KINERT;
}
/* This overwrites a previouly made def, it is used in '() */
/* NOTE: the shared def is guaranteed to exist */
-void change_shared_def(TValue def_token, TValue value)
+void change_shared_def(klisp_State *K, TValue def_token, TValue value)
{
/* TEMP: for now, only allow fixints in shared tokens */
int32_t ref_num = ivalue(kcdr(def_token));
- TValue tail = shared_dict;
+ TValue tail = K->shared_dict;
while (!ttisnil(tail)) {
TValue head = kcar(tail);
if (ref_num == ivalue(kcar(head))) {
@@ -185,9 +141,11 @@ void change_shared_def(TValue def_token, TValue value)
** Reader FSM
*/
/* TEMP: For now we'll use just one big function */
-TValue kread_fsm()
+TValue kread_fsm(klisp_State *K)
{
- push_state(ST_READ);
+ assert(ks_sisempty(K));
+ assert(ttisnil(K->shared_dict));
+ push_state(K, ST_READ);
/* read next token or process obj */
bool read_next_token = true;
@@ -196,46 +154,54 @@ TValue kread_fsm()
/* the source code information of that obj */
TValue obj_si;
- while (!(get_state() == ST_READ && !read_next_token)) {
+ while (!(get_state(K) == ST_READ && !read_next_token)) {
if (read_next_token) {
- TValue tok = ktok_read_token();
+ TValue tok = ktok_read_token(K);
if (ttispair(tok)) { /* special token */
switch (chvalue(kcar(tok))) {
case '(': {
- if (get_state() == ST_PAST_LAST_ILIST)
- return kread_error("open paren found after "
- "last element of improper list");
- TValue np = kdummy_cons();
+ if (get_state(K) == ST_PAST_LAST_ILIST) {
+ kread_error(K, "open paren found after "
+ "last element of improper list");
+ /* avoid warning */
+ return KINERT;
+ }
+ TValue np = kdummy_cons(K);
/*
** NOTE: the source info of the '(' is temporarily saved
** in np (later it will be replace by the source info
** of the car of the list
*/
- kset_source_info(np, ktok_get_source_info());
+ kset_source_info(np, ktok_get_source_info(K));
/* update the shared def to point to the new list */
- /* NOTE: this is necessary for self referrencing lists */
+ /* NOTE: this is necessary for self referencing lists */
/* NOTE: the shared def was already checked for errors */
- if (get_state() == ST_SHARED_DEF)
- change_shared_def(kcar(get_data()), np);
+ if (get_state(K) == ST_SHARED_DEF) {
+ /* take the state out of the way */
+ pop_state(K);
+ change_shared_def(K, kcar(get_data(K)), np);
+ push_state(K, ST_SHARED_DEF);
+ }
/* start reading elements of the new list */
- push_state(ST_FIRST_LIST);
- push_data(np);
+ push_data(K, np);
+ push_state(K, ST_FIRST_LIST);
read_next_token = true;
break;
}
case ')': {
- switch(get_state()) {
+ switch(get_state(K)) {
case ST_FIRST_LIST: { /* empty list */
/*
** Discard the pair in sdata but
** retain the source info
** Return () for processing
*/
- TValue fp_with_old_si = get_data();
- pop_data();
- pop_state();
+ pop_state(K);
+ TValue fp_with_old_si = get_data(K);
+ pop_data(K);
+
obj = KNIL;
obj_si = kget_source_info(fp_with_old_si);
read_next_token = false;
@@ -243,12 +209,12 @@ TValue kread_fsm()
}
case ST_MIDDLE_LIST: /* end of list */
case ST_PAST_LAST_ILIST: { /* end of ilist */
+ pop_state(K);
/* discard info on last pair */
- pop_data();
- pop_state();
- TValue fp_old_si = get_data();
- pop_data();
- pop_state();
+ pop_data(K);
+ pop_state(K);
+ TValue fp_old_si = get_data(K);
+ pop_data(K);
/* list read ok, process it in next iteration */
obj = kcar(fp_old_si);
obj_si = kcdr(fp_old_si);
@@ -256,62 +222,84 @@ TValue kread_fsm()
break;
}
case ST_LAST_ILIST:
- return kread_error("missing last element in "
- "improper list");
+ kread_error(K, "missing last element in "
+ "improper list");
+ /* avoid warning */
+ return KINERT;
case ST_SHARED_DEF:
- return kread_error("unmatched closing paren found "
- "in shared def");
+ kread_error(K, "unmatched closing paren found "
+ "in shared def");
+ /* avoid warning */
+ return KINERT;
case ST_READ:
- return kread_error("unmatched closing paren found");
+ kread_error(K, "unmatched closing paren found");
+ /* avoid warning */
+ return KINERT;
default:
/* shouldn't happen */
- assert(0);
+ kread_error(K, "Unknown read state in )");
+ /* avoid warning */
+ return KINERT;
}
break;
}
case '.': {
- switch(get_state()) {
+ switch(get_state(K)) {
case (ST_MIDDLE_LIST):
/* tok ok, read next obj for cdr of ilist */
- pop_state();
- push_state(ST_LAST_ILIST);
+ pop_state(K);
+ push_state(K, ST_LAST_ILIST);
read_next_token = true;
break;
case ST_FIRST_LIST:
- return kread_error("missing first element of "
- "improper list");
+ kread_error(K, "missing first element of "
+ "improper list");
+ /* avoid warning */
+ return KINERT;
case ST_LAST_ILIST:
case ST_PAST_LAST_ILIST:
- return kread_error("double dot in improper list");
+ kread_error(K, "double dot in improper list");
+ /* avoid warning */
+ return KINERT;
case ST_SHARED_DEF:
- return kread_error("dot found in shared def");
+ kread_error(K, "dot found in shared def");
+ /* avoid warning */
+ return KINERT;
case ST_READ:
- return kread_error("dot found outside list");
+ kread_error(K, "dot found outside list");
+ /* avoid warning */
+ return KINERT;
default:
/* shouldn't happen */
- assert(0);
+ kread_error(K, "Unknown read state in .");
+ /* avoid warning */
+ return KINERT;
}
break;
}
case '=': { /* srfi-38 shared def */
- switch (get_state()) {
+ switch (get_state(K)) {
case ST_SHARED_DEF:
- return kread_error("shared def found in "
- "shared def");
+ kread_error(K, "shared def found in "
+ "shared def");
+ /* avoid warning */
+ return KINERT;
case ST_PAST_LAST_ILIST:
- return kread_error("shared def found after "
- "last element of improper list");
+ kread_error(K, "shared def found after "
+ "last element of improper list");
+ /* avoid warning */
+ return KINERT;
default: {
- TValue res = try_shared_def(tok, KNIL);
+ TValue res = try_shared_def(K, tok, KNIL);
/* TEMP: while error returns EOF */
if (ttiseof(res)) {
return res;
} else {
/* token ok, read defined object */
- push_state(ST_SHARED_DEF);
/* NOTE: save the source info to return it
after the defined object is read */
- push_data(kcons(tok, ktok_get_source_info()));
+ push_data(K, kcons(K, tok, ktok_get_source_info(K)));
+ push_state(K, ST_SHARED_DEF);
read_next_token = true;
}
}
@@ -319,15 +307,19 @@ TValue kread_fsm()
break;
}
case '#': { /* srfi-38 shared ref */
- switch(get_state()) {
+ switch(get_state(K)) {
case ST_SHARED_DEF:
- return kread_error("shared ref found in "
- "shared def");
+ kread_error(K, "shared ref found in "
+ "shared def");
+ /* avoid warning */
+ return KINERT;
case ST_PAST_LAST_ILIST:
- return kread_error("shared ref found after "
- "last element of improper list");
+ kread_error(K, "shared ref found after "
+ "last element of improper list");
+ /* avoid warning */
+ return KINERT;
default: {
- TValue res = try_shared_ref(tok);
+ TValue res = try_shared_ref(K, tok);
/* TEMP: while error returns EOF */
if (ttiseof(res)) {
return res;
@@ -335,7 +327,7 @@ TValue kread_fsm()
/* ref ok, process it in next iteration */
obj = res;
/* NOTE: use source info of ref token */
- obj_si = ktok_get_source_info();
+ obj_si = ktok_get_source_info(K);
read_next_token = false;
}
}
@@ -344,45 +336,59 @@ TValue kread_fsm()
}
default:
/* shouldn't happen */
- assert(0);
+ kread_error(K, "unknown special token");
+ /* avoid warning */
+ return KINERT;
}
} else if (ttiseof(tok)) {
- switch (get_state()) {
+ switch (get_state(K)) {
case ST_READ:
/* will exit in next loop */
obj = tok;
- obj_si = ktok_get_source_info();
+ obj_si = ktok_get_source_info(K);
read_next_token = false;
break;
case ST_FIRST_LIST:
case ST_MIDDLE_LIST:
- return kread_error("EOF found while reading list");
+ kread_error(K, "EOF found while reading list");
+ /* avoid warning */
+ return KINERT;
case ST_LAST_ILIST:
case ST_PAST_LAST_ILIST:
- return kread_error("EOF found while reading "
+ kread_error(K, "EOF found while reading "
"improper list");
+ /* avoid warning */
+ return KINERT;
case ST_SHARED_DEF:
- return kread_error("EOF found in shared def");
+ kread_error(K, "EOF found in shared def");
+ /* avoid warning */
+ return KINERT;
default:
/* shouldn't happen */
- assert(0);
+ kread_error(K, "unknown read state in EOF");
+ /* avoid warning */
+ return KINERT;
}
} else { /* this can only be a complete token */
- if (get_state() == ST_PAST_LAST_ILIST) {
- return kread_error("Non paren found after last "
- "element of improper list");
+ if (get_state(K) == ST_PAST_LAST_ILIST) {
+ kread_error(K, "Non paren found after last "
+ "element of improper list");
+ /* avoid warning */
+ return KINERT;
} else {
/* token ok, process it in next iteration */
obj = tok;
- obj_si = ktok_get_source_info();
+ obj_si = ktok_get_source_info(K);
read_next_token = false;
}
}
} else { /* if(read_next_token) */
/* process the object just read */
- switch(get_state()) {
+ switch(get_state(K)) {
case ST_FIRST_LIST: {
- TValue fp = get_data();
+ /* get the state out of the way */
+ pop_state(K);
+ TValue fp = get_data(K);
/* replace source info in fp with the saved one */
/* NOTE: the old one will be returned when list is complete */
TValue fp_old_si = kget_source_info(fp);
@@ -390,39 +396,43 @@ TValue kread_fsm()
kset_car(fp, obj);
/* continue reading objects of list */
- push_state(ST_MIDDLE_LIST);
- pop_data();
/* save first & last pair of the (still incomplete) list */
- push_data(kcons (fp, fp_old_si));
- push_data(fp);
+ pop_data(K);
+ push_data(K, kcons (K, fp, fp_old_si));
+ push_state(K, ST_FIRST_LIST);
+ push_data(K, fp);
+ push_state(K, ST_MIDDLE_LIST);
read_next_token = true;
break;
}
case ST_MIDDLE_LIST: {
- TValue np = kcons(obj, KNIL);
+ /* get the state out of the way */
+ pop_state(K);
+ TValue np = kcons(K, obj, KNIL);
kset_source_info(np, obj_si);
- kset_cdr(get_data(), np);
+ kset_cdr(get_data(K), np);
/* replace last pair of the (still incomplete) read next obj */
- pop_data();
- push_data(np);
+ pop_data(K);
+ push_data(K, np);
+ push_state(K, ST_MIDDLE_LIST);
read_next_token = true;
break;
}
case ST_LAST_ILIST:
- kset_cdr(get_data(), obj);
- /* only change the state, keep the pair in data to simplify
+ /* only change the state, keep the pair data to simplify
the close paren code (same as for ST_MIDDLE_LIST) */
- pop_state();
- push_state(ST_PAST_LAST_ILIST);
+ pop_state(K);
+ kset_cdr(get_data(K), obj);
+ push_state(K, ST_PAST_LAST_ILIST);
read_next_token = true;
break;
case ST_SHARED_DEF: {
/* shared def completed, continue processing obj */
- TValue def_si = get_data();
- pop_state();
- pop_data();
+ pop_state(K);
+ TValue def_si = get_data(K);
+ pop_data(K);
- change_shared_def(kcar(def_si), obj);
+ change_shared_def(K, kcar(def_si), obj);
/* obj = obj; */
/* the source info returned is the one from the shared def */
@@ -432,33 +442,37 @@ TValue kread_fsm()
}
case ST_READ:
/* this shouldn't happen, should've exited the while */
- assert(0);
+ kread_error(K, "invalid read state (read in while)");
+ /* avoid warning */
+ return KINERT;
default:
/* shouldn't happen */
- assert(0);
+ kread_error(K, "unknown read state in process obj");
+ /* avoid warning */
+ return KINERT;
}
}
}
+ pop_state(K);
+ assert(ks_sisempty(K));
return obj;
}
/*
** Reader Main Function
*/
-TValue kread()
+TValue kread(klisp_State *K)
{
TValue obj;
/* TEMP: for now assume we are in the repl: reset source info */
- ktok_reset_source_info();
+ ktok_reset_source_info(K);
- obj = kread_fsm();
+ obj = kread_fsm(K);
/* NOTE: clear after function to allow earlier gc */
- clear_shared_dict();
- clear_state();
- clear_data();
+ clear_shared_dict(K);
return obj;
}
diff --git a/src/kread.h b/src/kread.h
@@ -7,19 +7,13 @@
#ifndef kread_h
#define kread_h
-#include <stdio.h>
-
#include "kobject.h"
+#include "kstate.h"
/*
** Reader interface
*/
-void kread_init();
-TValue kread();
-
-/* TODO: move this to the global state */
-FILE *kread_file;
-char *kread_filename;
+TValue kread(klisp_State *K);
#endif
diff --git a/src/kstate.c b/src/kstate.c
@@ -23,9 +23,16 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
if (k == NULL) return NULL;
void *s = (*f)(ud, NULL, 0, KS_ISSIZE * sizeof(TValue));
if (s == NULL) {
+ (*f)(ud, k, state_size(), 0);
+ return NULL;
+ }
+ void *b = (*f)(ud, NULL, 0, KS_ITBSIZE);
+ if (b == NULL) {
+ (*f)(ud, k, state_size(), 0);
(*f)(ud, s, KS_ISSIZE * sizeof(TValue), 0);
return NULL;
}
+
K = (klisp_State *) k;
K->symbol_table = KNIL;
@@ -39,6 +46,8 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
/* current input and output */
K->curr_in = stdin;
K->curr_out = stdout;
+ K->filename_in = "*STDIN*";
+ K->filename_out = "*STDOUT*";
/* TODO: more gc info */
K->totalbytes = KS_ISSIZE + state_size();
@@ -48,8 +57,23 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
K->ssize = KS_ISSIZE;
K->stop = 0; /* stack is empty */
- K->sbuf = (TValue **)s;
+ K->sbuf = (TValue *)s;
+
+ /* initialize tokenizer */
+ ks_tbsize(K) = KS_ITBSIZE;
+ ks_tbidx(K) = 0; /* buffer is empty */
+ ks_tbuf(K) = (char *)b;
+
+ /* XXX: For now just hardcode it to 8 spaces tab-stop */
+ K->ktok_source_info.tab_width = 8;
+ K->ktok_source_info.filename = "*STDIN*";
+ ktok_init(K);
+ ktok_reset_source_info(K);
+
+ /* initialize reader */
+ K->shared_dict = KNIL;
+ /* initialize writer */
return K;
}
diff --git a/src/kstate.h b/src/kstate.h
@@ -21,6 +21,20 @@
#include "kobject.h"
#include "klimits.h"
#include "klisp.h"
+#include "ktoken.h"
+
+/* XXX: for now, lines and column names are fixints */
+/* MAYBE: this should be in tokenizer */
+typedef struct {
+ char *filename;
+ int32_t tab_width;
+ int32_t line;
+ int32_t col;
+
+ char *saved_filename;
+ int32_t saved_line;
+ int32_t saved_col;
+} ksource_info_t;
struct klisp_State {
TValue symbol_table;
@@ -40,17 +54,33 @@ struct klisp_State {
/* 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;
+ FILE *curr_in;
+ FILE *curr_out;
+ char *filename_in;
+ char *filename_out;
+
+ /* tokenizer */
+ /* WORKAROUND for repl */
+ bool ktok_seen_eof;
+ ksource_info_t ktok_source_info;
+ /* tokenizer buffer */
+ int32_t ktok_buffer_size;
+ int32_t ktok_buffer_idx;
+ char *ktok_buffer;
+
+ /* reader */
+ /* TODO: replace the list with a hashtable */
+ TValue shared_dict;
+
+ /* 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 KS_ITBSIZE (1024)
#define state_size() (sizeof(klisp_State))
/*
@@ -59,22 +89,23 @@ struct klisp_State {
** eliminate it, change it to compiler specific or replace it
** with defines
*/
+
+/*
+** Stack functions
+*/
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_)))
+#define ks_sdpop(st_) (UNUSED(ks_spop(st_)))
inline TValue ks_sget(klisp_State *K);
inline void ks_sclear(klisp_State *K);
+inline bool ks_sisempty(klisp_State *K);
-/*
-** Stack manipulation functions
-*/
-
-/* Aux Stack manipulation macros */
+/* some 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_])
+#define ks_selem(st_, i_) ((ks_sbuf(st_))[i_])
inline void ks_spush(klisp_State *K, TValue obj)
{
@@ -114,4 +145,55 @@ inline void ks_sclear(klisp_State *K)
ks_stop(K) = 0;
}
+inline bool ks_sisempty(klisp_State *K)
+{
+ return ks_stop(K) == 0;
+}
+
+/*
+** Tokenizer char buffer functions
+*/
+
+inline void ks_tbadd(klisp_State *K, char ch);
+inline char *ks_tbget(klisp_State *K);
+inline void ks_tbclear(klisp_State *K);
+inline bool ks_tbisempty(klisp_State *K);
+
+/* some buf manipulation macros */
+#define ks_tbsize(st_) ((st_)->ktok_buffer_size)
+#define ks_tbidx(st_) ((st_)->ktok_buffer_idx)
+#define ks_tbuf(st_) ((st_)->ktok_buffer)
+#define ks_tbelem(st_, i_) ((ks_tbuf(st_))[i_])
+
+inline void ks_tbadd(klisp_State *K, char ch)
+{
+ if (ks_tbidx(K) == ks_tbsize(K)) {
+ /* TODO: try realloc */
+ assert(0);
+ }
+ ks_tbelem(K, ks_tbidx(K)) = ch;
+ ++ks_tbidx(K);
+}
+
+inline char *ks_tbget(klisp_State *K)
+{
+ assert(ks_tbelem(K, ks_tbidx(K) - 1) == '\0');
+ return ks_tbuf(K);
+}
+
+inline void ks_tbclear(klisp_State *K)
+{
+ if (ks_tbsize(K) != KS_ITBSIZE) {
+ /* NOTE: shrink can't fail */
+ /* TODO do realloc */
+ }
+ ks_tbsize(K) = KS_ITBSIZE;
+ ks_tbidx(K) = 0;
+}
+
+inline bool ks_tbisempty(klisp_State *K)
+{
+ return ks_tbidx(K) == 0;
+}
+
#endif
diff --git a/src/kstring.c b/src/kstring.c
@@ -4,29 +4,44 @@
** See Copyright Notice in klisp.h
*/
-/* XXX: for malloc */
-#include <stdlib.h>
-/* TODO: use a generalized alloc function */
-
#include <string.h>
#include "kstring.h"
#include "kobject.h"
+#include "kstate.h"
+#include "kmem.h"
-/* TEMP: for now initialized in ktoken.c */
+/* TEMP: for now initialized in kstate.c */
TValue kempty_string = KINERT_;
-/* TODO: Out of memory errors */
+/* TEMP: this is for initializing the above value, for now, from ktoken.h */
+TValue kstring_new_empty(klisp_State *K)
+{
+ String *new_str;
+
+ new_str = klispM_malloc(K, sizeof(String) + 1);
+
+ new_str->next = NULL;
+ new_str->gct = 0;
+ new_str->tt = K_TSTRING;
+ new_str->mark = KFALSE;
+ new_str->size = 0;
+ new_str->b[0] = '\0';
+
+ return gc2str(new_str);
+}
+
/* TEMP: for now all strings are mutable */
-TValue kstring_new(const char *buf, uint32_t size)
+TValue kstring_new(klisp_State *K, const char *buf, uint32_t size)
{
String *new_str;
- if (size == 0 && ttisstring(kempty_string)) {
+ if (size == 0) {
+ assert(ttisstring(kempty_string));
return kempty_string;
}
- new_str = malloc(sizeof(String) + size + 1);
+ new_str = klispM_malloc(K, sizeof(String) + size + 1);
new_str->next = NULL;
new_str->gct = 0;
diff --git a/src/kstring.h b/src/kstring.h
@@ -8,15 +8,17 @@
#define kstring_h
#include "kobject.h"
+#include "kstate.h"
/* TEMP: for now all strings are mutable */
-TValue kstring_new(const char *, uint32_t);
+TValue kstring_new_empty(klisp_State *K);
+TValue kstring_new(klisp_State *K, const char *buf, uint32_t size);
#define kstring_buf(tv_) (((Symbol *) ((tv_).tv.v.gc))->b)
#define kstring_size(tv_) (((Symbol *) ((tv_).tv.v.gc))->size)
/* The only empty string */
/* TEMP: for now initialized in ktoken.c */
TValue kempty_string;
-#define kstring_is_empty(tv_) (tv_equal(tv_, kempty_string))
+#define kstring_is_empty(tv_) (kstring_size(tv_) == 0)
#endif
diff --git a/src/ksymbol.c b/src/ksymbol.c
@@ -4,25 +4,19 @@
** See Copyright Notice in klisp.h
*/
-/* XXX: for malloc */
-#include <stdlib.h>
-/* TODO: use a generalized alloc function */
-
#include <string.h>
#include "ksymbol.h"
#include "kobject.h"
#include "kpair.h"
+#include "kstate.h"
+#include "kmem.h"
-/* TODO: replace the list with a hashtable */
-/* TODO: move to global state */
-TValue ksymbol_table = KNIL_;
-
-/* TODO: Out of memory errors */
-TValue ksymbol_new(const char *buf)
+TValue ksymbol_new(klisp_State *K, const char *buf)
{
+ /* TODO: replace symbol list with hashtable */
/* First look for it in the symbol table */
- TValue tbl = ksymbol_table;
+ TValue tbl = K->symbol_table;
while (!ttisnil(tbl)) {
TValue first = kcar(tbl);
/* NOTE: there are no embedded '\0's in symbols */
@@ -35,7 +29,7 @@ TValue ksymbol_new(const char *buf)
/* Didn't find it, alloc new and save in symbol table */
/* NOTE: there are no embedded '\0's in symbols */
int32_t size = strlen(buf);
- Symbol *new_sym = malloc(sizeof(Symbol) + size + 1);
+ Symbol *new_sym = klispM_malloc(K, sizeof(Symbol) + size + 1);
new_sym->next = NULL;
new_sym->gct = 0;
@@ -45,7 +39,7 @@ TValue ksymbol_new(const char *buf)
new_sym->b[size] = '\0';
TValue new_symv = gc2sym(new_sym);
- tbl = kcons(new_symv, ksymbol_table);
- ksymbol_table = tbl;
+ /* XXX: new_symv unrooted */
+ K->symbol_table = kcons(K, new_symv, K->symbol_table);
return new_symv;
}
diff --git a/src/ksymbol.h b/src/ksymbol.h
@@ -8,13 +8,11 @@
#define ksymbol_h
#include "kobject.h"
-
-/* TODO: replace the list with a hashtable */
-/* TODO: move to global state */
-TValue ksymbol_table;
+#include "kstate.h"
+#include "kmem.h"
/* TEMP: for now all symbols are interned */
-TValue ksymbol_new(const char *);
+TValue ksymbol_new(klisp_State *K, const char *buf);
#define ksymbol_buf(tv_) (((Symbol *) ((tv_).tv.v.gc))->b)
diff --git a/src/ktoken.c b/src/ktoken.c
@@ -15,7 +15,6 @@
** From the Report:
** - Support other number types besides fixints and exact infinities
** - Support for complete number syntax (exactness, radix, etc)
-** - Error handling
**
** NOT from the Report:
** - Support for unicode (strings, char and symbols).
@@ -26,13 +25,8 @@
**
*/
#include <stdio.h>
-/* XXX for malloc */
#include <stdlib.h>
-/* TODO: use a generalized alloc function */
-
-/* TEMP: for out of mem errors */
#include <assert.h>
-
#include <string.h>
#include <ctype.h>
#include <stdint.h>
@@ -40,9 +34,11 @@
#include "ktoken.h"
#include "kobject.h"
+#include "kstate.h"
#include "kpair.h"
#include "kstring.h"
#include "ksymbol.h"
+#include "kerror.h"
/*
** Char sets for fast ASCII char classification
@@ -129,29 +125,13 @@ kcharset ktok_delimiter, ktok_extended, ktok_subsequent;
*/
TValue ktok_lparen, ktok_rparen, ktok_dot;
-/* TODO: move this to the global state */
-char *ktok_buffer;
-uint32_t ktok_buffer_size;
-#define KTOK_BUFFER_INITIAL_SIZE 1024
-/* WORKAROUND: for stdin line buffering & reading of EOF */
-bool ktok_seen_eof;
-
-void ktok_init()
+void ktok_init(klisp_State *K)
{
- /* TEMP: for now initialize empty string here */
- kempty_string = kstring_new("", 0);
-
- assert(ktok_file != NULL);
- assert(ktok_source_info.filename != NULL);
-
+ assert(K->curr_in != NULL);
+ assert(K->filename_in != NULL);
+
/* WORKAROUND: for stdin line buffering & reading of EOF */
- ktok_seen_eof = false;
- /* string buffer */
- /* TEMP: for now use a fixed size */
- ktok_buffer_size = KTOK_BUFFER_INITIAL_SIZE;
- ktok_buffer = malloc(KTOK_BUFFER_INITIAL_SIZE);
- /* TEMP: while there is no error handling code */
- assert(ktok_buffer != NULL);
+ K->ktok_seen_eof = false;
/* Character sets */
kcharset_fill(ktok_alphabetic, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
@@ -170,36 +150,45 @@ void ktok_init()
kcharset_union(ktok_subsequent, ktok_extended);
/* Special Tokens */
- ktok_lparen = kcons(ch2tv('('), KNIL);
- ktok_rparen = kcons(ch2tv(')'), KNIL);
- ktok_dot = kcons(ch2tv('.'), KNIL);
+ /* TODO: make them uncollectible */
+ if (!ttispair(ktok_lparen)) {
+ ktok_lparen = kcons(K, ch2tv('('), KNIL);
+ ktok_rparen = kcons(K, ch2tv(')'), KNIL);
+ ktok_dot = kcons(K, ch2tv('.'), KNIL);
+ }
+
+ /* Empty string */
+ /* TEMP: for now initialize empty string here */
+ /* TODO: make it uncollectible */
+ if (!ttisstring(kempty_string))
+ kempty_string = kstring_new_empty(K);
}
/*
** Underlying stream interface & source code location tracking
*/
-int ktok_getc() {
+int ktok_getc(klisp_State *K) {
/* WORKAROUND: for stdin line buffering & reading of EOF */
- if (ktok_seen_eof) {
+ if (K->ktok_seen_eof) {
return EOF;
} else {
- int chi = getc(ktok_file);
+ int chi = getc(K->curr_in);
if (chi == EOF) {
/* NOTE: eof doesn't change source code location info */
- ktok_seen_eof = true;
+ K->ktok_seen_eof = true;
return EOF;
}
/* track source code location before returning the char */
if (chi == '\t') {
/* align column to next tab stop */
- ktok_source_info.col =
- (ktok_source_info.col + ktok_source_info.tab_width) -
- (ktok_source_info.col % ktok_source_info.tab_width);
+ K->ktok_source_info.col =
+ (K->ktok_source_info.col + K->ktok_source_info.tab_width) -
+ (K->ktok_source_info.col % K->ktok_source_info.tab_width);
return '\t';
} else if (chi == '\n') {
- ktok_source_info.line++;
- ktok_source_info.col = 0;
+ K->ktok_source_info.line++;
+ K->ktok_source_info.col = 0;
return '\n';
} else {
return chi;
@@ -207,75 +196,77 @@ int ktok_getc() {
}
}
-int ktok_peekc() {
+int ktok_peekc(klisp_State *K) {
/* WORKAROUND: for stdin line buffering & reading of EOF */
- if (ktok_seen_eof) {
+ if (K->ktok_seen_eof) {
return EOF;
} else {
- int chi = getc(ktok_file);
+ int chi = getc(K->curr_in);
if (chi == EOF)
- ktok_seen_eof = true;
+ K->ktok_seen_eof = true;
else
- ungetc(chi, ktok_file);
+ ungetc(chi, K->curr_in);
return chi;
}
}
-void ktok_reset_source_info()
+void ktok_reset_source_info(klisp_State *K)
{
/* line is 1-base and col is 0-based */
- ktok_source_info.line = 1;
- ktok_source_info.col = 0;
+ K->ktok_source_info.line = 1;
+ K->ktok_source_info.col = 0;
}
-void ktok_save_source_info()
+void ktok_save_source_info(klisp_State *K)
{
- ktok_source_info.saved_filename = ktok_source_info.filename;
- ktok_source_info.saved_line = ktok_source_info.line;
- ktok_source_info.saved_col = ktok_source_info.col;
+ K->ktok_source_info.saved_filename = K->ktok_source_info.filename;
+ K->ktok_source_info.saved_line = K->ktok_source_info.line;
+ K->ktok_source_info.saved_col = K->ktok_source_info.col;
}
-TValue ktok_get_source_info()
+TValue ktok_get_source_info(klisp_State *K)
{
/* XXX: what happens on gc? (unrooted objects) */
/* NOTE: the filename doesn't contains embedded '\0's */
- TValue filename_str = kstring_new(ktok_source_info.saved_filename,
- strlen(ktok_source_info.saved_filename));
+ TValue filename_str =
+ kstring_new(K, K->ktok_source_info.saved_filename,
+ strlen(K->ktok_source_info.saved_filename));
/* TEMP: for now, lines and column names are fixints */
- return kcons(filename_str, kcons(i2tv(ktok_source_info.saved_line),
- i2tv(ktok_source_info.saved_col)));
+ return kcons(K, filename_str, kcons(K, i2tv(K->ktok_source_info.saved_line),
+ i2tv(K->ktok_source_info.saved_col)));
}
/*
** Error management
*/
-TValue ktok_error(char *str)
+void ktok_error(klisp_State *K, char *str)
{
- /* TODO: Decide on error handling mechanism for reader (& tokenizer) */
- /* TEMP: Use eof object */
- printf("TOK ERROR: %s\n", str);
- return KEOF;
+ /* clear the buffer before throwing an error */
+ ks_tbclear(K);
+ klispE_throw(K, str, true);
}
/*
** ktok_read_token() helpers
*/
-void ktok_ignore_whitespace_and_comments();
-bool ktok_check_delimiter();
-TValue ktok_read_string();
-TValue ktok_read_special();
-TValue ktok_read_number(bool);
-TValue ktok_read_maybe_signed_numeric();
-TValue ktok_read_identifier();
-int ktok_read_until_delimiter();
+void ktok_ignore_whitespace_and_comments(klisp_State *K);
+bool ktok_check_delimiter(klisp_State *K);
+TValue ktok_read_string(klisp_State *K);
+TValue ktok_read_special(klisp_State *K);
+TValue ktok_read_number(klisp_State *K, bool sign);
+TValue ktok_read_maybe_signed_numeric(klisp_State *K);
+TValue ktok_read_identifier(klisp_State *K);
+int ktok_read_until_delimiter(klisp_State *K);
/*
** Main tokenizer function
*/
-TValue ktok_read_token ()
+TValue ktok_read_token (klisp_State *K)
{
- ktok_ignore_whitespace_and_comments();
+ assert(ks_tbisempty(K));
+
+ ktok_ignore_whitespace_and_comments(K);
/*
** NOTE: We jumped over all whitespace
** so either the next token starts here or eof was reached,
@@ -283,35 +274,38 @@ TValue ktok_read_token ()
*/
/* save the source info of the start of the next token */
- ktok_save_source_info();
+ ktok_save_source_info(K);
- int chi = ktok_peekc();
+ int chi = ktok_peekc(K);
switch(chi) {
case EOF:
- ktok_getc();
+ ktok_getc(K);
return KEOF;
case '(':
- ktok_getc();
+ ktok_getc(K);
return ktok_lparen;
case ')':
- ktok_getc();
+ ktok_getc(K);
return ktok_rparen;
case '.':
- ktok_getc();
- if (ktok_check_delimiter())
+ ktok_getc(K);
+ if (ktok_check_delimiter(K))
return ktok_dot;
- else
- return ktok_error("no delimiter found after dot");
+ else {
+ ktok_error(K, "no delimiter found after dot");
+ /* avoid warning */
+ return KINERT;
+ }
case '"':
- return ktok_read_string();
+ return ktok_read_string(K);
case '#':
- return ktok_read_special();
+ return ktok_read_special(K);
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
- return ktok_read_number(true); /* positive number */
+ return ktok_read_number(K, true); /* positive number */
case '+': case '-':
- return ktok_read_maybe_signed_numeric();
+ return ktok_read_maybe_signed_numeric(K);
case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': case 'G':
case 'H': case 'I': case 'J': case 'K': case 'L': case 'M': case 'N':
case 'O': case 'P': case 'Q': case 'R': case 'S': case 'T': case 'U':
@@ -328,39 +322,41 @@ TValue ktok_read_token ()
** considered so identifier-subsequent is used instead of
** identifier-first-char (in the cases above)
*/
- return ktok_read_identifier();
+ return ktok_read_identifier(K);
default:
- ktok_getc();
- return ktok_error("unrecognized token starting char");
+ ktok_getc(K);
+ ktok_error(K, "unrecognized token starting char");
+ /* avoid warning */
+ return KINERT;
}
}
/*
** Comments and Whitespace
*/
-void ktok_ignore_comment()
+void ktok_ignore_comment(klisp_State *K)
{
int chi;
do {
- chi = ktok_getc();
+ chi = ktok_getc(K);
} while (chi != EOF && chi != '\n');
}
-void ktok_ignore_whitespace_and_comments()
+void ktok_ignore_whitespace_and_comments(klisp_State *K)
{
/* NOTE: if it's not a whitespace or comment do nothing (even on eof) */
bool end = false;
while(!end) {
- int chi = ktok_peekc();
+ int chi = ktok_peekc(K);
if (chi == EOF) {
end = true;
} else {
char ch = (char) chi;
if (ktok_is_whitespace(ch)) {
- ktok_getc();
+ ktok_getc(K);
} else if (ch == ';') {
- ktok_ignore_comment(); /* NOTE: this also reads again the ';' */
+ ktok_ignore_comment(K); /* NOTE: this also reads again the ';' */
} else {
end = true;
}
@@ -371,28 +367,26 @@ void ktok_ignore_whitespace_and_comments()
/*
** Delimiter checking
*/
-bool ktok_check_delimiter()
+bool ktok_check_delimiter(klisp_State *K)
{
- int chi = ktok_peekc();
+ int chi = ktok_peekc(K);
return (ktok_is_delimiter(chi));
}
/*
** Returns the number of bytes read
*/
-int ktok_read_until_delimiter()
+int ktok_read_until_delimiter(klisp_State *K)
{
int i = 0;
- while (!ktok_check_delimiter()) {
- /* TODO: allow buffer to grow */
- assert(i + 1 < ktok_buffer_size);
-
+ while (!ktok_check_delimiter(K)) {
/* NOTE: can't be eof, because eof is a delimiter */
- char ch = (char) ktok_getc();
- ktok_buffer[i++] = ch;
+ char ch = (char) ktok_getc(K);
+ ks_tbadd(K, ch);
+ i++;
}
- ktok_buffer[i] = '\0';
+ ks_tbadd(K, '\0');
return i;
}
@@ -400,15 +394,18 @@ int ktok_read_until_delimiter()
** Numbers
** TEMP: for now, only fixints in base 10
*/
-TValue ktok_read_number(bool is_pos)
+TValue ktok_read_number(klisp_State *K, bool is_pos)
{
int32_t res = 0;
- while(!ktok_check_delimiter()) {
+ while(!ktok_check_delimiter(K)) {
/* NOTE: can't be eof because it's a delimiter */
- char ch = (char) ktok_getc();
- if (!ktok_is_numeric(ch))
- return ktok_error("Not a digit found in number");
+ char ch = (char) ktok_getc(K);
+ if (!ktok_is_numeric(ch)) {
+ ktok_error(K, "Not a digit found in number");
+ /* avoid warning */
+ return KINERT;
+ }
res = res * 10 + ktok_digit_value(ch);
}
@@ -417,109 +414,136 @@ TValue ktok_read_number(bool is_pos)
return i2tv(res);
}
-TValue ktok_read_maybe_signed_numeric()
+TValue ktok_read_maybe_signed_numeric(klisp_State *K)
{
/* NOTE: can't be eof, it's either '+' or '-' */
- char ch = (char) ktok_getc();
- if (ktok_check_delimiter()) {
- ktok_buffer[0] = ch;
- ktok_buffer[1] = '\0';
- return ksymbol_new(ktok_buffer);
+ char ch = (char) ktok_getc(K);
+ if (ktok_check_delimiter(K)) {
+ ks_tbadd(K, ch);
+ ks_tbadd(K, '\0');
+ TValue new_sym = ksymbol_new(K, ks_tbuf(K));
+ ks_tbclear(K);
+ return new_sym;
} else {
- return ktok_read_number(ch == '+');
+ return ktok_read_number(K, ch == '+');
}
}
/*
** Strings
*/
-TValue ktok_read_string()
+TValue ktok_read_string(klisp_State *K)
{
/* discard opening quote */
- ktok_getc();
+ ktok_getc(K);
bool done = false;
int i = 0;
while(!done) {
- int chi = ktok_getc();
+ int chi = ktok_getc(K);
char ch = (char) chi;
- if (chi == EOF)
- return ktok_error("EOF found while reading a string");
+ if (chi == EOF) {
+ ktok_error(K, "EOF found while reading a string");
+ /* avoid warning */
+ return KINERT;
+ }
if (ch == '"') {
- ktok_buffer[i] = '\0';
+ ks_tbadd(K, '\0');
done = true;
} else {
if (ch == '\\') {
- chi = ktok_getc();
+ chi = ktok_getc(K);
- if (chi == EOF)
- return ktok_error("EOF found while reading a string");
+ if (chi == EOF) {
+ ktok_error(K, "EOF found while reading a string");
+ /* avoid warning */
+ return KINERT;
+ }
ch = (char) chi;
if (ch != '\\' && ch != '"') {
- return ktok_error("Invalid char after '\\' "
- "while reading a string");
+ ktok_error(K, "Invalid char after '\\' "
+ "while reading a string");
+ /* avoid warning */
+ return KINERT;
}
}
- /* TODO: allow buffer to grow */
- assert(i+1 < ktok_buffer_size);
-
- ktok_buffer[i++] = ch;
+ ks_tbadd(K, ch);
+ i++;
}
}
- return kstring_new(ktok_buffer, i);
+ TValue new_str = kstring_new(K, ks_tbuf(K), i);
+ ks_tbclear(K);
+ return new_str;
}
/*
** Special constants (starting with "#")
** (Special number syntax, char constants, #ignore, #inert, srfi-38 tokens)
*/
-TValue ktok_read_special()
+TValue ktok_read_special(klisp_State *K)
{
/* discard the '#' */
- ktok_getc();
+ ktok_getc(K);
- int chi = ktok_getc();
+ int chi = ktok_getc(K);
char ch = (char) chi;
- if (chi == EOF)
- return ktok_error("EOF found while reading a '#' constant");
+ if (chi == EOF) {
+ ktok_error(K, "EOF found while reading a '#' constant");
+ /* avoid warning */
+ return KINERT;
+ }
switch(ch) {
- case 'i':
+ case 'i': {
/* ignore or inert */
/* XXX: could also be an inexact number */
- ktok_read_until_delimiter();
+ ktok_read_until_delimiter(K);
/* NOTE: can use strcmp even in the presence of '\0's */
- if (strcmp(ktok_buffer, "gnore") == 0)
- return KIGNORE;
- else if (strcmp(ktok_buffer, "nert") == 0)
+ TValue ret_val;
+ if (strcmp(ks_tbuf(K), "gnore") == 0)
+ ret_val = KIGNORE;
+ else if (strcmp(ks_tbuf(K), "nert") == 0)
+ ret_val = KINERT;
+ else {
+ ktok_error(K, "unexpected char in # constant");
+ /* avoid warning */
return KINERT;
- else
- return ktok_error("unexpected char in # constant");
+ }
+ ks_tbclear(K);
+ return ret_val;
+ }
case 'e':
/* an exact infinity */
/* XXX: could also be an exact number */
- if (ktok_read_until_delimiter()) {
- /* NOTE: can use strcmp even in the presence of '\0's */
- if (strcmp(ktok_buffer, "+infinity") == 0)
- return KEPINF;
- else if (strcmp(ktok_buffer, "-infinity") == 0)
- return KEMINF;
- else
- return ktok_error("unexpected char in # constant");
- } else
- return ktok_error("unexpected error in # constant");
+ ktok_read_until_delimiter(K);
+ TValue ret_val;
+ /* NOTE: can use strcmp even in the presence of '\0's */
+ if (strcmp(ks_tbuf(K), "+infinity") == 0) {
+ ret_val = KEPINF;
+ } else if (strcmp(ks_tbuf(K), "-infinity") == 0) {
+ ret_val = KEMINF;
+ } else {
+ ktok_error(K, "unexpected char in # constant");
+ /* avoid warning */
+ return KINERT;
+ }
+ ks_tbclear(K);
+ return ret_val;
case 't':
case 'f':
/* boolean constant */
- if (ktok_check_delimiter())
+ if (ktok_check_delimiter(K))
return b2tv(ch == 't');
- else
- return ktok_error("unexpected char in # constant");
+ else {
+ ktok_error(K, "unexpected char in # constant");
+ /* avoid warning */
+ return KINERT;
+ }
case '\\':
/* char constant */
/*
@@ -530,75 +554,88 @@ TValue ktok_read_special()
** Kernel report (R-1RK))
** For now we follow the scheme report
*/
- chi = ktok_getc();
+ chi = ktok_getc(K);
ch = (char) chi;
- if (chi == EOF)
- return ktok_error("EOF found while reading a char constant");
+ if (chi == EOF) {
+ ktok_error(K, "EOF found while reading a char constant");
+ /* avoid warning */
+ return KINERT;
+ }
- if (!ktok_is_alphabetic(ch) || ktok_check_delimiter())
+ if (!ktok_is_alphabetic(ch) || ktok_check_delimiter(K))
return ch2tv(ch);
- ktok_read_until_delimiter();
- char *p = ktok_buffer;
+ ktok_read_until_delimiter(K);
+ char *p = ks_tbuf(K);
while (*p) {
*p = tolower(*p);
p++;
}
ch = tolower(ch);
/* NOTE: can use strcmp even in the presence of '\0's */
- if (ch == 's' && strcmp(ktok_buffer, "pace") == 0)
- return ch2tv(' ');
- else if (ch == 'n' && strcmp(ktok_buffer, "ewline") == 0)
- return ch2tv('\n');
- else
- return ktok_error("Unrecognized character name");
+ if (ch == 's' && strcmp(ks_tbuf(K), "pace") == 0)
+ ch = ' ';
+ else if (ch == 'n' && strcmp(ks_tbuf(K), "ewline") == 0)
+ ch = ('\n');
+ else {
+ ktok_error(K, "Unrecognized character name");
+ /* avoid warning */
+ return KINERT;
+ }
+ ks_tbclear(K);
+ return ch2tv(ch);
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9': {
/* srfi-38 type token (can be either a def or ref) */
/* TODO: allow bigints */
int32_t res = 0;
while(ch != '#' && ch != '=') {
- if (!ktok_is_numeric(ch))
- return ktok_error("Invalid char found in srfi-38 token");
+ if (!ktok_is_numeric(ch)) {
+ ktok_error(K, "Invalid char found in srfi-38 token");
+ /* avoid warning */
+ return KINERT;
+ }
res = res * 10 + ktok_digit_value(ch);
- chi = ktok_getc();
+ chi = ktok_getc(K);
ch = (char) chi;
- if (chi == EOF)
- return ktok_error("EOF found while reading a srfi-38 token");
+ if (chi == EOF) {
+ ktok_error(K, "EOF found while reading a srfi-38 token");
+ /* avoid warning */
+ return KINERT;
+ }
}
- return kcons(ch2tv(ch), i2tv(res));
+ return kcons(K, ch2tv(ch), i2tv(res));
}
/* TODO: add real with no primary value and undefined */
default:
- return ktok_error("unexpected char in # constant");
+ ktok_error(K, "unexpected char in # constant");
+ /* avoid warning */
+ return KINERT;
}
}
/*
** Identifiers
*/
-TValue ktok_read_identifier()
+TValue ktok_read_identifier(klisp_State *K)
{
- int i = 0;
-
- while (!ktok_check_delimiter()) {
- /* TODO: allow buffer to grow */
- assert(i+1 < ktok_buffer_size);
-
+ while (!ktok_check_delimiter(K)) {
/* NOTE: can't be eof, because eof is a delimiter */
- char ch = (char) ktok_getc();
+ char ch = (char) ktok_getc(K);
/* NOTE: is_subsequent of '\0' is false, so no embedded '\0' */
if (ktok_is_subsequent(ch))
- ktok_buffer[i++] = ch;
+ ks_tbadd(K, ch);
else
- return ktok_error("Invalid char in identifier");
+ ktok_error(K, "Invalid char in identifier");
}
- ktok_buffer[i] = '\0';
- return ksymbol_new(ktok_buffer);
+ ks_tbadd(K, '\0');
+ TValue new_sym = ksymbol_new(K, ks_tbuf(K));
+ ks_tbclear(K);
+ return new_sym;
}
diff --git a/src/ktoken.h b/src/ktoken.h
@@ -8,32 +8,16 @@
#define ktoken_h
#include "kobject.h"
+#include "kstate.h"
#include <stdio.h>
/*
** Tokenizer interface
*/
-void ktok_init();
-TValue ktok_read_token();
-void ktok_reset_source_info();
-TValue ktok_get_source_info();
-
-/* TODO: move this to the global state */
-FILE *ktok_file;
-
-/* XXX: for now, lines and column names are fixints */
-typedef struct {
- char *filename;
- int32_t tab_width;
- int32_t line;
- int32_t col;
-
- char *saved_filename;
- int32_t saved_line;
- int32_t saved_col;
-} ksource_info_t;
-
-ksource_info_t ktok_source_info;
+void ktok_init(klisp_State *K);
+TValue ktok_read_token(klisp_State *K);
+void ktok_reset_source_info(klisp_State *K);
+TValue ktok_get_source_info(klisp_State *K);
#endif
diff --git a/src/kwrite.c b/src/kwrite.c
@@ -5,10 +5,7 @@
*/
#include <stdio.h>
-/* XXX for malloc */
#include <stdlib.h>
-/* TODO: use a generalized alloc function */
-/* TEMP: for out of mem errors */
#include <assert.h>
#include <inttypes.h>
@@ -17,49 +14,41 @@
#include "kpair.h"
#include "kstring.h"
#include "ksymbol.h"
-
-/* TODO: move to the global state */
-FILE *kwrite_file = NULL;
-/* TEMP: for now use fixints for shared refs */
-int32_t kw_shared_count;
+#include "kstate.h"
+#include "kerror.h"
/*
** Stack for the write FSM
**
*/
-/* TODO: move to the global state */
-TValue *kw_dstack;
-int kw_dstack_size;
-int kw_dstack_i;
-
-/* TEMP: for now stacks are fixed size, use asserts to check */
-#define STACK_INIT_SIZE 1024
-
-#define push_data(data_) ({ assert(kw_dstack_i < kw_dstack_size); \
- kw_dstack[kw_dstack_i++] = data_; })
-#define pop_data() (--kw_dstack_i)
-#define get_data() (kw_dstack[kw_dstack_i-1])
-#define data_is_empty() (kw_dstack_i == 0)
-#define clear_data() (kw_dstack_i = 0)
+#define push_data(ks_, data_) (ks_spush(ks_, data_))
+#define pop_data(ks_) (ks_sdpop(ks_))
+#define get_data(ks_) (ks_sget(ks_))
+#define data_is_empty(ks_) (ks_sisempty(ks_))
/* macro for printing */
-#define kw_printf(...) fprintf(kwrite_file, __VA_ARGS__)
-#define kw_flush() fflush(kwrite_file)
+#define kw_printf(ks_, ...) fprintf((ks_)->curr_out, __VA_ARGS__)
+#define kw_flush(ks_) fflush((ks_)->curr_out)
+
+void kwrite_error(klisp_State *K, char *msg)
+{
+ klispE_throw(K, msg, true);
+}
/*
** Helper for printing strings (correcly escapes backslashes and
** double quotes & prints embedded '\0's). It includes the surrounding
** double quotes.
*/
-void kw_print_string(TValue str)
+void kw_print_string(klisp_State *K, TValue str)
{
int size = kstring_size(str);
char *buf = kstring_buf(str);
char *ptr = buf;
int i = 0;
- kw_printf("\"");
+ kw_printf(K, "\"");
while (i < size) {
/* find the longest printf-able substring to avoid calling printf
@@ -72,58 +61,47 @@ void kw_print_string(TValue str)
first or last time) */
char ch = *ptr;
*ptr = '\0';
- printf("%s", buf);
+ kw_printf(K, "%s", buf);
*ptr = ch;
while(i < size && (*ptr == '\0' || *ptr == '\\' || *ptr == '"')) {
if (*ptr == '\0')
- printf("%c", '\0'); /* this may not show in the terminal */
+ kw_printf(K, "%c", '\0'); /* this may not show in the terminal */
else
- printf("\\%c", *ptr);
+ kw_printf(K, "\\%c", *ptr);
i++;
ptr++;
}
buf = ptr;
}
- kw_printf("\"");
-}
-
-/*
-** Writer initialization
-*/
-void kwrite_init()
-{
- assert(kwrite_file != NULL);
-
- /* XXX: for now use a fixed size for stack */
- kw_dstack_size = STACK_INIT_SIZE;
- clear_data();
- kw_dstack = malloc(STACK_INIT_SIZE*sizeof(TValue));
- assert(kw_dstack != NULL);
+ kw_printf(K, "\"");
}
/*
** Mark initialization and clearing
*/
-void kw_clear_marks(TValue root)
+void kw_clear_marks(klisp_State *K, TValue root)
{
- push_data(root);
+
+ assert(ks_sisempty(K));
+ push_data(K, root);
- while(!data_is_empty()) {
- TValue obj = get_data();
- pop_data();
+ while(!data_is_empty(K)) {
+ TValue obj = get_data(K);
+ pop_data(K);
if (ttispair(obj)) {
if (kis_marked(obj)) {
kunmark(obj);
- push_data(kcdr(obj));
- push_data(kcar(obj));
+ push_data(K, kcdr(obj));
+ push_data(K, kcar(obj));
}
} else if (ttisstring(obj) && (kis_marked(obj))) {
kunmark(obj);
}
}
+ assert(ks_sisempty(K));
}
/*
@@ -137,19 +115,20 @@ void kw_clear_marks(TValue root)
** find repetitions and to allow unmarking after write
*/
-void kw_set_initial_marks(TValue root)
+void kw_set_initial_marks(klisp_State *K, TValue root)
{
- push_data(root);
+ assert(ks_sisempty(K));
+ push_data(K, root);
- while(!data_is_empty()) {
- TValue obj = get_data();
- pop_data();
+ while(!data_is_empty(K)) {
+ TValue obj = get_data(K);
+ pop_data(K);
if (ttispair(obj)) {
if (kis_unmarked(obj)) {
kmark(obj); /* this mark just means visited */
- push_data(kcdr(obj));
- push_data(kcar(obj));
+ push_data(K, kcdr(obj));
+ push_data(K, kcar(obj));
} else {
/* this mark means it will need a ref number */
kset_mark(obj, i2tv(-1));
@@ -164,25 +143,28 @@ void kw_set_initial_marks(TValue root)
}
/* all other types of object don't matter */
}
+ assert(ks_sisempty(K));
}
/*
** Writes all values except strings and pairs
*/
-void kwrite_simple(TValue obj)
+void kwrite_simple(klisp_State *K, TValue obj)
{
switch(ttype(obj)) {
case K_TSTRING:
- /* this shouldn't happen */
- assert(0);
+ /* shouldn't happen */
+ kwrite_error(K, "string type found in kwrite-simple");
+ /* avoid warning */
+ return;
case K_TEINF:
- kw_printf("#e%cinfinity", tv_equal(obj, KEPINF)? '+' : '-');
+ kw_printf(K, "#e%cinfinity", tv_equal(obj, KEPINF)? '+' : '-');
break;
case K_TFIXINT:
- kw_printf("%" PRId32, ivalue(obj));
+ kw_printf(K, "%" PRId32, ivalue(obj));
break;
case K_TNIL:
- kw_printf("()");
+ kw_printf(K, "()");
break;
case K_TCHAR: {
char ch_buf[4];
@@ -198,53 +180,61 @@ void kwrite_simple(TValue obj)
ch_buf[1] = '\0';
ch_ptr = ch_buf;
}
- kw_printf("#\\%s", ch_ptr);
+ kw_printf(K, "#\\%s", ch_ptr);
break;
}
case K_TBOOLEAN:
- kw_printf("#%c", bvalue(obj)? 't' : 'f');
+ kw_printf(K, "#%c", bvalue(obj)? 't' : 'f');
break;
case K_TSYMBOL:
/* TEMP: access symbol structure directly */
/* TEMP: for now assume all symbols have external representations */
- kw_printf("%s", ksymbol_buf(obj));
+ kw_printf(K, "%s", ksymbol_buf(obj));
break;
case K_TINERT:
- kw_printf("#inert");
+ kw_printf(K, "#inert");
break;
case K_TIGNORE:
- kw_printf("#ignore");
+ kw_printf(K, "#ignore");
break;
case K_TEOF:
- kw_printf("[eof]");
+ kw_printf(K, "[eof]");
break;
default:
/* shouldn't happen */
- assert(0);
+ kwrite_error(K, "unknown object type");
+ /* avoid warning */
+ return;
}
}
-void kwrite_fsm()
+void kwrite_fsm(klisp_State *K, TValue obj)
{
+ /* NOTE: a fixint is more than enough for output */
+ int32_t kw_shared_count = 0;
+
+ assert(ks_sisempty(K));
+ push_data(K, obj);
+
bool middle_list = false;
- while (!data_is_empty()) {
- TValue obj = get_data();
- pop_data();
+ while (!data_is_empty(K)) {
+ TValue obj = get_data(K);
+ pop_data(K);
if (middle_list) {
if (ttisnil(obj)) { /* end of list */
- kw_printf(")");
+ kw_printf(K, ")");
/* middle_list = true; */
} else if (ttispair(obj) && ttisboolean(kget_mark(obj))) {
- push_data(kcdr(obj));
- push_data(kcar(obj));
- kw_printf(" ");
+ push_data(K, kcdr(obj));
+ push_data(K, kcar(obj));
+ kw_printf(K, " ");
middle_list = false;
} else { /* improper list is the same as shared ref */
- kw_printf(" . ");
- push_data(KNIL);
- push_data(obj);
+ kw_printf(K, " . ");
+ push_data(K, KNIL);
+ push_data(K, obj);
middle_list = false;
}
} else { /* if (middle_list) */
@@ -252,78 +242,70 @@ void kwrite_fsm()
case K_TPAIR: {
TValue mark = kget_mark(obj);
if (ttisboolean(mark)) { /* simple pair (only once) */
- kw_printf("(");
- push_data(kcdr(obj));
- push_data(kcar(obj));
+ kw_printf(K, "(");
+ push_data(K, kcdr(obj));
+ push_data(K, kcar(obj));
middle_list = false;
} else if (ivalue(mark) < 0) { /* pair with no assigned # */
/* TEMP: for now only fixints in shared refs */
assert(kw_shared_count >= 0);
+
kset_mark(obj, i2tv(kw_shared_count));
- kw_printf("#%" PRId32 "=(", kw_shared_count);
+ kw_printf(K, "#%" PRId32 "=(", kw_shared_count);
kw_shared_count++;
- push_data(kcdr(obj));
- push_data(kcar(obj));
+ push_data(K, kcdr(obj));
+ push_data(K, kcar(obj));
middle_list = false;
} else { /* string with an assigned number */
- kw_printf("#%" PRId32 "#", ivalue(mark));
+ kw_printf(K, "#%" PRId32 "#", ivalue(mark));
middle_list = true;
}
break;
}
case K_TSTRING: {
if (kstring_is_empty(obj)) {
- kw_printf("\"\"");
+ kw_printf(K, "\"\"");
} else {
TValue mark = kget_mark(obj);
if (ttisboolean(mark)) { /* simple string (only once) */
- kw_print_string(obj);
+ kw_print_string(K, obj);
} else if (ivalue(mark) < 0) { /* string with no assigned # */
/* TEMP: for now only fixints in shared refs */
assert(kw_shared_count >= 0);
kset_mark(obj, i2tv(kw_shared_count));
- kw_printf("#%" PRId32 "=", kw_shared_count);
+ kw_printf(K, "#%" PRId32 "=", kw_shared_count);
kw_shared_count++;
- kw_print_string(obj);
+ kw_print_string(K, obj);
} else { /* string with an assigned number */
- kw_printf("#%" PRId32 "#", ivalue(mark));
+ kw_printf(K, "#%" PRId32 "#", ivalue(mark));
}
}
middle_list = true;
break;
}
default:
- kwrite_simple(obj);
+ kwrite_simple(K, obj);
middle_list = true;
}
}
}
- return;
+
+ assert(ks_sisempty(K));
}
/*
** Writer Main function
*/
-void kwrite(TValue obj)
+void kwrite(klisp_State *K, TValue obj)
{
- assert(data_is_empty());
-
- kw_shared_count = 0;
- kw_set_initial_marks(obj);
-
- push_data(obj);
- kwrite_fsm();
- kw_flush();
-
- kw_clear_marks(obj);
-
- assert(data_is_empty());
- return;
+ kw_set_initial_marks(K, obj);
+ kwrite_fsm(K, obj);
+ kw_flush(K);
+ kw_clear_marks(K, obj);
}
-void knewline()
+void knewline(klisp_State *K)
{
- kw_printf("\n");
- kw_flush();
- return;
+ kw_printf(K, "\n");
+ kw_flush(K);
}
diff --git a/src/kwrite.h b/src/kwrite.h
@@ -7,19 +7,14 @@
#ifndef kwrite_h
#define kwrite_h
-#include <stdio.h>
-
#include "kobject.h"
+#include "kstate.h"
/*
** Writer interface
*/
-void kwrite_init();
-void kwrite(TValue);
-void knewline();
-
-/* TODO: move this to the global state */
-FILE *kwrite_file;
+void kwrite(klisp_State *K, TValue obj);
+void knewline(klisp_State *K);
#endif
