[pure-lang-svn] SF.net SVN: pure-lang:[649] pure/trunk
Status: Beta
Brought to you by:
agraef
Menu
▾
▴
[pure-lang-svn] SF.net SVN: pure-lang:[649] pure/trunk
|
From: <ag...@us...> - 2008-08-28 11:16:45
|
Revision: 649
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=649&view=rev
Author: agraef
Date: 2008-08-28 11:16:52 +0000 (Thu, 28 Aug 2008)
Log Message:
-----------
Added sentries a.k.a. expression guards.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/runtime.cc
pure/trunk/runtime.h
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-28 08:39:27 UTC (rev 648)
+++ pure/trunk/ChangeLog 2008-08-28 11:16:52 UTC (rev 649)
@@ -1,5 +1,10 @@
2008-08-28 Albert Graef <Dr....@t-...>
+ * runtime.cc/h: Added sentries -- expression "guards" which are
+ applied to the target expression when it is garbage-collected.
+ Only sentries on applications and pointer objects are supported
+ right now.
+
* Makefile.in: Set LC_ALL=C, to work around failed math tests due
to locale-related problems on some systems. Note: This requires a
reconfigure.
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-08-28 08:39:27 UTC (rev 648)
+++ pure/trunk/runtime.cc 2008-08-28 11:16:52 UTC (rev 649)
@@ -102,6 +102,50 @@
#define SSTK_DEBUG 0
#endif
+static inline pure_expr* pure_apply2(pure_expr *x, pure_expr *y)
+{
+ // Count references and construct a function application.
+ pure_new_args(2, x, y);
+ return pure_apply(x, y);
+}
+
+static inline pure_expr* signal_exception(int sig)
+{
+ if (!interpreter::g_interp) return 0;
+ pure_expr *f = pure_const(interpreter::g_interp->symtab.signal_sym().f);
+ pure_expr *x = pure_int(sig);
+ return pure_apply2(f, x);
+}
+
+static inline pure_expr* stack_exception()
+{
+ if (!interpreter::g_interp) return 0;
+ return pure_const(interpreter::g_interp->symtab.segfault_sym().f);
+}
+
+static inline pure_expr *get_sentry(pure_expr *x)
+{
+ if (x==0)
+ return 0;
+ else if (x->tag == EXPR::APP || x->tag == EXPR::PTR)
+ return x->data.x[2];
+ else
+ return 0;
+}
+
+static inline void free_sentry(pure_expr *x)
+{
+ if (x->tag == EXPR::APP || x->tag == EXPR::PTR) {
+ pure_expr *s = x->data.x[2];
+ if (s) {
+ ++x->refc;
+ pure_freenew(pure_apply2(s, x));
+ pure_free(s);
+ --x->refc;
+ }
+ }
+}
+
// Expression pointers are allocated in larger chunks for better performance.
// NOTE: Only internal fields get initialized by new_expr(), the remaining
// fields *must* be initialized as appropriate by the caller.
@@ -123,6 +167,7 @@
}
x->refc = 0;
x->xp = interp.tmps;
+ x->data.x[2] = 0; // initialize the sentry
interp.tmps = x;
return x;
}
@@ -197,6 +242,7 @@
pure_expr *xp = 0, *y;
loop:
if (--x->refc == 0) {
+ free_sentry(x);
switch (x->tag) {
case EXPR::APP:
y = x->data.x[0];
@@ -242,6 +288,7 @@
void pure_free_internal(pure_expr *x)
{
if (--x->refc == 0) {
+ free_sentry(x);
switch (x->tag) {
case EXPR::APP:
pure_free_internal(x->data.x[0]);
@@ -287,27 +334,6 @@
}
}
-static inline pure_expr* pure_apply2(pure_expr *x, pure_expr *y)
-{
- // Count references and construct a function application.
- pure_new_args(2, x, y);
- return pure_apply(x, y);
-}
-
-static inline pure_expr* signal_exception(int sig)
-{
- if (!interpreter::g_interp) return 0;
- pure_expr *f = pure_const(interpreter::g_interp->symtab.signal_sym().f);
- pure_expr *x = pure_int(sig);
- return pure_apply2(f, x);
-}
-
-static inline pure_expr* stack_exception()
-{
- if (!interpreter::g_interp) return 0;
- return pure_const(interpreter::g_interp->symtab.segfault_sym().f);
-}
-
/* PUBLIC API. **************************************************************/
extern "C"
@@ -812,6 +838,32 @@
}
extern "C"
+pure_expr *pure_sentry(pure_expr *sentry, pure_expr *x)
+{
+ if (x==0)
+ return 0;
+ else if (x->tag == EXPR::APP || x->tag == EXPR::PTR) {
+ if (x->data.x[2])
+ pure_free_internal(x->data.x[2]);
+ x->data.x[2] = sentry?pure_new_internal(sentry):0;
+ return x;
+ } else
+ return 0;
+}
+
+extern "C"
+pure_expr *pure_get_sentry(pure_expr *x)
+{
+ return get_sentry(x);
+}
+
+extern "C"
+pure_expr *pure_clear_sentry(pure_expr *x)
+{
+ return pure_sentry(0, x);
+}
+
+extern "C"
bool pure_let(int32_t sym, pure_expr *x)
{
if (sym <= 0 || !x) return false;
Modified: pure/trunk/runtime.h
===================================================================
--- pure/trunk/runtime.h 2008-08-28 08:39:27 UTC (rev 648)
+++ pure/trunk/runtime.h 2008-08-28 11:16:52 UTC (rev 649)
@@ -38,7 +38,7 @@
int32_t tag; // type tag or symbol, see expr.hh for possible values
uint32_t refc; // reference counter
union {
- struct _pure_expr *x[2]; // application arguments (EXPR::APP)
+ struct _pure_expr *x[3]; // application arguments (EXPR::APP), sentry
int32_t i; // integer (EXPR::INT)
mpz_t z; // GMP bigint (EXPR::BIGINT)
double d; // double (EXPR::DBL)
@@ -217,6 +217,20 @@
void pure_ref(pure_expr *x);
void pure_unref(pure_expr *x);
+/* Sentries. These are expression "guards" which are applied to the target
+ expression when it is garbage-collected. pure_sentry places a sentry at an
+ expression (or removes it if sentry is NULL) and returns the modified
+ expression, pure_get_sentry returns the current sentry of an expression, if
+ any (NULL otherwise). pure_clear_sentry(x) is a convenience function for
+ pure_sentry(NULL, x). NOTE: In the current implementation sentries can only
+ be placed at applications and pointer objects, pure_sentry will return NULL
+ if you apply it to other kinds of expressions. The sentry itself can be any
+ type of object (but usually it's a function). */
+
+pure_expr *pure_sentry(pure_expr *sentry, pure_expr *x);
+pure_expr *pure_get_sentry(pure_expr *x);
+pure_expr *pure_clear_sentry(pure_expr *x);
+
/* Variable and constant definitions. These allow you to directly bind
variable and constant symbols to pure_expr* values, as the 'let' and 'def'
constructs do in the Pure language. The functions return true if
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
