[pypy-commit] stmgc default: in-progress

arigo noreply at buildbot.pypy.org
Sun Jun 23 11:53:27 CEST 2013


Author: Armin Rigo <arigo at tunes.org>
Branch: 
Changeset: r246:501a1ab04191
Date: 2013-06-23 11:53 +0200
http://bitbucket.org/pypy/stmgc/changeset/501a1ab04191/

Log:	in-progress

diff too long, truncating to 2000 out of 2024 lines

diff --git a/duhton/ceval.c b/duhton/ceval.c
--- a/duhton/ceval.c
+++ b/duhton/ceval.c
@@ -3,12 +3,11 @@
 
 DuObject *Du_Eval(DuObject *ob, DuObject *locals)
 {
-    eval_fn fn = ob->ob_type->dt_eval;
+    eval_fn fn = Du_TYPE(ob)->dt_eval;
     if (fn) {
         return fn(ob, locals);
     }
     else {
-        Du_INCREF(ob);
         return ob;
     }
 }
diff --git a/duhton/compile.c b/duhton/compile.c
--- a/duhton/compile.c
+++ b/duhton/compile.c
@@ -11,9 +11,12 @@
 
     list = DuList_New();
     if (level == 0) {
+        _du_save1(list);
         DuObject *item = DuSymbol_FromString("progn");
+        _du_restore1(list);
+        _du_save1(list);
         DuList_Append(list, item);
-        Du_DECREF(item);
+        _du_restore1(list);
     }
     c = fgetc(f);
     while (1) {
@@ -25,7 +28,6 @@
             if (level > 0)
                 Du_FatalError("more '(' than ')'");
             if (stop_after_newline) {
-                Du_DECREF(list);
                 return NULL;
             }
             goto done;
@@ -76,21 +78,19 @@
                 break;
             }
         }
+        _du_save1(list);
         DuList_Append(list, item);
-        Du_DECREF(item);
+        _du_restore1(list);
     }
 
  done:
-    Du_INCREF(Du_None);
     cons = Du_None;
     for (i = DuList_Size(list) - 1; i >= 0; i--) {
         DuObject *item = DuList_GetItem(list, i);
-        DuObject *newcons = DuCons_New(item, cons);
-        Du_DECREF(cons);
-        Du_DECREF(item);
-        cons = newcons;
+        _du_save1(list);
+        cons = DuCons_New(item, cons);
+        _du_restore1(list);
     }
-    Du_DECREF(list);
     return cons;
 }
 
diff --git a/duhton/consobject.c b/duhton/consobject.c
--- a/duhton/consobject.c
+++ b/duhton/consobject.c
@@ -5,22 +5,15 @@
     DuObject *car, *cdr;
 } DuConsObject;
 
