klisp

commit 046abd03047ddd31203727bd71244770f0928f49
parent d52c9b26037f44d57d15725f8c79a1f8a837648e
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Thu,  3 Mar 2011 19:04:20 -0300

Added operative constructor.

Diffstat:
M
src/Makefile
 | 
6
+++---
M
src/kcontinuation.c
 | 
4
++--
M
src/kobject.h
 | 
2
++
A
src/koperative.c
 | 
34
++++++++++++++++++++++++++++++++++
A
src/koperative.h
 | 
17
+++++++++++++++++

5 files changed, 58 insertions(+), 5 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -9,7 +9,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
+	kcontinuation.o koperative.o
 
 KRN_T=	klisp
 KRN_O=	klisp.o
@@ -50,4 +50,5 @@ kerror.o: kerror.c kerror.h klisp.h kstate.h
 kauxlib.o: kauxlib.c kauxlib.h klisp.h kstate.h
 kenvironment.o: kenvironment.c kenvironment.h kpair.h kobject.h kerror.h \
 	kmem.h kstate.h
-kcontinuation.o: kcontinuation.c kcontinuation.h kmem.h kstate.h kobject.h
-\ No newline at end of file
+kcontinuation.o: kcontinuation.c kcontinuation.h kmem.h kstate.h kobject.h
+koperative.o: koperative.c koperative.h kmem.h kstate.h kobject.h
diff --git a/src/kcontinuation.c b/src/kcontinuation.c
@@ -15,8 +15,8 @@ TValue kmake_continuation(klisp_State *K, TValue parent, TValue name,
 			  TValue si, klisp_Ifunc fn, int32_t xcount, ...)
 {
     va_list argp;
-    Continuation *new_cont = klispM_malloc(K, sizeof(Continuation) + 
-					   sizeof(TValue) * xcount);
+    Continuation *new_cont = (Continuation *)
+	klispM_malloc(K, sizeof(Continuation) + sizeof(TValue) * xcount);
     new_cont->next = NULL;
     new_cont->gct = 0;
     new_cont->tt = K_TCONTINUATION;
diff --git a/src/kobject.h b/src/kobject.h
@@ -364,6 +364,7 @@ const TValue keminf;
 #define gc2sym(o_) (gc2tv(K_TAG_SYMBOL, o_))
 #define gc2env(o_) (gc2tv(K_TAG_ENVIRONMENT, o_))
 #define gc2cont(o_) (gc2tv(K_TAG_CONTINUATION, o_))
+#define gc2op(o_) (gc2tv(K_TAG_OPERATIVE, o_))
 
 /* Macro to convert a TValue into a specific heap allocated object */
 #define tv2pair(v_) ((Pair *) gcvalue(v_))
@@ -371,6 +372,7 @@ const TValue keminf;
 #define tv2sym(v_) ((Symbol *) gcvalue(v_))
 #define tv2env(v_) ((Environment *) gcvalue(v_))
 #define tv2cont(v_) ((Continuation *) gcvalue(v_))
+#define tv2op(v_) ((Operative *) gcvalue(v_))
 
 #define tv2mgch(v_) ((MGCheader *) gcvalue(v_))
 
diff --git a/src/koperative.c b/src/koperative.c
@@ -0,0 +1,34 @@
+/*
+** koperative.c
+** Kernel Operatives
+** See Copyright Notice in klisp.h
+*/
+
+#include <stdarg.h>
+
+#include "koperative.h"
+#include "kobject.h"
+#include "kstate.h"
+#include "kmem.h"
+
+TValue kmake_operative(klisp_State *K, TValue name, TValue si, 
+		       klisp_Ifunc fn, int32_t xcount, ...)
+{
+    va_list argp;
+    Operative *new_op = (Operative *) 
+	klispM_malloc(K, sizeof(Operative) + sizeof(TValue) * xcount);
+    new_op->next = NULL;
+    new_op->gct = 0;
+    new_op->tt = K_TOPERATIVE;
+    new_op->name = name;
+    new_op->si = si;
+    new_op->fn = fn;
+    new_op->extra_size = xcount;
+
+    va_start(argp, xcount);
+    for (int i = 0; i < xcount; i++) {
+	new_op->extra[i] = va_arg(argp, TValue);
+    }
+    va_end(argp);
+    return gc2op(new_op);
+}
diff --git a/src/koperative.h b/src/koperative.h
@@ -0,0 +1,17 @@
+/*
+** koperative.h
+** Kernel Operatives
+** See Copyright Notice in klisp.h
+*/
+
+#ifndef koperative_h
+#define koperative_h
+
+#include "kobject.h"
+#include "kstate.h"
+
+/* TODO: make some specialized constructors for 0, 1 and 2 parameters */
+TValue kmake_operative(klisp_State *K, TValue name, TValue si, 
+		       klisp_Ifunc fn, int xcount, ...);
+
+#endif