commit 44ee75643ede8c2cc39b70bc2cf7e03254bb0e11
parent 1cbb0fee5daf4ca4375a0427376dbce9f186464d
Author: Andres Navarro <canavarro82@gmail.com>
Date: Wed, 29 Aug 2012 16:45:15 -0300
Added Mutex Objects (still no applicatives for lock/unlock thou)
Diffstat:
7 files changed, 134 insertions(+), 4 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -56,7 +56,7 @@ CORE_O= kobject.o ktoken.o kpair.o kstring.o ksymbol.o kread.o \
kgenvironments.o kgenv_mut.o kgcombiners.o kgcontinuations.o \
kgencapsulations.o kgpromises.o kgkd_vars.o kgks_vars.o kgports.o \
kgchars.o kgnumbers.o kgstrings.o kgbytevectors.o kgvectors.o \
- kgtables.o kgsystem.o kgerrors.o kgkeywords.o kgthreads.o \
+ kgtables.o kgsystem.o kgerrors.o kgkeywords.o kgthreads.o kmutex.o \
$(if $(USE_LIBFFI),kgffi.o)
# TEMP: in klisp there is no distinction between core & lib
@@ -171,7 +171,7 @@ kgbytevectors.o: kgbytevectors.c kstate.h klimits.h klisp.h kobject.h \
kenvironment.h ksymbol.h kstring.h ktable.h kgbytevectors.h
kgc.o: kgc.c kgc.h kobject.h klimits.h klisp.h klispconf.h kstate.h \
ktoken.h kmem.h kport.h imath.h imrat.h ktable.h kstring.h kbytevector.h \
- kvector.h kerror.h kpair.h
+ kvector.h kerror.h kpair.h kmutex.h
kgchars.o: kgchars.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kapplicative.h koperative.h kcontinuation.h kerror.h \
kpair.h kgc.h kchar.h kghelpers.h kvector.h kenvironment.h ksymbol.h \
@@ -284,7 +284,7 @@ kgtables.o: kgtables.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
kpair.h kgc.h kghelpers.h kvector.h kenvironment.h ksymbol.h kstring.h \
ktable.h kgtables.h
kgthreads.o: kgthreads.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
- ktoken.h kmem.h kghelpers.h kerror.h kpair.h kgc.h kvector.h \
+ ktoken.h kmem.h kmutex.h kghelpers.h kerror.h kpair.h kgc.h kvector.h \
kapplicative.h koperative.h kcontinuation.h kenvironment.h ksymbol.h \
kstring.h ktable.h
kgvectors.o: kgvectors.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
@@ -303,6 +303,8 @@ klisp.o: klisp.c klimits.h klisp.h kstate.h kobject.h klispconf.h \
kerror.h kpair.h kgc.h krepl.h ksystem.h kghelpers.h kvector.h ktable.h
kmem.o: kmem.c klisp.h kstate.h klimits.h kobject.h klispconf.h ktoken.h \
kmem.h kerror.h kpair.h kgc.h
+kmutex.o: kmutex.c kobject.h klimits.h klisp.h klispconf.h kstate.h \
+ ktoken.h kmem.h kmutex.h kgc.h kerror.h kpair.h
kobject.o: kobject.c kobject.h klimits.h klisp.h klispconf.h
koperative.o: koperative.c koperative.h kobject.h klimits.h klisp.h \
klispconf.h kstate.h ktoken.h kmem.h kgc.h
diff --git a/src/kgc.c b/src/kgc.c
@@ -27,6 +27,7 @@
#include "kstring.h"
#include "kbytevector.h"
#include "kvector.h"
+#include "kmutex.h"
#include "kerror.h"
#define GCSTEPSIZE 1024u
@@ -121,6 +122,7 @@ static void reallymarkobject (global_State *g, GCObject *o)
case K_TMPORT:
case K_TLIBRARY:
case K_TTHREAD:
+ case K_TMUTEX:
o->gch.gclist = g->gray;
g->gray = o;
break;
@@ -385,6 +387,12 @@ static int32_t propagatemark (global_State *g) {
}
return sizeof(klisp_State) + (sizeof(TValue) * K->stop);
}
+ case K_TMUTEX: {
+ Mutex *m = cast(Mutex *, o);
+
+ markvalue(g, m->owner);
+ return sizeof(Mutex);
+ }
default:
fprintf(stderr, "Unknown GCObject type (in GC propagate): %d\n",
type);
@@ -550,6 +558,9 @@ static void freeobj (klisp_State *K, GCObject *o) {
klispT_freethread(K, K2);
break;
}
+ case K_TMUTEX:
+ klispX_free(K, (Mutex *)o);
+ break;
default:
/* shouldn't happen */
fprintf(stderr, "Unknown GCObject type (in GC free): %d\n",
diff --git a/src/kgthreads.c b/src/kgthreads.c
@@ -11,7 +11,7 @@
#include "kstate.h"
#include "kobject.h"
-
+#include "kmutex.h"
#include "kghelpers.h"
/* ?.1? thread? */
@@ -148,6 +148,23 @@ static void make_thread(klisp_State *K)
kapply_cc(K, new_th);
}
+
+/* make-mutex */
+static void make_mutex(klisp_State *K)
+{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+ UNUSED(xparams);
+ UNUSED(denv);
+
+ check_0p(K, ptree);
+
+ TValue new_mutex = kmake_mutex(K);
+ kapply_cc(K, new_mutex);
+}
+
/* init ground */
void kinit_threads_ground_env(klisp_State *K)
{
@@ -168,4 +185,12 @@ void kinit_threads_ground_env(klisp_State *K)
/* ?.3? make-thread */
add_applicative(K, ground_env, "make-thread", make_thread, 0);
+
+ /* Mutexes */
+ /* mutex? */
+ add_applicative(K, ground_env, "mutex?", typep, 2, symbol,
+ i2tv(K_TMUTEX));
+
+ /* make-mutex */
+ add_applicative(K, ground_env, "make-mutex", make_mutex, 0);
}
diff --git a/src/kmutex.c b/src/kmutex.c
@@ -0,0 +1,44 @@
+/*
+** kmutex.c
+** Kernel Libraries
+** See Copyright Notice in klisp.h
+*/
+
+#include "kobject.h"
+#include "kstate.h"
+#include "kmutex.h"
+#include "kmem.h"
+#include "kgc.h"
+#include "kerror.h"
+
+/* GC: Assumes env & ext_list are roooted */
+/* ext_list should be immutable (and it may be empty) */
+TValue kmake_mutex(klisp_State *K)
+{
+ Mutex *new_mutex = klispM_new(K, Mutex);
+
+ /* header + gc_fields */
+ klispC_link(K, (GCObject *) new_mutex, K_TMUTEX, 0);
+
+ /* mutex specific fields */
+ new_mutex->count = 0;
+ new_mutex->owner = KMUTEX_NO_OWNER; /* no owner */
+
+ /* XXX no attrs for now */
+ int32_t res = pthread_mutex_init(&new_mutex->mutex, NULL);
+
+ if (res != 0) {
+ klispE_throw_simple_with_irritants(K, "Can't create mutex", 1,
+ i2tv(res));
+ return KNIL;
+ }
+ return gc2mutex(new_mutex);
+}
+
+void klispX_free(klisp_State *K, Mutex *m)
+{
+/* XXX/??? Is it okay if the mutex wasn't correctly created?,
+ i.e. the contructor throwed an error*/
+ UNUSED(pthread_mutex_destroy(&m->mutex));
+ klispM_free(K, m);
+}
diff --git a/src/kmutex.h b/src/kmutex.h
@@ -0,0 +1,24 @@
+/*
+** kmutex.h
+** Kernel Libraries
+** See Copyright Notice in klisp.h
+*/
+
+#ifndef kmutex_h
+#define kmutex_h
+
+#include "kobject.h"
+#include "kstate.h"
+
+TValue kmake_mutex(klisp_State *K);
+void klispX_free(klisp_State *K, Mutex *mutex);
+
+/* XXX The functions for locking and unlocking are in kgthreads, for now,
+ mainly because they use locking... */
+
+#define kmutex_is_owned(m_) (ttisthread(tv2mutex(p_)->owner))
+#define kmutex_get_owner(m_) (tv2mutex(p_)->owner)
+#define kmutex_get_mutex(m_) (tv2mutex(p_)->mutex)
+#define kmutex_get_count(m_) (tv2mutex(p_)->count)
+
+#endif
diff --git a/src/kobject.h b/src/kobject.h
@@ -32,6 +32,7 @@
#include <stdint.h>
#include <stdio.h>
#include <math.h>
+#include <pthread.h>
#include "klimits.h"
#include "klispconf.h"
@@ -172,6 +173,7 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define K_TKEYWORD 45
#define K_TLIBRARY 46
#define K_TTHREAD 47
+#define K_TMUTEX 48
/* for tables */
#define K_TDEADKEY 60
@@ -230,6 +232,7 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define K_TAG_KEYWORD K_MAKE_VTAG(K_TKEYWORD)
#define K_TAG_LIBRARY K_MAKE_VTAG(K_TLIBRARY)
#define K_TAG_THREAD K_MAKE_VTAG(K_TTHREAD)
+#define K_TAG_MUTEX K_MAKE_VTAG(K_TMUTEX)
/*
** Macros to test types
@@ -333,6 +336,7 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define ttiskeyword(o) (tbasetype_(o) == K_TAG_KEYWORD)
#define ttislibrary(o) (tbasetype_(o) == K_TAG_LIBRARY)
#define ttisthread(o) (tbasetype_(o) == K_TAG_THREAD)
+#define ttismutex(o) (tbasetype_(o) == K_TAG_MUTEX)
/* macros to easily check boolean values */
#define kis_true(o_) (tv_equal((o_), KTRUE))
@@ -564,6 +568,15 @@ typedef struct __attribute__ ((__packed__)) {
TValue exp_list; /* this is an immutable list of symbols */
} Library;
+#define KMUTEX_NO_OWNER (KINERT)
+
+typedef struct __attribute__ ((__packed__)) {
+ CommonHeader; /* symbols are marked via their strings */
+ TValue owner; /* KINERT/thread currently holding this mutex */
+ pthread_mutex_t mutex;
+ uint32_t count; /* count for recursive mutex */
+} Mutex;
+
/*
** `module' operation for hashing (size is always a power of 2)
*/
@@ -718,6 +731,7 @@ const TValue kfree;
#define gc2keyw(o_) (gc2tv(K_TAG_KEYWORD, o_))
#define gc2lib(o_) (gc2tv(K_TAG_LIBRARY, o_))
#define gc2th(o_) (gc2tv(K_TAG_THREAD, o_))
+#define gc2mutex(o_) (gc2tv(K_TAG_MUTEX, o_))
#define gc2deadkey(o_) (gc2tv(K_TAG_DEADKEY, o_))
/* Macro to convert a TValue into a specific heap allocated object */
@@ -742,6 +756,7 @@ const TValue kfree;
#define tv2keyw(v_) ((Keyword *) gcvalue(v_))
#define tv2lib(v_) ((Library *) gcvalue(v_))
#define tv2th(v_) ((klisp_State *) gcvalue(v_))
+#define tv2mutex(v_) ((Mutex *) gcvalue(v_))
#define tv2gch(v_) ((GCheader *) gcvalue(v_))
#define tv2mgch(v_) ((MGCheader *) gcvalue(v_))
diff --git a/src/kwrite.c b/src/kwrite.c
@@ -734,6 +734,15 @@ void kwrite_scalar(klisp_State *K, TValue obj)
#endif
kw_printf(K, "]");
break;
+ case K_TMUTEX:
+ kw_printf(K, "#[mutex");
+#if KTRACK_NAMES
+ if (khas_name(obj)) {
+ kw_print_name(K, obj);
+ }
+#endif
+ kw_printf(K, "]");
+ break;
default:
/* shouldn't happen */
kwrite_error(K, "unknown object type");