-void cons_free(DuConsObject *ob)
-{
-    Du_DECREF(ob->car);
-    Du_DECREF(ob->cdr);
-#ifdef Du_DEBUG
-    ob->car = ob->cdr = (DuObject *)0xDD;
-#endif
-    free(ob);
-}
-
 void cons_print(DuConsObject *ob)
 {
     DuObject *p;
     printf("( ");
     while (1) {
+        _du_read1(ob);
+        _du_save1(ob);
         Du_Print(ob->car, 0);
+        _du_restore1(ob);
         p = ob->cdr;
         if (!DuCons_Check(p))
             break;
@@ -38,51 +31,53 @@
 
 DuObject *cons_eval(DuConsObject *ob, DuObject *locals)
 {
+    _du_read1(ob);
     return _DuFrame_EvalCall(locals, ob->car, ob->cdr, 1);
 }
 
-DuTypeObject DuCons_Type = {
-    DuOBJECT_HEAD_INIT(&DuType_Type),
+DuType DuCons_Type = {
     "cons",
+    DUTYPE_CONS,
     sizeof(DuConsObject),
-    (destructor_fn)cons_free,
     (print_fn)cons_print,
     (eval_fn)cons_eval,
 };
 
 DuObject *DuCons_New(DuObject *car, DuObject *cdr)
 {
+    _du_save2(car, cdr);
     DuConsObject *ob = (DuConsObject *)DuObject_New(&DuCons_Type);
-    ob->car = car; Du_INCREF(car);
-    ob->cdr = cdr; Du_INCREF(cdr);
+    _du_restore2(car, cdr);
+    ob->car = car;
+    ob->cdr = cdr;
     return (DuObject *)ob;
 }
 
 DuObject *DuCons_Car(DuObject *cons)
 {
     DuCons_Ensure("DuCons_Car", cons);
-    DuObject *res = ((DuConsObject *)cons)->car;
-    Du_INCREF(res);
-    return res;
+    _du_read1(cons);
+    return ((DuConsObject *)cons)->car;
 }
 
 DuObject *DuCons_Cdr(DuObject *cons)
 {
     DuCons_Ensure("DuCons_Cdr", cons);
-    DuObject *res = ((DuConsObject *)cons)->cdr;
-    Du_INCREF(res);
-    return res;
+    _du_read1(cons);
+    return ((DuConsObject *)cons)->cdr;
 }
 
 DuObject *_DuCons_CAR(DuObject *cons)
 {
     assert(DuCons_Check(cons));
+    _du_read1(cons);
     return ((DuConsObject *)cons)->car;
 }
 
 DuObject *_DuCons_NEXT(DuObject *cons)
 {
     assert(DuCons_Check(cons));
+    _du_read1(cons);
     DuObject *result = ((DuConsObject *)cons)->cdr;
     if (result != Du_None && !DuCons_Check(cons))
         Du_FatalError("_DuCons_NEXT: not a well-formed cons list");
@@ -93,5 +88,5 @@
 {
     if (!DuCons_Check(ob))
         Du_FatalError("%s: expected 'cons' argument, got '%s'",
-                      where, ob->ob_type->dt_name);
+                      where, Du_TYPE(ob)->dt_name);
 }
diff --git a/duhton/containerobject.c b/duhton/containerobject.c
--- a/duhton/containerobject.c
+++ b/duhton/containerobject.c
@@ -44,11 +44,10 @@
     Du_DECREF(prev);
 }
 
-DuTypeObject DuContainer_Type = {
-    DuOBJECT_HEAD_INIT(&DuType_Type),
+DuType DuContainer_Type = {
     "container",
+    DUTYPE_CONTAINER,
     sizeof(DuContainerObject),
-    (destructor_fn)container_free,
     (print_fn)container_print,
 };
 
diff --git a/duhton/duhton.h b/duhton/duhton.h
--- a/duhton/duhton.h
+++ b/duhton/duhton.h
@@ -1,43 +1,17 @@
 #ifndef _DUHTON_H_
 #define _DUHTON_H_
 
-
+#include "../c4/stmgc.h"
 #include <stdio.h>
 #include <stdlib.h>
 #include <assert.h>
 
 
-#define Du_AME     /* must always be on for now */
-
-#if defined(Du_DEBUG) || defined(Du_AME)
-#  define Du_TRACK_REFS
-#endif
-
-#ifdef Du_AME
-typedef long owner_version_t;
-#endif
-
-
-typedef struct _DuObject {
-    int ob_refcnt;
-    struct _DuTypeObject *ob_type;
-#ifdef Du_TRACK_REFS
-    struct _DuObject *ob_debug_prev, *ob_debug_next;
-#endif
-#ifdef Du_AME
-    owner_version_t ob_version;
-#endif
-} DuObject;
-
-#ifdef Du_TRACK_REFS
-#  define _DuObject_HEAD_EXTRA  NULL, NULL
-#else
-#  define _DuObject_HEAD_EXTRA  /* nothing */
-#endif
+typedef struct stm_object_s DuObject;
 
 #define DuOBJECT_HEAD   DuObject ob_base;
 
-#define DuOBJECT_HEAD_INIT(type)   { -1, type, _DuObject_HEAD_EXTRA }
+#define DuOBJECT_HEAD_INIT(type)   { type | PREBUILT_FLAGS, PREBUILT_REVISION }
 
 
 #ifdef __GNUC__
@@ -47,75 +21,59 @@
 #endif
 
 
-typedef void(*destructor_fn)(DuObject *);
 typedef void(*print_fn)(DuObject *);
 typedef DuObject *(*eval_fn)(DuObject *, DuObject *);
 typedef int(*len_fn)(DuObject *);
-typedef void(*ame_copy_fn)(DuObject *);
 
-typedef struct _DuTypeObject {
-    DuOBJECT_HEAD
+typedef struct {
     const char *dt_name;
+    int dt_typeindex;
     int dt_size;
-    destructor_fn dt_destructor;
     print_fn dt_print;
     eval_fn dt_eval;
     len_fn dt_is_true;
     len_fn dt_length;
-    ame_copy_fn dt_ame_copy;
-} DuTypeObject;
+} DuType;
 
-DuObject *DuObject_New(DuTypeObject *tp);
-void _Du_Dealloc(DuObject *ob);
+#define DUTYPE_INVALID       0
+#define DUTYPE_NONE          1
+#define DUTYPE_INT           2
+#define DUTYPE_SYMBOL        3
+#define DUTYPE_CONS          4
+#define DUTYPE_LIST          5
+#define DUTYPE_TUPLE         6
+#define DUTYPE_FRAME         7
+#define DUTYPE_CONTAINER     8
+#define _DUTYPE_TOTAL        9
+
+extern DuType DuNone_Type;
+extern DuType DuInt_Type;
+extern DuType DuSymbol_Type;
+extern DuType DuCons_Type;
+extern DuType DuList_Type;
+extern DuType DuTuple_Type;
+extern DuType DuFrame_Type;
+extern DuType DuContainer_Type;
+
+extern DuType *Du_Types[_DUTYPE_TOTAL];
+
+
+DuObject *DuObject_New(DuType *tp);
 int DuObject_IsTrue(DuObject *ob);
 int DuObject_Length(DuObject *ob);
 
-#ifdef Du_TRACK_REFS
-void _Du_NewReference(DuObject *ob);
-void _Du_ForgetReference(DuObject *ob);
-#else
-#define _Du_NewReference(ob)       /* nothing */
-#define _Du_ForgetReference(ob)    /* nothing */
-#endif
-void _Du_BecomeImmortal(DuObject *ob);
-
-
-#define Du_AME_GLOBAL(ob)                       \
-    (((DuObject*)(ob))->ob_refcnt < 0)
-
-#define Du_INCREF(ob)                           \
-    do {                                        \
-        if (!Du_AME_GLOBAL(ob))                 \
-            ++((DuObject*)(ob))->ob_refcnt;     \
-    } while (0)
-
-#define Du_DECREF(ob)                                   \
-    do {                                                \
-        if (((DuObject*)(ob))->ob_refcnt > 1)           \
-            --((DuObject*)(ob))->ob_refcnt;             \
-        else if (!Du_AME_GLOBAL(ob))                    \
-            _Du_Dealloc((DuObject*)(ob));               \
-    } while (0)
-
 
 extern DuObject _Du_NoneStruct;
 #define Du_None (&_Du_NoneStruct)
 
-extern DuTypeObject DuType_Type;
-extern DuTypeObject DuInt_Type;
-extern DuTypeObject DuList_Type;
-extern DuTypeObject DuContainer_Type;
-extern DuTypeObject DuCons_Type;
-extern DuTypeObject DuSymbol_Type;
-extern DuTypeObject DuFrame_Type;
-
-#define DuType_Check(ob)      (((DuObject*)(ob))->ob_type == &DuType_Type)
-#define DuInt_Check(ob)       (((DuObject*)(ob))->ob_type == &DuInt_Type)
-#define DuList_Check(ob)      (((DuObject*)(ob))->ob_type == &DuList_Type)
-#define DuContainer_Check(ob) (((DuObject*)(ob))->ob_type == &DuContainer_Type)
-#define DuCons_Check(ob)      (((DuObject*)(ob))->ob_type == &DuCons_Type)
-#define DuSymbol_Check(ob)    (((DuObject*)(ob))->ob_type == &DuSymbol_Type)
-#define DuFrame_Check(ob)     (((DuObject*)(ob))->ob_type == &DuFrame_Type)
+#define _DuObject_TypeNum(ob) stm_get_tid((DuObject*)(ob))
+#define Du_TYPE(ob)           (Du_Types[_DuObject_TypeNum(ob)])
+#define DuInt_Check(ob)       (_DuObject_TypeNum(ob) == DUTYPE_INT)
+#define DuSymbol_Check(ob)    (_DuObject_TypeNum(ob) == DUTYPE_SYMBOL)
+#define DuCons_Check(ob)      (_DuObject_TypeNum(ob) == DUTYPE_CONS)
+#define DuList_Check(ob)      (_DuObject_TypeNum(ob) == DUTYPE_LIST)
+#define DuFrame_Check(ob)     (_DuObject_TypeNum(ob) == DUTYPE_FRAME)
+#define DuContainer_Check(ob) (_DuObject_TypeNum(ob) == DUTYPE_CONTAINER)
 
 void DuType_Ensure(char *where, DuObject *ob);
 void DuInt_Ensure(char *where, DuObject *ob);
@@ -168,17 +126,28 @@
 
 void Du_Initialize(void);
 void Du_Finalize(void);
-void _Du_InitializeObjects(void);
-void _Du_FinalizeObjects(void);
-#ifdef Du_TRACK_REFS
-void _Du_MakeImmortal(void);
-#endif
 extern DuObject *Du_Globals;
 
 void Du_TransactionAdd(DuObject *code, DuObject *frame);
 void Du_TransactionRun(void);
 
 
-#include "stm/ame.h"
+#define _du_save1(p1)           (stm_push_root((DuObject *)(p1)))
+#define _du_save2(p1,p2)        (stm_push_root((DuObject *)(p1)),  \
+                                 stm_push_root((DuObject *)(p2)))
+#define _du_save3(p1,p2,p3)     (stm_push_root((DuObject *)(p1)),  \
+                                 stm_push_root((DuObject *)(p2)),  \
+                                 stm_push_root((DuObject *)(p3)))
+
+#define _du_restore1(p1)        (p1 = (typeof(p1))stm_pop_root())
+#define _du_restore2(p1,p2)     (p2 = (typeof(p2))stm_pop_root(),  \
+                                 p1 = (typeof(p1))stm_pop_root())
+#define _du_restore3(p1,p2,p3)  (p3 = (typeof(p3))stm_pop_root(),  \
+                                 p2 = (typeof(p2))stm_pop_root(),  \
+                                 p1 = (typeof(p1))stm_pop_root())
+
+#define _du_read1(p1)    (p1 = (typeof(p1))stm_read_barrier((DuObject *)(p1)))
+#define _du_write1(p1)   (p1 = (typeof(p1))stm_write_barrier((DuObject *)(p1)))
+
 
 #endif  /* _DUHTON_H_ */
diff --git a/duhton/frame.c b/duhton/frame.c
--- a/duhton/frame.c
+++ b/duhton/frame.c
@@ -226,10 +226,9 @@
                       where, ob->ob_type->dt_name);
 }
 
