commit d12b123da3e711359c477c556432228df0842053
parent 43c7bd97d2668ab7bbabf4ffdc89b9bf1bb1ee29
Author: Andres Navarro <canavarro82@gmail.com>
Date: Thu, 17 Mar 2011 15:18:35 -0300
Added support for creating(opening) and closing ports.
Diffstat:
6 files changed, 159 insertions(+), 5 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -10,7 +10,7 @@ MYLIBS=
CORE_O= kobject.o ktoken.o kpair.o kstring.o ksymbol.o kread.o \
kwrite.o kstate.o kmem.o kerror.o kauxlib.o kenvironment.o \
kcontinuation.o koperative.o kapplicative.o keval.o krepl.o \
- kencapsulation.o kpromise.o \
+ kencapsulation.o kpromise.o kport.o \
kground.o kghelpers.o kgbooleans.o kgeqp.o kgequalp.o \
kgsymbols.o kgcontrol.o kgpairs_lists.o kgpair_mut.o kgenvironments.o \
kgenv_mut.o kgcombiners.o kgcontinuations.o kgencapsulations.o \
@@ -48,12 +48,13 @@ kpair.o: kpair.c kpair.h kobject.h kstate.h kmem.h klisp.h
kstring.o: kstring.c kstring.h kobject.h kstate.h kmem.h klisp.h
# XXX: kpair.h because of use of list as symbol table
ksymbol.o: ksymbol.c ksymbol.h kobject.h kpair.h kstate.h kmem.h klisp.h
-kread.o: kread.c kread.h kobject.h ktoken.h kpair.h kstate.h kerror.h klisp.h
+kread.o: kread.c kread.h kobject.h ktoken.h kpair.h kstate.h kerror.h klisp.h \
+ kport.h
kwrite.o: kwrite.c kwrite.h kobject.h kpair.h kstring.h kstate.h kerror.h \
- klisp.h
+ klisp.h kport.h
kstate.o: kstate.c kstate.h klisp.h kobject.h kmem.h kstring.h klisp.h \
kground.h kenvironment.h kpair.h keval.h koperative.h kground.h \
- krepl.h kcontinuation.h kapplicative.h
+ krepl.h kcontinuation.h kapplicative.h kport.h
kmem.o: kmem.c kmem.h klisp.h kerror.h klisp.h
kerror.o: kerror.c kerror.h klisp.h kstate.h klisp.h kmem.h kstring.h
kauxlib.o: kauxlib.c kauxlib.h klisp.h kstate.h klisp.h
@@ -69,6 +70,7 @@ kencapsulation.o: kencapsulation.c kencapsulation.h kmem.h kstate.h kobject.h \
klisp.h kpair.h
kpromise.o: kpromise.c kpromise.h kmem.h kstate.h kobject.h \
klisp.h kpair.h
+kport.o: kport.c kport.h kmem.h kstate.h kobject.h klisp.h kerror.h kstring.h
keval.o: keval.c keval.h kcontinuation.h kenvironment.h kstate.h kobject.h \
kpair.h kerror.h klisp.h
krepl.o: krepl.c krepl.h kcontinuation.h kstate.h kobject.h keval.h klisp.h \
diff --git a/src/kghelpers.c b/src/kghelpers.c
@@ -47,3 +47,34 @@ void typep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
return;
}
}
+
+void ftypep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+ (void) denv;
+ /*
+ ** xparams[0]: name symbol
+ ** xparams[1]: fn pointer (as a void * in a user TValue)
+ */
+ bool (*fn)(TValue obj) = pvalue(xparams[1]);
+
+ /* check the ptree is a list while checking the predicate.
+ Keep going even if the result is false to catch errors in
+ ptree structure */
+ bool res = true;
+
+ TValue tail = ptree;
+ while(ttispair(tail) && kis_unmarked(tail)) {
+ kmark(tail);
+ res &= (*fn)(kcar(tail));
+ tail = kcdr(tail);
+ }
+ unmark_list(K, ptree);
+
+ if (ttispair(tail) || ttisnil(tail)) {
+ kapply_cc(K, b2tv(res));
+ } else {
+ char *name = ksymbol_buf(xparams[0]);
+ klispE_throw_extra(K, name, ": expected list");
+ return;
+ }
+}
diff --git a/src/kghelpers.h b/src/kghelpers.h
@@ -323,9 +323,15 @@ inline TValue check_copy_env_list(klisp_State *K, char *name, TValue obj)
}
/*
-** This is a generic function for type predicates
+** Generic function for type predicates
** It can only be used by types that have a unique tag
*/
void typep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+/*
+** Generic function for type predicates
+** It takes an arbitrary function pointer of type bool (*fn)(TValue o)
+*/
+void ftypep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+
#endif
diff --git a/src/kobject.h b/src/kobject.h
@@ -476,6 +476,7 @@ extern char *ktv_names[];
#define K_FLAG_INNER 0x02
#define K_FLAG_DYNAMIC 0x04
+/* evaluates c_ more than once */
#define kset_inner_cont(c_) (tv_get_flags(c_) |= K_FLAG_INNER)
#define kset_outer_cont(c_) (tv_get_flags(c_) |= K_FLAG_OUTER)
#define kset_dyn_cont(c_) (tv_get_flags(c_) |= K_FLAG_DYNAMIC)
@@ -488,6 +489,28 @@ extern char *ktv_names[];
#define kis_mutable(o_) ((tv_get_flags(o_) & K_FLAG_IMMUTABLE) == 0)
#define kis_immutable(o_) (!kis_mutable(o_))
+#define K_FLAG_OUTPUT_PORT 0x01
+#define K_FLAG_INPUT_PORT 0x02
+#define K_FLAG_CLOSED_PORT 0x04
+
+#define kport_set_input(o_) (tv_get_flags(o_) |= K_FLAG_INPUT_PORT)
+#define kport_set_output(o_) (tv_get_flags(o_) |= K_FLAG_INPUT_PORT)
+#define kport_set_closed(o_) (tv_get_flags(o_) |= K_FLAG_CLOSED_PORT)
+
+#define kport_is_input(o_) ((tv_get_flags(o_) & K_FLAG_INPUT_PORT) != 0)
+#define kport_is_output(o_) ((tv_get_flags(o_) & K_FLAG_OUTPUT_PORT) != 0)
+#define kport_is_closed(o_) ((tv_get_flags(o_) & K_FLAG_CLOSED_PORT) != 0)
+
+inline bool kis_input_port(TValue o)
+{
+ return ttisport(o) && kport_is_input(o);
+}
+
+inline bool kis_ouput_port(TValue o)
+{
+ return ttisport(o) && kport_is_output(o);
+}
+
/* Macro to test the most basic equality on TValues */
#define tv_equal(tv1_, tv2_) ((tv1_).raw == (tv2_).raw)
diff --git a/src/kport.c b/src/kport.c
@@ -0,0 +1,66 @@
+/*
+** kport.h
+** Kernel Ports
+** See Copyright Notice in klisp.h
+*/
+
+#include <stdio.h>
+#include <assert.h>
+
+#include "kport.h"
+#include "kobject.h"
+#include "kstate.h"
+#include "kmem.h"
+#include "kerror.h"
+#include "kstring.h"
+
+TValue kmake_port(klisp_State *K, TValue filename, bool writep, TValue name,
+ TValue si)
+{
+ FILE *f = fopen(kstring_buf(filename), writep? "w": "r");
+ if (f == NULL) {
+ klispE_throw(K, "Create port: could't open file");
+ return KINERT;
+ } else {
+ return kmake_std_port(K, filename, writep, name, si, f);
+ }
+}
+
+/* this is for creating ports for stdin/stdout/stderr &
+ also a helper for the above */
+TValue kmake_std_port(klisp_State *K, TValue filename, bool writep,
+ TValue name, TValue si, FILE *file)
+{
+ Port *new_port = klispM_new(K, Port);
+
+ /* header + gc_fields */
+ new_port->next = K->root_gc;
+ K->root_gc = (GCObject *)new_port;
+ new_port->gct = 0;
+ new_port->tt = K_TPORT;
+ new_port->flags = writep? K_FLAG_OUTPUT_PORT : K_FLAG_INPUT_PORT;
+
+ /* portinuation specific fields */
+ new_port->name = name;
+ new_port->si = si;
+ new_port->filename = filename;
+ new_port->file = file;
+
+ return gc2port(new_port);
+}
+
+/* if the port is already closed do nothing */
+void kclose_port(klisp_State *K, TValue port)
+{
+ assert(ttisport(port));
+
+ if (!kport_is_closed(port)) {
+ FILE *f = tv2port(port)->file;
+ if (f != stdin && f != stderr && f != stdout)
+ fclose(f); /* it isn't necessary to check the close ret val */
+
+ kport_set_closed(port);
+ }
+
+ return;
+}
diff --git a/src/kport.h b/src/kport.h
@@ -0,0 +1,26 @@
+/*
+** kport.h
+** Kernel Ports
+** See Copyright Notice in klisp.h
+*/
+
+#ifndef kport_h
+#define kport_h
+
+#include <stdio.h>
+
+#include "kobject.h"
+#include "kstate.h"
+
+TValue kmake_port(klisp_State *K, TValue filename, bool writep, TValue name,
+ TValue si);
+
+/* this is for creating ports for stdin/stdout/stderr */
+TValue kmake_std_port(klisp_State *K, TValue filename, bool writep,
+ TValue name, TValue si, FILE *file);
+
+/* This closes the underlying FILE * (unless it is a std port) and also
+ set the closed flag to true */
+void kclose_port(klisp_State *K, TValue port);
+
+#endif