-DuTypeObject DuFrame_Type = {
-    DuOBJECT_HEAD_INIT(&DuType_Type),
+DuType DuFrame_Type = {
     "frame",
+    DUTYPE_FRAME,
     sizeof(DuFrameObject),
-    (destructor_fn)frame_free,
     (print_fn)frame_print,
 };
diff --git a/duhton/intobject.c b/duhton/intobject.c
--- a/duhton/intobject.c
+++ b/duhton/intobject.c
@@ -7,19 +7,20 @@
 
 void int_print(DuIntObject *ob)
 {
+    _du_read1(ob);
     printf("%d", ob->ob_intval);
 }
 
 int int_is_true(DuIntObject *ob)
 {
+    _du_read1(ob);
     return ob->ob_intval;
 }
 
-DuTypeObject DuInt_Type = {
-    DuOBJECT_HEAD_INIT(&DuType_Type),
+DuType DuInt_Type = {
     "int",
+    DUTYPE_INT,
     sizeof(DuIntObject),
-    (destructor_fn)free,
     (print_fn)int_print,
     (eval_fn)NULL,
     (len_fn)int_is_true,
@@ -36,6 +37,7 @@
 int DuInt_AsInt(DuObject *ob)
 {
     DuInt_Ensure("DuInt_AsInt", ob);
+    _du_read1(ob);
     return ((DuIntObject *)ob)->ob_intval;
 }
 
@@ -43,5 +45,5 @@
 {
     if (!DuInt_Check(ob))
         Du_FatalError("%s: expected 'int' argument, got '%s'",
-                      where, ob->ob_type->dt_name);
+                      where, Du_TYPE(ob)->dt_name);
 }
diff --git a/duhton/listobject.c b/duhton/listobject.c
--- a/duhton/listobject.c
+++ b/duhton/listobject.c
@@ -1,36 +1,35 @@
 #include <string.h>
 #include "duhton.h"
 
+
+/* 'tuple' objects are only used internally as the current items
+   of 'list' objects
+*/
 typedef struct {
     DuOBJECT_HEAD
     int ob_count;
-    DuObject **ob_items;
+    DuObject *ob_items[1];
+} DuTupleObject;
+
+typedef struct {
+    DuOBJECT_HEAD
+    DuTupleObject *ob_tuple;
 } DuListObject;
 
-void list_free(DuListObject *ob)
-{
-    int i;
-    for (i=0; i<ob->ob_count; i++) {
-        Du_DECREF(ob->ob_items[i]);
-#ifdef Du_DEBUG
-        ob->ob_items[i] = (DuObject *)0xDD;
-#endif
-    }
-    free(ob->ob_items);
-    free(ob);
-}
 
 void list_print(DuListObject *ob)
 {
     int i;
-    Du_AME_INEVITABLE(ob);
+    _du_read1(ob);
     if (ob->ob_count == 0) {
         printf("[]");
     }
     else {
+        DuTupleObject *p = ob->ob_tuple;
+        _du_read1(p);
         printf("[ ");
-        for (i=0; i<ob->ob_count; i++) {
-            Du_Print(ob->ob_items[i], 0);
+        for (i=0; i<p->ob_count; i++) {
+            Du_Print(p->ob_items[i], 0);
             printf(" ");
         }
         printf("]");
@@ -39,35 +38,35 @@
 
 int list_length(DuListObject *ob)
 {
-    int length;
-    Du_AME_READ(ob, (length = ob->ob_count));
-    return length;
+    _du_read1(ob);
+    DuTupleObject *p = ob->ob_tuple;
+    _du_read1(p);
+    return p->ob_count;
 }
 
-void list_ame_copy(DuListObject *ob)
+DuTupleObject *DuTuple_New(int length)
 {
-    DuObject **globitems = ob->ob_items;
-    int count = ob->ob_count;
-    ob->ob_items = malloc(sizeof(DuObject*) * count);
-    assert(ob->ob_items);
-    memcpy((char*)ob->ob_items, globitems, sizeof(DuObject*) * count);
-    /* XXX either this ob_items or the original one is never freed */
+    DuTupleObject *ob;
+    size_t size = sizeof(DuTupleObject) + (length-1)*sizeof(DuObject *);
+    ob = (DuTupleObject *)stm_allocate(size, DUTYPE_TUPLE);
+    ob->ob_count = length;
+    return ob;
 }
 
 void _list_append(DuListObject *ob, DuObject *x)
 {
-    Du_AME_WRITE(ob);
-    int i, newcount = ob->ob_count + 1;
-    DuObject **olditems = ob->ob_items;
-    DuObject **newitems = malloc(sizeof(DuObject*) * newcount);
-    assert(newitems);
+    _du_write1(ob);
+    DuTupleObject *olditems = ob->ob_tuple;
+
+    _du_read1(olditems);
+    int i, newcount = olditems->ob_count + 1;
+    DuTupleObject *newitems = DuTuple_New(newcount);
+
     for (i=0; i<newcount-1; i++)
         newitems[i] = olditems[i];
-    Du_INCREF(x);
     newitems[newcount-1] = x;
-    ob->ob_items = newitems;
-    ob->ob_count = newcount;
-    free(olditems);
+
+    ob->ob_tuple = newitems;
 }
 
 void DuList_Append(DuObject *ob, DuObject *item)
@@ -84,15 +83,13 @@
 
 DuObject *_list_getitem(DuListObject *ob, int index)
 {
-    DuObject *result;
-    int length;
-    DuObject **items;
-    Du_AME_READ(ob, (length = ob->ob_count, items = ob->ob_items));
-    if (index < 0 || index >= length)
+    _du_read1(ob);
+    DuTupleObject *p = ob->ob_tuple;
+
+    _du_read1(p);
+    if (index < 0 || index >= p->ob_count)
         Du_FatalError("list_get: index out of range");
-    result = items[index];
-    Du_INCREF(result);
-    return result;
+    return p->ob_items[index];
 }
 
 DuObject *DuList_GetItem(DuObject *ob, int index)
@@ -103,13 +100,13 @@
 
 void _list_setitem(DuListObject *ob, int index, DuObject *newitem)
 {
-    Du_AME_WRITE(ob);
-    if (index < 0 || index >= ob->ob_count)
+    _du_read1(ob);
+    DuTupleObject *p = ob->ob_tuple;
+
+    _du_write1(p);
+    if (index < 0 || index >= p->ob_count)
         Du_FatalError("list_set: index out of range");
-    DuObject *prev = ob->ob_items[index];
-    Du_INCREF(newitem);
-    ob->ob_items[index] = newitem;
-    Du_DECREF(prev);
+    p->ob_items[index] = newitem;
 }
 
 void DuList_SetItem(DuObject *list, int index, DuObject *newobj)
@@ -120,14 +117,16 @@
 
 DuObject *_list_pop(DuListObject *ob, int index)
 {
-    int i;
-    Du_AME_WRITE(ob);
-    if (index < 0 || index >= ob->ob_count)
+    _du_read1(ob);
+    DuTupleObject *p = ob->ob_tuple;
+
+    _du_write1(p);
+    if (index < 0 || index >= p->ob_count)
         Du_FatalError("list_pop: index out of range");
-    DuObject *result = ob->ob_items[index];
-    ob->ob_count--;
-    for (i=index; i<ob->ob_count; i++)
-        ob->ob_items[i] = ob->ob_items[i+1];
+    DuObject *result = p->ob_items[index];
+    p->ob_count--;
+    for (i=index; i<p->ob_count; i++)
+        p->ob_items[i] = p->ob_items[i+1];
     return result;
 }
 
@@ -137,23 +136,25 @@
     return _list_pop((DuListObject *)list, index);
 }
 
-DuTypeObject DuList_Type = {
-    DuOBJECT_HEAD_INIT(&DuType_Type),
+DuType DuList_Type = {
     "list",
+    DUTYPE_LIST,
     sizeof(DuListObject),
-    (destructor_fn)list_free,
     (print_fn)list_print,
     (eval_fn)NULL,
     (len_fn)NULL,
     (len_fn)list_length,
-    (ame_copy_fn)list_ame_copy,
 };
 
+static DuTupleObject du_empty_tuple = {
+    DuOBJECT_HEAD_INIT(DUTYPE_TUPLE),
+    0,
+}
+
 DuObject *DuList_New()
 {
     DuListObject *ob = (DuListObject *)DuObject_New(&DuList_Type);
-    ob->ob_count = 0;
-    ob->ob_items = NULL;
+    ob->ob_tuple = &du_empty_tuple;
     return (DuObject *)ob;
 }
 
@@ -161,5 +162,5 @@
 {
     if (!DuList_Check(ob))
         Du_FatalError("%s: expected 'list' argument, got '%s'",
-                      where, ob->ob_type->dt_name);
+                      where, Du_TYPE(ob)->dt_name);
 }
diff --git a/duhton/object.c b/duhton/object.c
--- a/duhton/object.c
+++ b/duhton/object.c
@@ -2,70 +2,26 @@
 #include "duhton.h"
 
 
-static __thread DuObject chainedlist;
+DuType *Du_Types[_DUTYPE_TOTAL] = {
+    NULL,
+    &DuNone_Type,
+    &DuInt_Type,
+    &DuSymbol_Type,
+    &DuCons_Type,
+    &DuList_Type,
+    &DuFrame_Type,
+    &DuContainer_Type,
+};
 
-DuObject *DuObject_New(DuTypeObject *tp)
+
+DuObject *DuObject_New(DuType *tp)
 {
     assert(tp->dt_size >= sizeof(DuObject));
-    DuObject *ob = malloc(tp->dt_size);
+    DuObject *ob = stm_allocate(tp->dt_size, tp->dt_typeindex);
     assert(ob);
-    ob->ob_refcnt = 1;
-    ob->ob_type = tp;
-    _Du_NewReference(ob);
     return ob;
 }
 
-void _Du_Dealloc(DuObject *ob)
-{
-    assert(ob->ob_refcnt == 1);
-    destructor_fn destructor = ob->ob_type->dt_destructor;
-    assert(destructor != NULL);
-    _Du_ForgetReference(ob);
-    destructor(ob);
-}
-
-#ifdef Du_TRACK_REFS
-void _Du_NewReference(DuObject *ob)
-{
-    if (chainedlist.ob_debug_prev == NULL)
-        Du_FatalError("Du_Initialize() must be called first");
-    ob->ob_debug_prev = &chainedlist;
-    ob->ob_debug_next = chainedlist.ob_debug_next;
-#ifdef Du_AME
-    ob->ob_version = 0;
-#endif
-    chainedlist.ob_debug_next = ob;
-    ob->ob_debug_next->ob_debug_prev = ob;
-}
-
-void _Du_ForgetReference(DuObject *ob)
-{
-    ob->ob_debug_prev->ob_debug_next = ob->ob_debug_next;
-    ob->ob_debug_next->ob_debug_prev = ob->ob_debug_prev;
-    ob->ob_debug_prev = NULL;
-    ob->ob_debug_next = NULL;
-}
-#endif
-
-void _Du_BecomeImmortal(DuObject *ob)
-{
-    _Du_ForgetReference(ob);
-    ob->ob_refcnt = -1;
-}
-
-void type_print(DuTypeObject *ob)
-{
-    printf("<type '%s'>", ob->dt_name);
-}
-
-DuTypeObject DuType_Type = {
-    DuOBJECT_HEAD_INIT(&DuType_Type),
-    "type",
-    0,
-    NULL,
-    (print_fn)type_print,
-};
-
 void none_print(DuObject *ob)
 {
     printf("None");
@@ -76,18 +32,17 @@
     return 0;
 }
 
-DuTypeObject DuNone_Type = {
-    DuOBJECT_HEAD_INIT(&DuType_Type),
+DuType DuNone_Type = {
     "NoneType",
+    DUTYPE_NONE,
     sizeof(DuObject),
-    NULL,
     none_print,
     (eval_fn)NULL,
     none_is_true,
 };
 
 DuObject _Du_NoneStruct =
-    DuOBJECT_HEAD_INIT(&DuNone_Type);
+    DuOBJECT_HEAD_INIT(DUTYPE_NONE);
 
 void Du_FatalError(char *msg, ...)
 {
@@ -102,63 +57,23 @@
 
 void Du_Print(DuObject *ob, int newline)
 {
-    ob->ob_type->dt_print(ob);
+    Du_TYPE(ob)->dt_print(ob);
     if (newline)
         printf("\n");
 }
 
 int DuObject_IsTrue(DuObject *ob)
 {
-    len_fn fn = ob->ob_type->dt_is_true;
-    if (!fn) fn = ob->ob_type->dt_length;
+    len_fn fn = Du_TYPE(ob)->dt_is_true;
+    if (!fn) fn = Du_TYPE(ob)->dt_length;
     if (!fn) return 1;
     return fn(ob) != 0;
 }
 
 int DuObject_Length(DuObject *ob)
 {
-    if (!ob->ob_type->dt_length)
+    if (!Du_TYPE(ob)->dt_length)
         Du_FatalError("object of type '%s' has no length",
-                      ob->ob_type->dt_name);
-    return ob->ob_type->dt_length(ob);
+                      Du_TYPE(ob)->dt_name);
+    return Du_TYPE(ob)->dt_length(ob);
 }
-
-void _Du_InitializeObjects(void)
-{
-#ifdef Du_TRACK_REFS
-    chainedlist.ob_debug_prev = &chainedlist;
-    chainedlist.ob_debug_next = &chainedlist;
-#endif
-}
-
-void _Du_FinalizeObjects(void)
-{
-#ifdef Du_DEBUG
-    DuObject *obj;
-    for (obj = chainedlist.ob_debug_next;
-         obj != &chainedlist;
-         obj = obj->ob_debug_next) {
-        printf("NOT FREED: ");
-        Du_Print(obj, 1);
-    }
-#endif
-#ifdef Du_TRACK_REFS
-    chainedlist.ob_debug_prev = NULL;
-    chainedlist.ob_debug_next = NULL;
-#endif
-}
-
-#ifdef Du_TRACK_REFS
-void _Du_MakeImmortal(void)
-{
-    DuObject *end_marker = &chainedlist;
-    DuObject *obj = end_marker;
-    do {
-        DuObject *next = obj->ob_debug_next;
-        obj->ob_refcnt = -1;
-        obj->ob_debug_prev = NULL;
-        obj->ob_debug_next = NULL;
-        obj = next;
-    } while (obj != end_marker);
-}
-#endif
diff --git a/duhton/stm/ame.c b/duhton/stm/ame.c
deleted file mode 100644
--- a/duhton/stm/ame.c
+++ /dev/null
@@ -1,466 +0,0 @@
-#include <string.h>
-#include <pthread.h>
-#include "ame.h"
-#include "lists.h"
-
-
-/* XXX assumes that time never wraps around (in a 'long'), which may be
- * correct on 64-bit machines but not on 32-bit machines if the process
- * runs for long enough.
- */
-
-#define IS_LOCKED(num)  ((num) < 0)
-#define IS_LOCKED_OR_NEWER(num, max_age)                        \
-    (((unsigned long)(num)) > ((unsigned long)(max_age)))
-
-
-struct tx_descriptor {
-    jmp_buf *setjmp_buf;
-    int in_transaction;
-    owner_version_t start_time;
-    owner_version_t end_time;
-    owner_version_t my_lock_word;
-    struct OrecList reads;
-    struct RedoLog redolog;   /* last item, because it's the biggest one */
-};
-
-/* global_timestamp contains in its lowest bit a flag equal to 1
-   if there is an inevitable transaction running */
-static volatile owner_version_t global_timestamp = 2;
-static __thread struct tx_descriptor *thread_descriptor;
-
-
-static void common_cleanup(struct tx_descriptor *d)
-{
-    d->reads.size = 0;
-    redolog_clear(&d->redolog);
-    d->in_transaction = 0;
-}
-
-static void tx_spinloop(void)
-{
-    spinloop();
-}
-
-static void tx_abort(void);
-
-static int is_inevitable(struct tx_descriptor *d)
-{
-    assert(d->in_transaction);
-    return d->setjmp_buf == NULL;
-}
-
-
-typedef struct {
-    DuOBJECT_HEAD
-    DuObject *ob_reference;
-} DuContainerObject;
-
-/*** run the redo log to commit a transaction, and release the locks */
-static void tx_redo(struct tx_descriptor *d)
-{
-    owner_version_t newver = d->end_time;
-    wlog_t *item;
-    REDOLOG_LOOP_FORWARD(d->redolog, item)
-    {
-        DuObject *globalobj = item->addr;
-        DuObject *localobj = item->val;
-        long size = localobj->ob_type->dt_size;
-        assert(size >= sizeof(DuObject));
-        memcpy(((char *)globalobj) + sizeof(DuObject),
-               ((char *)localobj) + sizeof(DuObject),
-               size - sizeof(DuObject));
-        CFENCE;
-        globalobj->ob_version = newver;
-
-        //int num = DuInt_AsInt(((DuContainerObject*)localobj)->ob_reference);
-        //printf("COMMIT thread %lx: %p <- %p (%d), v. %ld\n",
-        //        (long)pthread_self(), globalobj, localobj, num, newver);
-
-    } REDOLOG_LOOP_END;
-}
-
-/*** on abort, release locks and restore the old version number. */
-static void releaseAndRevertLocks(struct tx_descriptor *d)
-{
-  wlog_t *item;
-  REDOLOG_LOOP_FORWARD(d->redolog, item)
-  {
-      if (item->p != -1) {
-          DuObject* o = item->addr;
-          o->ob_version = item->p;
-      }
-  } REDOLOG_LOOP_END;
-}
-
-/*** release locks and restore the old version number, ready to retry later */
-static void releaseLocksForRetry(struct tx_descriptor *d)
-{
-    wlog_t *item;
-    REDOLOG_LOOP_FORWARD(d->redolog, item)
-    {
-        if (item->p != -1) {
-            DuObject* o = item->addr;
-            o->ob_version = item->p;
-            item->p = -1;
-        }
-    } REDOLOG_LOOP_END;
-}
-
-/*** lock all locations */
-static void acquireLocks(struct tx_descriptor *d)
-{
-    wlog_t *item;
-    // try to lock every location in the write set
-    REDOLOG_LOOP_BACKWARD(d->redolog, item)
-    {
-        DuObject* o = item->addr;
-        owner_version_t ovt;
-
-    retry:
-        ovt = o->ob_version;
-
-        // if object not locked, lock it
-        //
-        // NB: if ovt > start time, we may introduce inconsistent reads.
-        // Since most writes are also reads, we'll just abort under this
-        // condition.  This can introduce false conflicts
-        if (!IS_LOCKED_OR_NEWER(ovt, d->start_time)) {
-            if (!bool_cas(&o->ob_version, ovt, d->my_lock_word)) {
-                CFENCE;
-                goto retry;
-            }
-            // save old version to item->p.  Now we hold the lock.
-            item->p = ovt;
-        }
-        // else if the location is too recent...
-        else if (!IS_LOCKED(ovt))
-            tx_abort();
-        // else it is locked: check it's not by me (no duplicates in redolog)
-        else {
-            assert(ovt != d->my_lock_word);
-            // we can either abort or spinloop.  Because we are at the end of
-            // the transaction we might try to spinloop, even though after the
-            // lock is released the ovt will be very recent, possibly greater
-            // than d->start_time.  It is necessary to spinloop in case we are
-            // inevitable, so use that as a criteria.  Another solution to
-            // avoid deadlocks would be to sort the order in which we take the
-            // locks.
-            if (is_inevitable(d))
-                tx_spinloop();
-            else
-                tx_abort();
-            goto retry;
-        }
-    } REDOLOG_LOOP_END;
-}
-
-/**
- * fast-path validation, assuming that I don't hold locks.
- */
-static void validate_fast(struct tx_descriptor *d)
-{
-    int i;
-    owner_version_t ovt;
-    assert(!is_inevitable(d));
-    for (i=0; i<d->reads.size; i++) {
-     retry:
-        ovt = d->reads.items[i]->ob_version;
-        if (IS_LOCKED_OR_NEWER(ovt, d->start_time)) {
-            // If locked, we wait until it becomes unlocked.  The chances are
-            // that it will then have a very recent start_time, likely greater
-            // than d->start_time, but it might still be better than always
-            // aborting
-            if (IS_LOCKED(ovt)) {
-                tx_spinloop();
-                goto retry;
-            }
-            else
-                // abort if the timestamp is newer than my start time.  
-                tx_abort();
-        }
-    }
-}
-
-/**
- * validate the read set by making sure that all orecs that we've read have
- * timestamps at least as old as our start time, unless we locked those orecs.
- */
-static void validate(struct tx_descriptor *d)
-{
-    int i;
-    owner_version_t ovt;
-    assert(!is_inevitable(d));
-    for (i=0; i<d->reads.size; i++) {
-        ovt = d->reads.items[i]->ob_version;
-        if (IS_LOCKED_OR_NEWER(ovt, d->start_time)) {
-            if (!IS_LOCKED(ovt)) {
-                // if unlocked and newer than start time, abort
-                tx_abort();
-            }
-            else {
-                // if locked and not by me, abort
-                if (ovt != d->my_lock_word)
-                    tx_abort();
-            }
-        }
-    }
-}
-
-static void wait_end_inevitability(struct tx_descriptor *d)
-{
-    owner_version_t curts;
-    releaseLocksForRetry(d);
-
-    // We are going to wait until the other inevitable transaction
-    // finishes.  XXX We could do better here: we could check if
-    // committing 'd' would create a conflict for the other inevitable
-    // thread 'd_inev' or not.  It requires peeking in 'd_inev' from this
-    // thread (which we never do so far) in order to do something like
-    // 'validate_fast(d_inev); d_inev->start_time = updated;'
-
-    while ((curts = global_timestamp) & 1) {
-        // while we're about to wait anyway, we can do a validate_fast
-        if (d->start_time < curts - 1) {
-            validate_fast(d);
-            d->start_time = curts - 1;
-        }
-        tx_spinloop();
-    }
-    acquireLocks(d);
-}
-
-static void commitInevitableTransaction(struct tx_descriptor *d)
-{
-    owner_version_t ts;
-
-    // no-one else can modify global_timestamp if I'm inevitable
-    ts = global_timestamp;
-    assert(ts & 1);
-    global_timestamp = ts + 1;
-    d->end_time = ts + 1;
-    assert(d->end_time == (d->start_time + 2));
-
-    // run the redo log, and release the locks
-    tx_redo(d);
-}
-
-static void tx_abort(void)
-{
-    struct tx_descriptor *d = thread_descriptor;
-    assert(!is_inevitable(d));
-    // release the locks and restore version numbers
-    releaseAndRevertLocks(d);
-    // reset all lists
-    common_cleanup(d);
-
-    tx_spinloop();
-    longjmp(*d->setjmp_buf, 1);
-}
-
-
-static inline owner_version_t prepare_read(struct tx_descriptor *d,
-                                           DuObject *glob)
-{
-    owner_version_t ovt;
- retry:
-    ovt = glob->ob_version;
-    if (IS_LOCKED_OR_NEWER(ovt, d->start_time)) {
-        if (IS_LOCKED(ovt)) {
-            tx_spinloop();
-            goto retry;
-        }
-        /* else this location is too new, scale forward */
-        owner_version_t newts = global_timestamp & ~1;
-        validate_fast(d);
-        d->start_time = newts;
-    }
-    return ovt;
-}
-
-DuObject *_Du_AME_read_from_global(DuObject *glob, owner_version_t *vers_out)
-{
-    struct tx_descriptor *d = thread_descriptor;
-    wlog_t *found;
-    REDOLOG_FIND(d->redolog, glob, found, goto not_found);
-    DuObject *localobj = found->val;
-    assert(!Du_AME_GLOBAL(localobj));
-    return localobj;
-
- not_found:
-    *vers_out = prepare_read(d, glob);
-    return glob;
-}
-
-void _Du_AME_oreclist_insert(DuObject *glob)
-{
-    struct tx_descriptor *d = thread_descriptor;
-    oreclist_insert(&d->reads, glob);
-}
-
-DuObject *_Du_AME_writebarrier(DuObject *glob)
-{
-    struct tx_descriptor *d = thread_descriptor;
-    if (!d->in_transaction)
-        return glob;
-
-    DuObject *localobj;
-    wlog_t* found;
-    REDOLOG_FIND(d->redolog, glob, found, goto not_found);
-    localobj = found->val;
-    assert(!Du_AME_GLOBAL(localobj));
-    return localobj;
-
- not_found:;
-    /* We need to really make a local copy */
-    owner_version_t version;
-    int size = glob->ob_type->dt_size;
-    localobj = malloc(size);
-    assert(localobj != NULL);
-
-    do {
-        version = prepare_read(d, glob);
-        CFENCE;
-        /* Initialize the copy by doing an stm raw copy of the bytes */
-        memcpy((char *)localobj, (char *)glob, size);
-        CFENCE;
-        /* Check the copy for validity */
-    } while (glob->ob_version != version);
-
-    /* Initialize the copy's refcount to be a valid local object */
-    localobj->ob_refcnt = 42;   /* XXX */
-    /* Set the ob_debug_prev field to NULL and the ob_debug_next field to
-       point to the global object */
-    localobj->ob_debug_prev = NULL;
-    localobj->ob_debug_next = glob;
-    /* Ask for additional type-specific copy */
-    if (localobj->ob_type->dt_ame_copy)
-        localobj->ob_type->dt_ame_copy(localobj);
-    /* Register the object as a valid copy */
-    redolog_insert(&d->redolog, glob, localobj);
-    return localobj;
-}
-
-DuObject *_Du_AME_getlocal(DuObject *glob)
-{
-    struct tx_descriptor *d = thread_descriptor;
-    DuObject *localobj;
-    wlog_t* found;
-    REDOLOG_FIND(d->redolog, glob, found, return glob);
-    localobj = found->val;
-    assert(!Du_AME_GLOBAL(localobj));
-    return localobj;
-}
-
-void _Du_AME_InitThreadDescriptor(void)
-{
-    assert(thread_descriptor == NULL);
-    struct tx_descriptor *d = malloc(sizeof(struct tx_descriptor));
-    memset(d, 0, sizeof(struct tx_descriptor));
-
-    /* initialize 'my_lock_word' to be a unique negative number */
-    d->my_lock_word = (owner_version_t)d;
-    if (!IS_LOCKED(d->my_lock_word))
-        d->my_lock_word = ~d->my_lock_word;
-    assert(IS_LOCKED(d->my_lock_word));
-
-    common_cleanup(d);
-    thread_descriptor = d;
-}
-
-void _Du_AME_FiniThreadDescriptor(void)
-{
-    struct tx_descriptor *d = thread_descriptor;
-    assert(d);
-    thread_descriptor = NULL;
-    free(d);
-}
-
-void _Du_AME_StartTransaction(jmp_buf *setjmp_buf)
-{
-    struct tx_descriptor *d = thread_descriptor;
-    assert(!d->in_transaction);
-    d->setjmp_buf = setjmp_buf;
-    d->in_transaction = 1;
-    d->start_time = global_timestamp & ~1;
-}
-
-void _Du_AME_CommitTransaction(void)
-{
-    struct tx_descriptor *d = thread_descriptor;
-    assert(d->in_transaction);
-
-    // if I don't have writes, I'm committed
-    if (!redolog_any_entry(&d->redolog)) {
-        if (is_inevitable(d)) {
-            owner_version_t ts = global_timestamp;
-            assert(ts & 1);
-            global_timestamp = ts - 1;
-        }
-        common_cleanup(d);
-        return;
-    }
-
-    //printf("COMMIT thread %lx: START\n",
-    //        (long)pthread_self());
-
-    // acquire locks
-    acquireLocks(d);
-
-    if (is_inevitable(d)) {
-        commitInevitableTransaction(d);
-    }
-    else {
-        while (1) {
-            owner_version_t expected = global_timestamp;
-            if (expected & 1) {
-                // wait until it is done.  hopefully we can then proceed
-                // without conflicts.
-                wait_end_inevitability(d);
-                continue;
-            }
-            if (bool_cas(&global_timestamp, expected, expected + 2)) {
-                d->end_time = expected + 2;
-                break;
-            }
-        }
-
-        // validate (but skip validation if nobody else committed)
-        if (d->end_time != (d->start_time + 2))
-            validate(d);
-
-        // run the redo log, and release the locks
-        tx_redo(d);
-    }
-
-    //printf("COMMIT thread %lx: DONE\n",
-    //        (long)pthread_self());
-
-    common_cleanup(d);
-}
-
-void Du_AME_TryInevitable(void)
-{
-    struct tx_descriptor *d = thread_descriptor;
-    if (!d->in_transaction || is_inevitable(d))
-        return;
-
-    while (1) {
-        owner_version_t curtime = global_timestamp;
-        if (d->start_time != (curtime & ~1)) {
-            /* scale forward */
-            validate_fast(d);
-            d->start_time = curtime & ~1;
-        }
-        if (curtime & 1) { /* there is, or was, already an inevitable thread */
-            /* should we spinloop here, or abort (and likely come back
-               in try_inevitable() very soon)?  unclear.  For now
-               let's try to spinloop. */
-            tx_spinloop();
-            continue;
-        }
-        if (bool_cas(&global_timestamp, curtime, curtime + 1))
-            break;
-    }
-    d->setjmp_buf = NULL;   /* inevitable from now on */
-}
diff --git a/duhton/stm/ame.h b/duhton/stm/ame.h
deleted file mode 100644
--- a/duhton/stm/ame.h
+++ /dev/null
@@ -1,62 +0,0 @@
-#ifndef _DUHTON_AME_H_
-#define _DUHTON_AME_H_
-
-#include <setjmp.h>
-#include "atomic_ops.h"
-#include "../duhton.h"
-
-
-DuObject *_Du_AME_read_from_global(DuObject *glob, owner_version_t *vers_out);
-void _Du_AME_oreclist_insert(DuObject *glob);
-DuObject *_Du_AME_writebarrier(DuObject *glob);
-DuObject *_Du_AME_getlocal(DuObject *glob);
-
-void _Du_AME_InitThreadDescriptor(void);
-void _Du_AME_FiniThreadDescriptor(void);
-void _Du_AME_StartTransaction(jmp_buf *);
-void _Du_AME_CommitTransaction(void);
-
-void Du_AME_TryInevitable(void);
-
-
-#define Du_AME_READ(ob, READ_OPERATIONS)                                \
-    while (1) {                                                         \
-        DuObject *__du_ame_ob = (DuObject *)(ob);                       \
-        if (Du_AME_GLOBAL(__du_ame_ob)) {                               \
-            owner_version_t __du_ame_version;                           \
-            __du_ame_ob = _Du_AME_read_from_global(__du_ame_ob,         \
-                                                   &__du_ame_version);  \
-            (ob) = (typeof(ob))__du_ame_ob;                             \
-            if (Du_AME_GLOBAL(__du_ame_ob)) {                           \
-                CFENCE;                                                 \
-                READ_OPERATIONS;                                        \
-                CFENCE;                                                 \
-                __du_ame_ob = (DuObject *)(ob);                         \
-                if (__du_ame_ob->ob_version != __du_ame_version)        \
-                    continue;                                           \
-                _Du_AME_oreclist_insert(__du_ame_ob);                   \
-                break;                                                  \
-            }                                                           \
-        }                                                               \
-        READ_OPERATIONS;                                                \
-        break;                                                          \
-    }
-
-
-#define Du_AME_WRITE(ob)                                                \
-    do {                                                                \
-        if (Du_AME_GLOBAL(ob))                                          \
-            (ob) = (typeof(ob))_Du_AME_writebarrier((DuObject *)(ob));  \
-    } while (0)
-
-
-#define Du_AME_INEVITABLE(ob)                                           \
-    do {                                                                \
-        Du_AME_TryInevitable();                                         \
-        if (Du_AME_GLOBAL(ob))                                          \
-            (ob) = (typeof(ob))_Du_AME_getlocal((DuObject *)(ob));      \
-    } while (0)
-/* XXX must also wait for ob to be unlocked, if necessary */
-
-
-#endif  /* _DUHTON_AME_H_ */
diff --git a/duhton/stm/atomic_ops.h b/duhton/stm/atomic_ops.h
deleted file mode 100644
--- a/duhton/stm/atomic_ops.h
+++ /dev/null
@@ -1,52 +0,0 @@
-#ifndef _SRCSTM_ATOMIC_OPS_
-#define _SRCSTM_ATOMIC_OPS_
-
-
-/* "compiler fence" for preventing reordering of loads/stores to
-   non-volatiles */
-#define CFENCE          asm volatile ("":::"memory")
-
-
-#ifdef __llvm__
-#  define HAS_SYNC_BOOL_COMPARE_AND_SWAP
-#endif
-
-#ifdef __GNUC__
-#  if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 1)
-#    define HAS_SYNC_BOOL_COMPARE_AND_SWAP
-#  endif
-#endif
-
-
-#ifdef HAS_SYNC_BOOL_COMPARE_AND_SWAP
-#  define bool_cas __sync_bool_compare_and_swap
-#else
-/* x86 (32 bits and 64 bits) */
-static inline _Bool
-bool_cas(volatile long* ptr, long old, long _new)
-{
-    long prev;
-    asm volatile("lock;"
-#if defined(__amd64__)
-                 "cmpxchgq %1, %2;"
-#else
-                 "cmpxchgl %1, %2;"
-#endif
-                 : "=a"(prev)
-                 : "q"(_new), "m"(*ptr), "a"(old)
-                 : "memory");
-    return prev == old;
-}
-/* end */
-#endif
-
-
-static inline void spinloop(void)
-{
-  /* use "memory" here to make sure that gcc will reload the
-     relevant data from memory after the spinloop */
-  asm volatile ("pause":::"memory");
-}
-
-
-#endif  /* _SRCSTM_ATOMIC_OPS_ */
diff --git a/duhton/stm/fifo.c b/duhton/stm/fifo.c
deleted file mode 100644
--- a/duhton/stm/fifo.c
+++ /dev/null
@@ -1,51 +0,0 @@
-#include "fifo.h"
-
-
-void fifo_init(fifo_t *self)
-{
-    self->ff_first = NULL;
-    self->ff_last = NULL;
-}
-
-void fifo_append(fifo_t *self, fifonode_t *newnode)
-{
-    newnode->fn_next = NULL;
-    if (self->ff_last == NULL)
-        self->ff_first = newnode;
-    else
-        self->ff_last->fn_next = newnode;
-    self->ff_last = newnode;
-}
-
-int fifo_is_empty(fifo_t *self)
-{
-    assert((self->ff_first == NULL) == (self->ff_last == NULL));
-    return (self->ff_first == NULL);
-}
-
-int fifo_is_of_length_1(fifo_t *self)
-{
-    return (self->ff_first != NULL && self->ff_first == self->ff_last);
-}
-
-fifonode_t *fifo_pop_left(fifo_t *self)
-{
-    fifonode_t *item = self->ff_first;
-    self->ff_first = item->fn_next;
-    if (self->ff_first == NULL)
-        self->ff_last = NULL;
-    return item;
-}
-
-void fifo_steal(fifo_t *self, fifo_t *other)
-{
-    if (other->ff_last != NULL) {
-        if (self->ff_last == NULL)
-            self->ff_first = other->ff_first;
-        else
-            self->ff_last->fn_next = other->ff_first;
-        self->ff_last = other->ff_last;
-        other->ff_first = NULL;
-        other->ff_last = NULL;
-    }
-}
diff --git a/duhton/stm/fifo.h b/duhton/stm/fifo.h
deleted file mode 100644
--- a/duhton/stm/fifo.h
+++ /dev/null
@@ -1,23 +0,0 @@
-#include "../duhton.h"
-
-
-typedef struct {
-    struct fifonode_s *ff_first;
-    struct fifonode_s *ff_last;
-} fifo_t;
-
-typedef struct fifonode_s {
-    struct fifonode_s *fn_next;
-    DuObject *fn_frame;
-    DuObject *fn_code;
-} fifonode_t;
-
-
-#define FIFO_INITIALIZER  { NULL, NULL }
-
-void fifo_init(fifo_t *self);
-void fifo_append(fifo_t *self, fifonode_t *newnode);
-int fifo_is_empty(fifo_t *self);
-int fifo_is_of_length_1(fifo_t *self);
-fifonode_t *fifo_pop_left(fifo_t *self);
-void fifo_steal(fifo_t *self, fifo_t *other);
diff --git a/duhton/stm/lists.h b/duhton/stm/lists.h
deleted file mode 100644
--- a/duhton/stm/lists.h
+++ /dev/null
@@ -1,240 +0,0 @@
-/* -*- c-basic-offset: 2 -*- */
-
-#include <limits.h>
-
-/************************************************************/
-
-/* The redolog_xx functions are implemented as a tree, supporting
-   very high performance in REDOLOG_FIND in the common case where
-   there are no or few elements in the tree, but scaling correctly
-   if the number of items becomes large. */
-
-#define TREE_BITS   4
-#define TREE_ARITY  (1 << TREE_BITS)
-
-#define TREE_DEPTH_MAX   ((sizeof(DuObject*)*8 - 2 + TREE_BITS-1) / TREE_BITS)
-/* sizeof(void*) = total number of bits
-   2 = bits that we ignore anyway (2 or 3, conservatively 2)
-   (x + TREE_BITS-1) / TREE_BITS = divide by TREE_BITS, rounding up
-*/
-
-#define TREE_MASK   ((TREE_ARITY - 1) * sizeof(DuObject*))
-
-typedef struct {
-  DuObject *addr;
-  DuObject *val;
-  owner_version_t p;   // the previous version number (if locked)
-} wlog_t;
-
-typedef struct {
-  char *items[TREE_ARITY];
-} wlog_node_t;
-
-struct RedoLog {
-  char *raw_start, *raw_current, *raw_end;
-  wlog_node_t toplevel;
-};
-
-static void _redolog_clear_node(wlog_node_t *node)
-{
-  memset(node, 0, sizeof(wlog_node_t));
-}
-
-static void redolog_clear(struct RedoLog *redolog)
-{
-  if (redolog->raw_current != redolog->raw_start)
-    {
-      _redolog_clear_node(&redolog->toplevel);
-      redolog->raw_current = redolog->raw_start;
-    }
-}
-
-static int redolog_any_entry(struct RedoLog *redolog)
-{
-  return redolog->raw_current != redolog->raw_start;
-}
-
-#define _REDOLOG_LOOP(redolog, item, INITIAL, _PLUS_)                   \
-{                                                                       \
-  struct { char **next; char **end; } _stack[TREE_DEPTH_MAX], *_stackp; \
-  char **_next, **_end, *_entry;                                        \
-  /* initialization */                                                  \
-  _stackp = _stack;      /* empty stack */                              \
-  _next = (redolog).toplevel.items + INITIAL;                           \
-  _end = _next _PLUS_ TREE_ARITY;                                       \
-  /* loop */                                                            \
-  while (1)                                                             \
-    {                                                                   \
-      if (_next == _end)                                                \
-        {                                                               \
-          if (_stackp == _stack)                                        \
-            break;   /* done */                                         \
-          /* finished with this level, go to the next one */            \
-          _stackp--;                                                    \
-          _next = _stackp->next;                                        \
-          _end = _stackp->end;                                          \
-          continue;                                                     \
-        }                                                               \
-      _entry = *_next;                                                  \
-      _next = _next _PLUS_ 1;                                           \
-      if (_entry == NULL)   /* empty entry */                           \
-        continue;                                                       \
-      if (((long)_entry) & 1)                                           \
-        {  /* points to a further level: enter it */                    \
-          _stackp->next = _next;                                        \
-          _stackp->end = _end;                                          \
-          _stackp++;                                                    \
-          _next = ((wlog_node_t *)(_entry - 1))->items + INITIAL;       \
-          _end = _next _PLUS_ TREE_ARITY;                               \
-          continue;                                                     \
-        }                                                               \
-      /* points to a wlog_t item */                                     \
-      item = (wlog_t *)_entry;
-
-#define REDOLOG_LOOP_FORWARD(redolog, item)                             \
-                       _REDOLOG_LOOP(redolog, item, 0, +)
-#define REDOLOG_LOOP_BACKWARD(redolog, item)                            \
-                       _REDOLOG_LOOP(redolog, item, (TREE_ARITY-1), -)
-#define REDOLOG_LOOP_END     } }
-
-#define REDOLOG_FIND(redolog, addr1, result, goto_not_found)    \
-{                                                               \
-  unsigned long _key = (unsigned long)(addr1);                  \
-  char *_p = (char *)((redolog).toplevel.items);                \
-  char *_entry = *(char **)(_p + (_key & TREE_MASK));           \
-  if (__builtin_expect(_entry == NULL, 1))                      \
-    goto_not_found;    /* common case, hopefully */             \
-  result = _redolog_find(_entry, addr1);                        \
-  if (result == NULL || result->addr != (addr1))                \
-    goto_not_found;                                             \
-}
-
-static wlog_t *_redolog_find(char *entry, DuObject *addr)
-{
-  unsigned long key = (unsigned long)addr;
-  while (((long)entry) & 1)
-    {   /* points to a further level */
-      key >>= TREE_BITS;
-      entry = *(char **)((entry - 1) + (key & TREE_MASK));
-    }
-  return (wlog_t *)entry;   /* may be NULL */
-}
-
-static void redolog_insert(struct RedoLog *redolog,
-                           DuObject *addr, DuObject *val);
-
-static void _redolog_grow(struct RedoLog *redolog, long extra)
-{
-  struct RedoLog newredolog;
-  wlog_t *item;
-  long alloc = redolog->raw_end - redolog->raw_start;
-  long newalloc = (alloc + extra + (alloc >> 2) + 31) & ~15;
-  //fprintf(stderr, "growth: %ld\n", newalloc);
-  char *newitems = malloc(newalloc);
-  newredolog.raw_start = newitems;
-  newredolog.raw_current = newitems;
-  newredolog.raw_end = newitems + newalloc;
-  _redolog_clear_node(&newredolog.toplevel);
-  REDOLOG_LOOP_FORWARD(*redolog, item)
-    {
-      assert(item->p == -1);
-      redolog_insert(&newredolog, item->addr, item->val);
-    } REDOLOG_LOOP_END;
-  free(redolog->raw_start);
-  *redolog = newredolog;
-}
-
-static char *_redolog_grab(struct RedoLog *redolog, long size)
-{
-  char *result;
-  result = redolog->raw_current;
-  redolog->raw_current += size;
-  if (redolog->raw_current > redolog->raw_end)
-    {
-      _redolog_grow(redolog, size);
-      return NULL;
-    }
-  return result;
-}
-
-static void redolog_insert(struct RedoLog *redolog,
-                           DuObject *addr, DuObject *val)
-{
- retry:;
-  wlog_t *wlog;
-  unsigned long key = (unsigned long)addr;
-  int shift = 0;
-  char *p = (char *)(redolog->toplevel.items);
-  char *entry;
-  assert((key & (sizeof(DuObject*)-1)) == 0);   /* only for aligned keys */
-  while (1)
-    {
-      p += (key >> shift) & TREE_MASK;
-      shift += TREE_BITS;
-      entry = *(char **)p;
-      if (entry == NULL)
-        break;
-      else if (((long)entry) & 1)
-        {   /* points to a further level */
-          p = entry - 1;
-        }
-      else
-        {
-          wlog_t *wlog1 = (wlog_t *)entry;
-          /* the key must not already be present */
-          assert(wlog1->addr != addr);
-          /* collision: there is already a different wlog here */
-          wlog_node_t *node = (wlog_node_t *)
-                _redolog_grab(redolog, sizeof(wlog_node_t));
-          if (node == NULL) goto retry;
-          _redolog_clear_node(node);
-          unsigned long key1 = (unsigned long)(wlog1->addr);
-          char *p1 = (char *)(node->items);
-          *(wlog_t **)(p1 + ((key1 >> shift) & TREE_MASK)) = wlog1;
-          *(char **)p = ((char *)node) + 1;
-          p = p1;
-        }
-    }
-  wlog = (wlog_t *)_redolog_grab(redolog, sizeof(wlog_t));
-  if (wlog == NULL) goto retry;
-  wlog->addr = addr;
-  wlog->val = val;
-  wlog->p = -1;
-  *(char **)p = (char *)wlog;
-}
-
-/************************************************************/
-
-/* The oreclist_xx functions are implemented as an array that grows
-   as needed. */
-
-struct OrecList {
-  long size, alloc;
-  long locked;
-  DuObject **items;
-};
-
-static void _oreclist_grow(struct OrecList *oreclist)
-{
-  long newalloc = oreclist->alloc + (oreclist->alloc >> 1) + 16;
-  DuObject **newitems = malloc(newalloc * sizeof(DuObject *));
-  long i;
-  for (i=0; i<oreclist->size; i++)
-    newitems[i] = oreclist->items[i];
-  while (!bool_cas(&oreclist->locked, 0, 1))
-    /* rare case */ ;
-  free(oreclist->items);
-  oreclist->items = newitems;
-  oreclist->alloc = newalloc;
-  CFENCE;
-  oreclist->locked = 0;
-}
-
-static void oreclist_insert(struct OrecList *oreclist, DuObject *newitem)
-{
-  if (oreclist->size == oreclist->alloc)
-    _oreclist_grow(oreclist);
-  oreclist->items[oreclist->size++] = newitem;
-}
-
-/************************************************************/
diff --git a/duhton/stm/thread.c b/duhton/stm/thread.c
deleted file mode 100644
--- a/duhton/stm/thread.c
+++ /dev/null
@@ -1,173 +0,0 @@
-#include <pthread.h>
-#include <assert.h>
-#include "../duhton.h"
-#include "fifo.h"
-
-
-#define NUMTHREADS    2
-
-
-static int num_waiting_threads;
-static int finished;
-static pthread_mutex_t ll_state = PTHREAD_MUTEX_INITIALIZER;
-static pthread_mutex_t ll_no_tasks_pending = PTHREAD_MUTEX_INITIALIZER;
-static fifo_t global_list_pending = FIFO_INITIALIZER;
-static __thread fifo_t *local_list_pending = &global_list_pending;
-
-static void lock(pthread_mutex_t *mutex)
-{
-    if (pthread_mutex_lock(mutex) != 0)
-        Du_FatalError("lock() failed??");
-}
-
-static void unlock(pthread_mutex_t *mutex)
-{
-    if (pthread_mutex_unlock(mutex) != 0)
-        Du_FatalError("unlock() failed: the lock is not acquired?");
-}
-
-static int is_locked(pthread_mutex_t *mutex)
-{
-    /* Test a lock for debugging. */
-    if (pthread_mutex_trylock(mutex) != 0)
-        return 1;
-    unlock(mutex);
-    return 0;
-}
-
-void Du_TransactionAdd(DuObject *code, DuObject *frame)
-{
-    fifonode_t *fnode = malloc(sizeof(fifonode_t));
-    fnode->fn_code = code;   Du_INCREF(code);
-    fnode->fn_frame = frame; Du_INCREF(frame);
-    fifo_append(local_list_pending, fnode);
-}
-
-
-//static pthread_mutex_t tmp_GIL = PTHREAD_MUTEX_INITIALIZER;
-
-static void execute_fifo_node(fifonode_t *fnode)
-{
-    jmp_buf env;
-    assert(fifo_is_empty(local_list_pending));
-    //lock(&tmp_GIL);
-    if (setjmp(env) == 0) {
-        _Du_AME_StartTransaction(&env);
-        _Du_InitializeObjects();
-        DuObject *framecopy = DuFrame_Copy(fnode->fn_frame);
-        DuObject *res = Du_Progn(fnode->fn_code, framecopy);
-        Du_DECREF(res);
-        Du_DECREF(framecopy);
-        Du_DECREF(fnode->fn_frame);
-        Du_DECREF(fnode->fn_code);
-        _Du_MakeImmortal();
-        _Du_AME_CommitTransaction();
-        free(fnode);
-    }
-    else {    /* transaction aborted, re-schedule fnode for later */
-        fifo_t *local_list = local_list_pending;
-        fifo_init(local_list);
-        fifo_append(local_list, fnode);
-    }
-    //unlock(&tmp_GIL);
-}
-
-static void _add_list(fifo_t *new_pending_list)
-{
-    if (fifo_is_empty(new_pending_list))
-        return;
-    int was_empty = fifo_is_empty(&global_list_pending);
-    fifo_steal(&global_list_pending, new_pending_list);
-    if (was_empty)
-        unlock(&ll_no_tasks_pending);
-}
-
-static void *_run_thread(void *arg)
-{
-    lock(&ll_state);
-    _Du_AME_InitThreadDescriptor();
-    fifo_t my_transactions_pending = FIFO_INITIALIZER;
-    local_list_pending = &my_transactions_pending;
-
-    while (1) {
-        if (fifo_is_empty(&global_list_pending)) {
-            assert(is_locked(&ll_no_tasks_pending));
-            num_waiting_threads++;
-            if (num_waiting_threads == NUMTHREADS) {
-                finished = 1;
-                unlock(&ll_no_tasks_pending);
-            }
-            unlock(&ll_state);
-
-            lock(&ll_no_tasks_pending);
-            unlock(&ll_no_tasks_pending);
-
-            lock(&ll_state);
-            num_waiting_threads--;
-            if (finished)
-                break;
-        }
-        else {
-            fifonode_t *pending = fifo_pop_left(&global_list_pending);
-            if (fifo_is_empty(&global_list_pending))
-                lock(&ll_no_tasks_pending);
-            unlock(&ll_state);
-
-            while (1) {
-                execute_fifo_node(pending);
-                /* for now, always break out of this loop, unless
-                   'my_transactions_pending' contains precisely one item */
-                if (!fifo_is_of_length_1(&my_transactions_pending))
-                    break;
-                pending = fifo_pop_left(&my_transactions_pending);
-            }
-
-            lock(&ll_state);
-            _add_list(&my_transactions_pending);
-        }
-    }
-
-    local_list_pending = NULL;
-    _Du_AME_FiniThreadDescriptor();
-    unlock(&ll_state);
-    return NULL;
-}
-
-static void _run(void)
-{
-    pthread_t th[NUMTHREADS];
-    int i;
-    for (i=0; i<NUMTHREADS; i++) {
-        int status = pthread_create(&th[i], NULL, _run_thread, NULL);
-        assert(status == 0);
-    }
-    for (i=0; i<NUMTHREADS; i++) {
-        void *result;
-        int status = pthread_join(th[i], &result);
-        assert(status == 0);
-        assert(result == NULL);
-    }
-}
-
-void Du_TransactionRun(void)
-{
-    assert(!is_locked(&ll_state));
-    assert(!is_locked(&ll_no_tasks_pending));
-    if (fifo_is_empty(&global_list_pending))
-        return;
-
-    _Du_MakeImmortal();
-
-    num_waiting_threads = 0;
-    finished = 0;
-
-    _run();
-
-    assert(finished);
-    assert(num_waiting_threads == 0);
-    assert(fifo_is_empty(&global_list_pending));
-    assert(!is_locked(&ll_state));
-    assert(!is_locked(&ll_no_tasks_pending));
-
-    _Du_InitializeObjects();
-}
diff --git a/duhton/symbol.c b/duhton/symbol.c
--- a/duhton/symbol.c
+++ b/duhton/symbol.c
@@ -7,18 +7,27 @@
     struct _Du_Symbol *next;
 } DuSymbolObject;
 
-DuSymbolObject *_Du_AllSymbols = NULL;
+static DuSymbolObject _Du_AllSymbols = {
+    DuOBJECT_HEAD_INIT(DUTYPE_SYMBOL),
+    "",
+    NULL};
+
 
 void symbol_print(DuSymbolObject *ob)
 {
+    _du_read1(ob);
     printf("'%s'", ob->name);
 }
 
 DuObject *symbol_eval(DuObject *ob, DuObject *locals)
 {
+    _du_save1(ob);
     DuObject *res = DuFrame_GetSymbol(locals, ob);
+    _du_restore1(ob);
     if (res == NULL) {
+        _du_save1(ob);
         res = DuFrame_GetSymbol(Du_Globals, ob);
+        _du_restore1(ob);
         if (res == NULL)
             Du_FatalError("symbol not defined as a variable: '%s'",
                           DuSymbol_AsString(ob));
@@ -26,36 +35,37 @@
     return res;
 }
 
-DuTypeObject DuSymbol_Type = {
-    DuOBJECT_HEAD_INIT(&DuType_Type),
+DuType DuSymbol_Type = {
     "symbol",
+    DUTYPE_SYMBOL,
     sizeof(DuSymbolObject),
-    (destructor_fn)NULL,
     (print_fn)symbol_print,
     (eval_fn)symbol_eval,
 };
 
 DuObject *DuSymbol_FromString(char *name)
 {
-    DuSymbolObject *p;
-    for (p=_Du_AllSymbols; p != NULL; p=p->next) {
+    DuSymbolObject *p, *head = &_Du_AllSymbols;
+    for (p=head; p != NULL; p=p->next) {
+        _du_read1(p);
         if (strcmp(name, p->name) == 0) {
-            Du_INCREF(p);
             return (DuObject *)p;
         }
     }
     p = (DuSymbolObject *)DuObject_New(&DuSymbol_Type);
-    _Du_BecomeImmortal((DuObject *)p);    /* make the symbol object immortal */
     p->name = strdup(name);
-    p->next = _Du_AllSymbols;


More information about the pypy-commit mailing list