clisp-cvs digest, Vol 1 #506 - 4 msgs

[<cli...@li...>]

Send clisp-cvs mailing list submissions to
	cli...@li...

To subscribe or unsubscribe via the World Wide Web, visit
	https://lists.sourceforge.net/lists/listinfo/clisp-cvs
or, via email, send a message with subject or body 'help' to
	cli...@li...

You can reach the person managing the list at
	cli...@li...

When replying, please edit your Subject line so it is more specific
than "Re: Contents of clisp-cvs digest..."


CLISP CVS commits for today

Today's Topics:

   1. clisp/src weak.d,NONE,1.1 (Bruno Haible)
   2. clisp/tests weak.tst,NONE,1.1 (Bruno Haible)
   3. clisp/tests tests.lisp,1.31,1.32 ChangeLog,1.164,1.165 (Bruno Haible)
   4. clisp/src io.d,1.222,1.223 constobj.d,1.123,1.124 places.lisp,1.34,1.35 subr.d,1.169,1.170 subrkw.d,1.43,1.44 spvw.d,1.281,1.282 spvw_garcol.d,1.73,1.74 lispbibl.d,1.482,1.483 predtype.d,1.103,1.104 makemake.in,1.441,1.442 spvw_circ.d,1.26,1.27 record.d,1.86,1.87 init.lisp,1.133,1.134 spvw_memfile.d,1.70,1.71 constsym.d,1.237,1.238 ChangeLog,1.3041,1.3042 (Bruno Haible)

--__--__--

Message: 1
From: Bruno Haible <ha...@us...>
To: cli...@li...
Subject: clisp/src weak.d,NONE,1.1
Date: Wed, 19 May 2004 10:22:14 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1666/src

Added Files:
	weak.d 
Log Message:
Functions for weak datastructures.


--- NEW FILE: weak.d ---
/*
 * Functions for weak references in CLISP
 * Bruno Haible 1999-2004
 * Sam Steingold 2003
 */
#include "lispbibl.c"

/* ============================= Weak Pointers ============================= */

/* (MAKE-WEAK-POINTER value)
   returns a fresh weak pointer referring to value. */
LISPFUN(make_weak_pointer,seclass_no_se,1,0,norest,nokey,0,NIL) {
  var object wp = allocate_xrecord(0,Rectype_Weakpointer,weakpointer_length,0,
                                   orecord_type);
  var object obj = popSTACK();
  TheWeakpointer(wp)->wp_value = obj;
  TheWeakpointer(wp)->wp_cdr = unbound; /* a GC-invariant dummy */
  activate_weak(wp); /* add to O(all_weakpointers) if needed */
  VALUES1(wp);
[...1135 lines suppressed...]
        }
      ASSERT(i == count);
      # Add the new pair.
      TheWeakAlist(wal)->wal_data[2*i+0] = STACK_(3+3);
      TheWeakAlist(wal)->wal_data[2*i+1] = STACK_(4+3);
      i++;
      TheWeakAlist(wal)->wal_count = fixnum(i);
      for (; i < maxlen; i++) {
        TheWeakAlist(wal)->wal_data[2*i+0] = unbound;
        TheWeakAlist(wal)->wal_data[2*i+1] = unbound;
      }
      activate_weak(wal); /* add to O(all_weakpointers) if needed */
      TheMutableWeakAlist(STACK_(2+3))->mwal_list = wal;
    }
  }
  VALUES1(STACK_(4+3));
  skipSTACK(5+3);
}

/* ========================================================================= */



--__--__--

Message: 2
From: Bruno Haible <ha...@us...>
To: cli...@li...
Subject: clisp/tests weak.tst,NONE,1.1
Date: Wed, 19 May 2004 10:22:41 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1745/tests

Added Files:
	weak.tst 
Log Message:
Tests for weak datastructures.


--- NEW FILE: weak.tst ---
;; Tests for datatypes containing weak references
;; Bruno Haible 2004-05-05

;; Type tests

(mapcar #'(lambda (x)
            (list (weak-pointer-p x)
                  (weak-list-p x)
                  (weak-and-relation-p x)
                  (weak-or-relation-p x)
                  (weak-mapping-p x)
                  (weak-and-mapping-p x)
                  (weak-or-mapping-p x)
                  (weak-alist-p x)))
        (list '(a b c)
              #(a b c)
              (make-weak-pointer (list 'x))
              (make-weak-list (list 'x 'y 'z))
              (make-weak-and-relation (list (list 'x)))
[...1355 lines suppressed...]
                                                    (cons kc vc)))))
    (list (weak-alist-value ka w :test #'(lambda (u v) (string-equal (car u) (car v))))
          (weak-alist-value kb w :test #'(lambda (u v) (string-equal (car u) (car v))))
          (weak-alist-value kc w :test #'(lambda (u v) (string-equal (car u) (car v))))
          (weak-alist-value va w :test #'(lambda (u v) (string-equal (car u) (car v))))
          (weak-alist-value vb w :test #'(lambda (u v) (string-equal (car u) (car v))))
          (weak-alist-value vc w :test #'(lambda (u v) (string-equal (car u) (car v)))))))
((\x) (\y) (\z) (\x) (\y) (\z))

(let* ((li '())
       (w (let ((ali '()))
            (loop :for i :from 0 :to 1000
                  :for string = (format nil "~r" i)
                  :do (push string li) (push (cons string i) ali))
            (setq li (nreverse li))
            (setq ali (nreverse ali))
            (make-weak-alist :initial-contents ali))))
  (list (progn (gc) (length (weak-alist-contents w)))
        (progn (setq li nil) (gc) (length (weak-alist-contents w)))))
(1001 0)



--__--__--

Message: 3
From: Bruno Haible <ha...@us...>
To: cli...@li...
Subject: clisp/tests tests.lisp,1.31,1.32 ChangeLog,1.164,1.165
Date: Wed, 19 May 2004 10:24:32 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1847/tests

Modified Files:
	tests.lisp ChangeLog 
Log Message:
Implement weak data structures (relations, mappings, lists, alists).


Index: tests.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/tests.lisp,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -d -r1.31 -r1.32
--- tests.lisp	29 Apr 2004 19:12:37 -0000	1.31
+++ tests.lisp	19 May 2004 10:24:29 -0000	1.32
@@ -196,7 +196,8 @@
                                     "symbols"
                   #+XCL             "tprint"
                   #+XCL             "tread"
-                                    "type"))
+                                    "type"
+                  #+CLISP           "weak"))
       (with-accumulating-errors (error-count total-count) (run-test ff)))
     #+CLISP
     (dotimes (i 50)

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v
retrieving revision 1.164
retrieving revision 1.165
diff -u -d -r1.164 -r1.165
--- ChangeLog	19 May 2004 10:12:50 -0000	1.164
+++ ChangeLog	19 May 2004 10:24:29 -0000	1.165
@@ -1,3 +1,8 @@
+2004-05-08  Bruno Haible  <br...@cl...>
+
+	* weak.tst: New file.
+	* tests.lisp (run-all-tests): Also run weak.tst.
+
 2004-04-25  Bruno Haible  <br...@cl...>
 
 	* clos.tst: Test documentation string on a class without proper name.



--__--__--

Message: 4
From: Bruno Haible <ha...@us...>
To: cli...@li...
Subject: clisp/src io.d,1.222,1.223 constobj.d,1.123,1.124 places.lisp,1.34,1.35 subr.d,1.169,1.170 subrkw.d,1.43,1.44 spvw.d,1.281,1.282 spvw_garcol.d,1.73,1.74 lispbibl.d,1.482,1.483 predtype.d,1.103,1.104 makemake.in,1.441,1.442 spvw_circ.d,1.26,1.27 record.d,1.86,1.87 init.lisp,1.133,1.134 spvw_memfile.d,1.70,1.71 constsym.d,1.237,1.238 ChangeLog,1.3041,1.3042
Date: Wed, 19 May 2004 10:24:31 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1847/src

Modified Files:
	io.d constobj.d places.lisp subr.d subrkw.d spvw.d 
	spvw_garcol.d lispbibl.d predtype.d makemake.in spvw_circ.d 
	record.d init.lisp spvw_memfile.d constsym.d ChangeLog 
Log Message:
Implement weak data structures (relations, mappings, lists, alists).


Index: spvw_memfile.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/spvw_memfile.d,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -d -r1.70 -r1.71
--- spvw_memfile.d	29 Apr 2004 19:14:49 -0000	1.70
+++ spvw_memfile.d	19 May 2004 10:24:29 -0000	1.71
@@ -1478,6 +1478,21 @@
  #ifdef GENERATIONAL_GC
   O(gc_count) = Fixnum_0;  /* so far no GCs: */
  #endif
+  { # Initialize markwatchset:
+    var uintL need = 0;
+    var object L;
+    for (L = O(all_weakpointers);
+         !eq(L,Fixnum_0);
+         L = ((Weakpointer)TheRecord(L))->wp_cdr)
+      need += 1 + max_watchset_count(L);
+    if (need > 0) {
+      markwatchset_allocated = markwatchset_size = need;
+      begin_system_call();
+      markwatchset = (markwatch_t*)malloc(markwatchset_allocated*sizeof(markwatch_t));
+      end_system_call();
+      if (markwatchset==NULL) goto abort3;
+    }
+  }
  #ifdef MACHINE_KNOWN
   /* declare (MACHINE-TYPE), (MACHINE-VERSION), (MACHINE-INSTANCE)
      as unknown again: */

Index: spvw_circ.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/spvw_circ.d,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -d -r1.26 -r1.27
--- spvw_circ.d	16 May 2004 18:46:30 -0000	1.26
+++ spvw_circ.d	19 May 2004 10:24:28 -0000	1.27
@@ -549,6 +549,58 @@
           case Rectype_Weakpointer: /* only the value is printed! */
             get_circ_mark(TheWeakpointer(obj)->wp_value,env);
             goto m_end;
+          case Rectype_MutableWeakList:
+            get_circ_mark(TheMutableWeakList(obj)->mwl_list,env);
+            goto m_end;
+          case Rectype_MutableWeakAlist:
+            get_circ_mark(TheMutableWeakAlist(obj)->mwal_list,env);
+            goto m_end;
+          case Rectype_Weakmapping:
+            get_circ_mark(TheWeakmapping(obj)->wm_value,env);
+            get_circ_mark(TheWeakmapping(obj)->wm_key,env);
+            goto m_end;
+          case Rectype_WeakList:
+            {
+              var uintL count = Lrecord_length(obj)-2;
+              if (count > 0) {
+                var gcv_object_t* ptr = &TheWeakList(obj)->wl_elements[0];
+                if (SP_overflow()) # check SP-depth
+                  longjmp(env->abbruch_context,true); # abort
+                dotimespC(count,count, { get_circ_mark(*ptr++,env); } ); # mark elements (recursive)
+              }
+            }
+            goto m_end;
+          case Rectype_WeakAnd:
+            get_circ_mark(TheWeakAnd(obj)->war_keys_list,env);
+            goto m_end;
+          case Rectype_WeakOr:
+            get_circ_mark(TheWeakOr(obj)->wor_keys_list,env);
+            goto m_end;
+          case Rectype_WeakAndMapping:
+            get_circ_mark(TheWeakAndMapping(obj)->wam_value,env);
+            get_circ_mark(TheWeakAndMapping(obj)->wam_keys_list,env);
+            goto m_end;
+          case Rectype_WeakOrMapping:
+            get_circ_mark(TheWeakOrMapping(obj)->wom_value,env);
+            get_circ_mark(TheWeakOrMapping(obj)->wom_keys_list,env);
+            goto m_end;
+          case Rectype_WeakAlist_Key:
+          case Rectype_WeakAlist_Value:
+          case Rectype_WeakAlist_Either:
+          case Rectype_WeakAlist_Both:
+            {
+              var uintL count = (Lrecord_length(obj)-2)/2;
+              if (count > 0) {
+                var gcv_object_t* ptr = &TheWeakAlist(obj)->wal_data[0];
+                if (SP_overflow()) # check SP-depth
+                  longjmp(env->abbruch_context,true); # abort
+                dotimespC(count,count, {
+                  get_circ_mark(*ptr++,env); # mark key (recursive)
+                  get_circ_mark(*ptr++,env); # mark value (recursive)
+                });
+              }
+            }
+            goto m_end;
           default: break;
         }
         # Pathnames, Random-States, Bytes, Fsubrs, Loadtimeevals,
@@ -858,6 +910,58 @@
           case Rectype_Weakpointer: /* only the value is printed! */
             get_circ_mark(TheWeakpointer(obj)->wp_value,env);
             goto m_end;
+          case Rectype_MutableWeakList:
+            get_circ_mark(TheMutableWeakList(obj)->mwl_list,env);
+            goto m_end;
+          case Rectype_MutableWeakAlist:
+            get_circ_mark(TheMutableWeakAlist(obj)->mwal_list,env);
+            goto m_end;
+          case Rectype_Weakmapping:
+            get_circ_mark(TheWeakmapping(obj)->wm_value,env);
+            get_circ_mark(TheWeakmapping(obj)->wm_key,env);
+            goto m_end;
+          case Rectype_WeakList:
+            {
+              var uintL count = Lrecord_length(obj)-2;
+              if (count > 0) {
+                var gcv_object_t* ptr = &TheWeakList(obj)->wl_elements[0];
+                if (SP_overflow()) # check SP-depth
+                  longjmp(env->abbruch_context,true); # abort
+                dotimespC(count,count, { get_circ_mark(*ptr++,env); } ); # mark elements (recursive)
+              }
+            }
+            goto m_end;
+          case Rectype_WeakAnd:
+            get_circ_mark(TheWeakAnd(obj)->war_keys_list,env);
+            goto m_end;
+          case Rectype_WeakOr:
+            get_circ_mark(TheWeakOr(obj)->wor_keys_list,env);
+            goto m_end;
+          case Rectype_WeakAndMapping:
+            get_circ_mark(TheWeakAndMapping(obj)->wam_value,env);
+            get_circ_mark(TheWeakAndMapping(obj)->wam_keys_list,env);
+            goto m_end;
+          case Rectype_WeakOrMapping:
+            get_circ_mark(TheWeakOrMapping(obj)->wom_value,env);
+            get_circ_mark(TheWeakOrMapping(obj)->wom_keys_list,env);
+            goto m_end;
+          case Rectype_WeakAlist_Key:
+          case Rectype_WeakAlist_Value:
+          case Rectype_WeakAlist_Either:
+          case Rectype_WeakAlist_Both:
+            {
+              var uintL count = (Lrecord_length(obj)-2)/2;
+              if (count > 0) {
+                var gcv_object_t* ptr = &TheWeakAlist(obj)->wal_data[0];
+                if (SP_overflow()) # check SP-depth
+                  longjmp(env->abbruch_context,true); # abort
+                dotimespC(count,count, {
+                  get_circ_mark(*ptr++,env); # mark key (recursive)
+                  get_circ_mark(*ptr++,env); # mark value (recursive)
+                });
+              }
+            }
+            goto m_end;
           default: break;
         }
         # Pathnames, Random-States, Bytes, Fsubrs, Loadtimeevals,
@@ -1045,6 +1149,54 @@
           case Rectype_Weakpointer: /* only the value is printed! */
             get_circ_unmark(TheWeakpointer(obj)->wp_value,env);
             goto u_end;
+          case Rectype_MutableWeakList:
+            get_circ_unmark(TheMutableWeakList(obj)->mwl_list,env);
+            goto u_end;
+          case Rectype_MutableWeakAlist:
+            get_circ_unmark(TheMutableWeakAlist(obj)->mwal_list,env);
+            goto u_end;
+          case Rectype_Weakmapping:
+            get_circ_unmark(TheWeakmapping(obj)->wm_value,env);
+            get_circ_unmark(TheWeakmapping(obj)->wm_key,env);
+            goto u_end;
+          case Rectype_WeakList:
+            {
+              var uintL count = Lrecord_length(obj)-2;
+              if (count > 0) {
+                var gcv_object_t* ptr = &TheWeakList(obj)->wl_elements[0];
+                dotimespC(count,count, { get_circ_unmark(*ptr++,env); } ); # mark elements (recursive)
+              }
+            }
+            goto u_end;
+          case Rectype_WeakAnd:
+            get_circ_unmark(TheWeakAnd(obj)->war_keys_list,env);
+            goto u_end;
+          case Rectype_WeakOr:
+            get_circ_unmark(TheWeakOr(obj)->wor_keys_list,env);
+            goto u_end;
+          case Rectype_WeakAndMapping:
+            get_circ_unmark(TheWeakAndMapping(obj)->wam_value,env);
+            get_circ_unmark(TheWeakAndMapping(obj)->wam_keys_list,env);
+            goto u_end;
+          case Rectype_WeakOrMapping:
+            get_circ_unmark(TheWeakOrMapping(obj)->wom_value,env);
+            get_circ_unmark(TheWeakOrMapping(obj)->wom_keys_list,env);
+            goto u_end;
+          case Rectype_WeakAlist_Key:
+          case Rectype_WeakAlist_Value:
+          case Rectype_WeakAlist_Either:
+          case Rectype_WeakAlist_Both:
+            {
+              var uintL count = (Lrecord_length(obj)-2)/2;
+              if (count > 0) {
+                var gcv_object_t* ptr = &TheWeakAlist(obj)->wal_data[0];
+                dotimespC(count,count, {
+                  get_circ_unmark(*ptr++,env); # mark key (recursive)
+                  get_circ_unmark(*ptr++,env); # mark value (recursive)
+                });
+              }
+            }
+            goto u_end;
           default: break;
         }
         # Pathnames, Random-States, Bytes, Fsubrs, Loadtimeevals,

Index: subrkw.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/subrkw.d,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -d -r1.43 -r1.44
--- subrkw.d	11 May 2004 17:43:12 -0000	1.43
+++ subrkw.d	19 May 2004 10:24:26 -0000	1.44
@@ -129,6 +129,14 @@
 v(9, (kw(element_type),kw(external_format),kw(buffered),kw(arguments),kw(wait),kw(input),kw(output),kw(error),kw(priority)))
 s(launch)
 #endif
+v(2, (kw(type),kw(initial_contents)) )
+s(make_weak_alist)
+v(3, (kw(test),kw(test_not),kw(key)) )
+s(weak_alist_assoc)
+s(weak_alist_rassoc)
+v(2, (kw(test),kw(test_not)) )
+s(weak_alist_value)
+s(set_weak_alist_value)
 v(2, (kw(initial_element),kw(update)) )
 s(make_sequence)
 v(5, (kw(from_end),kw(start),kw(end),kw(key),kw(initial_value)) )

Index: constobj.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/constobj.d,v
retrieving revision 1.123
retrieving revision 1.124
diff -u -d -r1.123 -r1.124
--- constobj.d	17 May 2004 16:47:48 -0000	1.123
+++ constobj.d	19 May 2004 10:24:25 -0000	1.124
@@ -144,6 +144,8 @@
   LISPOBJ(type_weak_ht,"(MEMBER :BOTH :EITHER :VALUE :KEY NIL)")
 # for RECORD.D:
   LISPOBJ(constant_initfunction_code,".")
+# for WEAK.D:
+  LISPOBJ(type_weak_alist,"(MEMBER :BOTH :EITHER :VALUE :KEY)")
 # for SEQUENCE.D:
   # internal list of all defined sequence-types:
   LISPOBJ(seq_types,"NIL")
@@ -262,7 +264,9 @@
   #endif
   LISPOBJ(hs_realloc_instance,"EXT::FORWARD-POINTER-INSTANCE")
   LISPOBJ(hs_weakpointer,"EXT::WEAK-POINTER")
-  LISPOBJ(hs_weakkvt,"EXT::WEAK-KEY-VALUE-TABLE")
+  LISPOBJ(hs_weak_list,"EXT::WEAK-LIST")
+  LISPOBJ(hs_weak_alist,"EXT::WEAK-ALIST")
+  LISPOBJ(hs_weakmapping,"EXT::WEAK-MAPPING")
   LISPOBJ(hs_finalizer,"EXT::FINALIZER")
   #ifdef SOCKET_STREAMS
   LISPOBJ(hs_socket_server,"SOCKET::SOCKET-SERVER")
@@ -270,6 +274,13 @@
   #ifdef YET_ANOTHER_RECORD
   LISPOBJ(hs_yetanother,"SYS::YETANOTHER")
   #endif
+  LISPOBJ(hs_internal_weak_list,"SYS::INTERNAL-WEAK-LIST")
+  LISPOBJ(hs_weak_and_relation,"EXT::WEAK-AND-RELATION")
+  LISPOBJ(hs_weak_or_relation,"EXT::WEAK-OR-RELATION")
+  LISPOBJ(hs_weak_and_mapping,"EXT::WEAK-AND-MAPPING")
+  LISPOBJ(hs_weak_or_mapping,"EXT::WEAK-OR-MAPPING")
+  LISPOBJ(hs_internal_weak_alist,"SYS::INTERNAL-WEAK-ALIST")
+  LISPOBJ(hs_weakkvt,"EXT::WEAK-KEY-VALUE-TABLE")
   LISPOBJ(hs_system_function,"EXT::SYSTEM-FUNCTION")
   LISPOBJ(hs_bignum,"BIGNUM")
   LISPOBJ(hs_ratio,"RATIO")
@@ -573,6 +584,10 @@
   #endif
   LISPOBJ_S(printstring_weakpointer,"WEAK-POINTER")
   LISPOBJ_S(printstring_broken_weakpointer,"#<BROKEN WEAK-POINTER>")
+  LISPOBJ_S(printstring_weak_list,"WEAK-LIST")
+  LISPOBJ_S(printstring_weak_alist,"WEAK-ALIST")
+  LISPOBJ_S(printstring_weakmapping,"WEAK-MAPPING")
+  LISPOBJ_S(printstring_broken_weakmapping,"#<BROKEN WEAK-MAPPING>")
   LISPOBJ_S(printstring_finalizer,"#<FINALIZER>")
   #ifdef SOCKET_STREAMS
   LISPOBJ_S(printstring_socket_server,"SOCKET-SERVER")
@@ -580,6 +595,16 @@
   #ifdef YET_ANOTHER_RECORD
   LISPOBJ_S(printstring_yetanother,"YET-ANOTHER")
   #endif
+  LISPOBJ_S(printstring_internal_weak_list,"#<INTERNAL-WEAK-LIST>")
+  LISPOBJ_S(printstring_weak_and_relation,"WEAK-AND-RELATION")
+  LISPOBJ_S(printstring_broken_weak_and_relation,"#<BROKEN WEAK-AND-RELATION>")
+  LISPOBJ_S(printstring_weak_or_relation,"WEAK-OR-RELATION")
+  LISPOBJ_S(printstring_broken_weak_or_relation,"#<BROKEN WEAK-OR-RELATION>")
+  LISPOBJ_S(printstring_weak_and_mapping,"WEAK-AND-MAPPING")
+  LISPOBJ_S(printstring_broken_weak_and_mapping,"#<BROKEN WEAK-AND-MAPPING>")
+  LISPOBJ_S(printstring_weak_or_mapping,"WEAK-OR-MAPPING")
+  LISPOBJ_S(printstring_broken_weak_or_mapping,"#<BROKEN WEAK-OR-MAPPING>")
+  LISPOBJ_S(printstring_internal_weak_alist,"#<INTERNAL-WEAK-ALIST>")
   LISPOBJ_S(printstring_closure,"CLOSURE")
   LISPOBJ_S(printstring_generic_function,"GENERIC-FUNCTION")
   LISPOBJ_S(printstring_compiled_closure,"COMPILED-CLOSURE")

Index: constsym.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/constsym.d,v
retrieving revision 1.237
retrieving revision 1.238
diff -u -d -r1.237 -r1.238
--- constsym.d	11 May 2004 10:27:56 -0000	1.237
+++ constsym.d	19 May 2004 10:24:29 -0000	1.238
@@ -748,10 +748,6 @@
 LISPSYM(function_macro_p,"FUNCTION-MACRO-P",system)
 LISPSYM(function_macro_function,"FUNCTION-MACRO-FUNCTION",system)
 LISPSYM(function_macro_expander,"FUNCTION-MACRO-EXPANDER",system)
-LISPSYM(make_weak_pointer,"MAKE-WEAK-POINTER",ext)
-LISPSYM(weak_pointer_p,"WEAK-POINTER-P",ext)
-LISPSYM(weak_pointer_value,"WEAK-POINTER-VALUE",ext)
-LISPSYM(set_weak_pointer_value,"%SET-WEAK-POINTER-VALUE",system)
 LISPSYM(finalize,"FINALIZE",ext)
 LISPSYM(structure_object_p,"STRUCTURE-OBJECT-P",clos)
 LISPSYM(std_instance_p,"STD-INSTANCE-P",clos)
@@ -768,6 +764,45 @@
 LISPSYM(pinitialize_instance,"%INITIALIZE-INSTANCE",clos)
 LISPSYM(pmake_instance,"%MAKE-INSTANCE",clos)
 LISPSYM(pchange_class,"%CHANGE-CLASS",clos)
+/* ---------- WEAK ---------- */
+LISPSYM(make_weak_pointer,"MAKE-WEAK-POINTER",ext)
+LISPSYM(weak_pointer_p,"WEAK-POINTER-P",ext)
+LISPSYM(weak_pointer_value,"WEAK-POINTER-VALUE",ext)
+LISPSYM(set_weak_pointer_value,"(SETF WEAK-POINTER-VALUE)",system)
+LISPSYM(make_weak_list,"MAKE-WEAK-LIST",ext)
+LISPSYM(weak_list_p,"WEAK-LIST-P",ext)
+LISPSYM(weak_list_list,"WEAK-LIST-LIST",ext)
+LISPSYM(set_weak_list_list,"(SETF WEAK-LIST-LIST)",system)
+LISPSYM(make_weak_and_relation,"MAKE-WEAK-AND-RELATION",ext)
+LISPSYM(weak_and_relation_p,"WEAK-AND-RELATION-P",ext)
+LISPSYM(weak_and_relation_list,"WEAK-AND-RELATION-LIST",ext)
+LISPSYM(make_weak_or_relation,"MAKE-WEAK-OR-RELATION",ext)
+LISPSYM(weak_or_relation_p,"WEAK-OR-RELATION-P",ext)
+LISPSYM(weak_or_relation_list,"WEAK-OR-RELATION-LIST",ext)
+LISPSYM(make_weak_mapping,"MAKE-WEAK-MAPPING",ext)
+LISPSYM(weak_mapping_p,"WEAK-MAPPING-P",ext)
+LISPSYM(weak_mapping_pair,"WEAK-MAPPING-PAIR",ext)
+LISPSYM(weak_mapping_value,"WEAK-MAPPING-VALUE",ext)
+LISPSYM(set_weak_mapping_value,"(SETF WEAK-MAPPING-VALUE)",system)
+LISPSYM(make_weak_and_mapping,"MAKE-WEAK-AND-MAPPING",ext)
+LISPSYM(weak_and_mapping_p,"WEAK-AND-MAPPING-P",ext)
+LISPSYM(weak_and_mapping_pair,"WEAK-AND-MAPPING-PAIR",ext)
+LISPSYM(weak_and_mapping_value,"WEAK-AND-MAPPING-VALUE",ext)
+LISPSYM(set_weak_and_mapping_value,"(SETF WEAK-AND-MAPPING-VALUE)",system)
+LISPSYM(make_weak_or_mapping,"MAKE-WEAK-OR-MAPPING",ext)
+LISPSYM(weak_or_mapping_p,"WEAK-OR-MAPPING-P",ext)
+LISPSYM(weak_or_mapping_pair,"WEAK-OR-MAPPING-PAIR",ext)
+LISPSYM(weak_or_mapping_value,"WEAK-OR-MAPPING-VALUE",ext)
+LISPSYM(set_weak_or_mapping_value,"(SETF WEAK-OR-MAPPING-VALUE)",system)
+LISPSYM(make_weak_alist,"MAKE-WEAK-ALIST",ext)
+LISPSYM(weak_alist_p,"WEAK-ALIST-P",ext)
+LISPSYM(weak_alist_type,"WEAK-ALIST-TYPE",ext)
+LISPSYM(weak_alist_contents,"WEAK-ALIST-CONTENTS",ext)
+LISPSYM(set_weak_alist_contents,"(SETF WEAK-ALIST-CONTENTS)",system)
+LISPSYM(weak_alist_assoc,"WEAK-ALIST-ASSOC",ext)
+LISPSYM(weak_alist_rassoc,"WEAK-ALIST-RASSOC",ext)
+LISPSYM(weak_alist_value,"WEAK-ALIST-VALUE",ext)
+LISPSYM(set_weak_alist_value,"(SETF WEAK-ALIST-VALUE)",system)
 /* ---------- SEQUENCE ---------- */
 LISPSYM(sequencep,"SEQUENCEP",system)
 LISPSYM(defseq,"%DEFSEQ",system)
@@ -1605,11 +1640,20 @@
 LISPSYM(foreign_function,"FOREIGN-FUNCTION",ffi) /* type in PREDTYPE */
 #endif
 LISPSYM(weak_pointer,"WEAK-POINTER",ext) /* type in PREDTYPE */
-LISPSYM(weak_kvtable,"WEAK-KEY-VALUE-TABLE",ext) /* type in PREDTYPE */
+LISPSYM(weak_list,"WEAK-LIST",ext) /* type in PREDTYPE */
+LISPSYM(weak_alist,"WEAK-ALIST",ext) /* type in PREDTYPE */
+LISPSYM(weak_mapping,"WEAK-MAPPING",ext) /* type in PREDTYPE */
 LISPSYM(finalizer,"FINALIZER",ext) /* type in PREDTYPE */
 #ifdef YET_ANOTHER_RECORD
 LISPSYM(yet_another,"YET-ANOTHER",ext) /* type in PREDTYPE */
 #endif
+LISPSYM(internal_weak_list,"INTERNAL-WEAK-LIST",system) /* type in PREDTYPE */
+LISPSYM(weak_and_relation,"WEAK-AND-RELATION",ext) /* type in PREDTYPE */
+LISPSYM(weak_or_relation,"WEAK-OR-RELATION",ext) /* type in PREDTYPE */
+LISPSYM(weak_and_mapping,"WEAK-AND-MAPPING",ext) /* type in PREDTYPE */
+LISPSYM(weak_or_mapping,"WEAK-OR-MAPPING",ext) /* type in PREDTYPE */
+LISPSYM(internal_weak_alist,"INTERNAL-WEAK-ALIST",system) /* type in PREDTYPE */
+LISPSYM(weak_kvtable,"WEAK-KEY-VALUE-TABLE",ext) /* type in PREDTYPE */
 LISPSYM(compiled_function,"COMPILED-FUNCTION",lisp) /* type in PREDTYPE */
 LISPSYM(frame_pointer,"FRAME-POINTER",system) /* type in PREDTYPE */
 LISPSYM(read_label,"READ-LABEL",system) /* type in PREDTYPE */

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.3041
retrieving revision 1.3042
diff -u -d -r1.3041 -r1.3042
--- ChangeLog	19 May 2004 10:12:28 -0000	1.3041
+++ ChangeLog	19 May 2004 10:24:29 -0000	1.3042
@@ -1,3 +1,67 @@
+2004-05-08  Bruno Haible  <br...@cl...>
+
+	New data types containing weak references.
+	* lispbibl.d (Rectype_MutableWeakList, Rectype_MutableWeakAlist,
+	Rectype_Weakmapping, Rectype_WeakList, Rectype_WeakAnd, Rectype_WeakOr,
+	Rectype_WeakAndMapping, Rectype_WeakOrMapping, Rectype_WeakAlist_Key,
+	Rectype_WeakAlist_Value, Rectype_WeakAlist_Either,
+	Rectype_WeakAlist_Both): New enum values.
+	(WeakList, MutableWeakList, WeakAnd, WeakOr, Weakmapping,
+	WeakAndMapping, WeakOrMapping, WeakAlist, MutableWeakAlist): New types.
+	(mutableweaklist_length, weakmapping_length, mutableweakalist_length):
+	New macros.
+	(TheMutableWeakList, TheWeakList, TheWeakAnd, TheWeakOr,
+	TheWeakmapping, TheWeakAndMapping, TheWeakOrMapping,
+	TheMutableWeakAlist, TheWeakAlist): New macros.
+	(SXrecord_nonweak_length, Lrecord_nonweak_length): Return 0 also for
+	the new weak data types.
+	(activate_weak): New declaration.
+	* spvw_gcmark.d: New file, extracted from spvw_garcol.d.
+	(gc_mark): Handle Rectype_WeakList, Rectype_WeakAnd, Rectype_WeakOr,
+	Rectype_WeakAndMapping, Rectype_WeakOrMapping, Rectype_WeakAlist_* as
+	Lrecords.
+	* spvw_weak.d: New file.
+	* spvw_garcol.d (gc_mark): Move away to spvw_gcmark.d. Include
+	spvw_gcmark.c, spvw_weak.c.
+	(gar_col_normal): Invoke gc_mark_weakpointers and clean_weakpointers.
+	Remove old handling of O(all_weakpointers).
+	* spvw_circ.d (get_circ_mark, get_circ_unmark): Handle
+	Rectype_MutableWeakList, Rectype_MutableWeakAlist, Rectype_Weakmapping,
+	Rectype_WeakList, Rectype_WeakAnd, Rectype_WeakOr,
+	Rectype_WeakAndMapping, Rectype_WeakOrMapping, Rectype_WeakAlist_*.
+	* spvw.d (main): Initialize markwatchset.
+	* spvw_memfile.d (loadmem_from_handle): Likewise.
+	* weak.d: New file.
+	* record.d (mk_weakpointer, MAKE-WEAK-POINTER, WEAK-POINTER-P,
+	check_weakpointer_replacement, check_weakpointer, WEAK-POINTER-VALUE,
+	SETF WEAK-POINTER-VALUE): Move to weak.d.
+	* io.d (pr_orecord): Handle Rectype_MutableWeakList,
+	Rectype_MutableWeakAlist, Rectype_Weakmapping, Rectype_WeakList,
+	Rectype_WeakAnd, Rectype_WeakOr, Rectype_WeakAndMapping,
+	Rectype_WeakOrMapping, Rectype_WeakAlist_*.
+	* predtype.d (TYPE-OF, CLASS-OF): Handle Rectype_MutableWeakList,
+	Rectype_MutableWeakAlist, Rectype_Weakmapping, Rectype_WeakList,
+	Rectype_WeakAnd, Rectype_WeakOr, Rectype_WeakAndMapping,
+	Rectype_WeakOrMapping, Rectype_WeakAlist_*.
+	(enum_hs_weak_list, enum_hs_weak_alist, enum_hs_weakmapping,
+	enum_hs_internal_weak_list, enum_hs_weak_and_relation,
+	enum_hs_weak_or_relation, enum_hs_weak_and_mapping,
+	enum_hs_weak_or_mapping, enum_hs_internal_weak_alist): New enum values.
+	(heap_statistics_mapper): Handle Rectype_MutableWeakList,
+	Rectype_MutableWeakAlist, Rectype_Weakmapping, Rectype_WeakList,
+	Rectype_WeakAnd, Rectype_WeakOr, Rectype_WeakAndMapping,
+	Rectype_WeakOrMapping, Rectype_WeakAlist_*.
+	* init.lisp: Export symbols relating to weak-list, weak-and-relation,
+	weak-or-relation, weak-mapping, weak-and-mapping, weak-or-mapping,
+	weak-alist from EXT.
+	* places.lisp (setf weak-pointer-value): Define as a function alias.
+	(setf weak-list-list, setf weak-mapping-value,
+	setf weak-and-mapping-value, setf weak-or-mapping-value,
+	setf weak-alist-contents, setf weak-alist-value): New aliases.
+	* makemake.in (CPARTS): Add weak.
+	(SPVW_INCLUDES): Add spvw_gcmark, spvw_weak.
+	* po/Makefile.devel (DSOURCES): Add spvw_gcmark, spvw_weak, weak.
+
 2004-04-25  Bruno Haible  <br...@cl...>
 
 	Make it possible to attach a documentation string to classes without

Index: makemake.in
===================================================================
RCS file: /cvsroot/clisp/clisp/src/makemake.in,v
retrieving revision 1.441
retrieving revision 1.442
diff -u -d -r1.441 -r1.442
--- makemake.in	12 May 2004 14:35:08 -0000	1.441
+++ makemake.in	19 May 2004 10:24:27 -0000	1.442
@@ -1267,7 +1267,7 @@
   CPARTS=$CPARTS' socket'
 fi
 CPARTS=$CPARTS' io'
-CPARTS=$CPARTS' array hashtabl list package record sequence'
+CPARTS=$CPARTS' array hashtabl list package record weak sequence'
 CPARTS=$CPARTS' charstrg debug error misc time predtype symbol lisparit i18n'
 if [ $TSYS = master -o -n "$with_dynamic_ffi" ] ; then
   CPARTS=$CPARTS' foreign'
@@ -1305,7 +1305,7 @@
 
 OTHER_INCLUDES=' constpack avl sort subrkw bytecode'
 
-SPVW_INCLUDES=' spvw_module spvw_debug spvw_alloca spvw_mmap spvw_multimap spvw_singlemap spvw_page spvw_heap spvw_global spvw_gcstat spvw_space spvw_mark spvw_objsize spvw_update spvw_fault spvw_sigsegv spvw_sigcld spvw_sigpipe spvw_sigint spvw_sigwinch spvw_garcol spvw_genera1 spvw_genera2 spvw_genera3 spvw_allocate spvw_typealloc spvw_circ spvw_walk spvw_ctype spvw_language spvw_memfile'
+SPVW_INCLUDES=' spvw_module spvw_debug spvw_alloca spvw_mmap spvw_multimap spvw_singlemap spvw_page spvw_heap spvw_global spvw_gcstat spvw_space spvw_mark spvw_objsize spvw_update spvw_fault spvw_sigsegv spvw_sigcld spvw_sigpipe spvw_sigint spvw_sigwinch spvw_garcol spvw_genera1 spvw_gcmark spvw_genera2 spvw_weak spvw_genera3 spvw_allocate spvw_typealloc spvw_circ spvw_walk spvw_ctype spvw_language spvw_memfile'
 
 UNICODE_INCLUDES=''
 UNICODE_EXTRA=''

Index: record.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/record.d,v
retrieving revision 1.86
retrieving revision 1.87
diff -u -d -r1.86 -r1.87
--- record.d	18 May 2004 14:25:13 -0000	1.86
+++ record.d	19 May 2004 10:24:28 -0000	1.87
@@ -668,102 +668,6 @@
 }
 
 /* ===========================================================================
- * Weak-Pointer:
- We keep all WEAK-POINTER objects on the O(all_weakpointers) list unless the
- value that the WEAK-POINTER points to is GC-invariant.  This requires that
- we add the WEAK-POINTER to O(all_weakpointers) when the value is changed
- to a non-GC-invariant one, and GC removes the WEAK-POINTERs with GC-invariant
- values from O(all_weakpointers).
- The alternative it to keep all the WEAK-POINTERs on the list.
- We do not do that because we assume that the lifetime of a WEAK-POINTER is
- relatively high compared to GC timeout, so there will be several GCs while
- the given WEAK-POINTER is alive (why would one use a WEAK-POINTER otherwise?)
- and therefore it is worth the effort to keep O(all_weakpointers) as short
- as possible. */
-
-/* UP: make a weakpointer to popSTACK()
- can trigger GC, modifies STACK */
-local inline object mk_weakpointer () {
-  var object wp = allocate_xrecord(0,Rectype_Weakpointer,weakpointer_length,0,
-                                   orecord_type);
-  var object obj = popSTACK();
-  TheWeakpointer(wp)->wp_value = obj;
-  if (gcinvariant_object_p(obj)) {
-    TheWeakpointer(wp)->wp_cdr = unbound; /* a GC-invariant dummy */
-  } else {
-    TheWeakpointer(wp)->wp_cdr = O(all_weakpointers);
-    O(all_weakpointers) = wp;
-  }
-  return wp;
-}
-
-/* (MAKE-WEAK-POINTER value)
-   returns a fresh weak pointer referring to value. */
-LISPFUN(make_weak_pointer,seclass_no_se,1,0,norest,nokey,0,NIL) {
-  VALUES1(mk_weakpointer());
-}
-
-/* (WEAK-POINTER-P object)
-   returns true if the object is of type WEAK-POINTER. */
-LISPFUNNF(weak_pointer_p,1) {
-  var object obj = popSTACK();
-  VALUES_IF(weakpointerp(obj));
-}
-
-/* check_weakpointer_replacement(obj)
- > obj: not a weak-pointer
- < result: a weak-pointer, a replacement
- can trigger GC */
-local object check_weakpointer_replacement (object obj) {
-  do {
-    pushSTACK(NIL); /* no PLACE */
-    pushSTACK(obj); /* TYPE-ERROR slot EXPECTED-TYPE */
-    pushSTACK(S(weak_pointer)); /* TYPE-ERROR slot EXPECTED-TYPE */
-    pushSTACK(S(weak_pointer)); pushSTACK(obj);
-    pushSTACK(TheSubr(subr_self)->name); /* function name */
-    check_value(type_error,GETTEXT("~S: ~S is not a ~S"));
-    obj = value1;
-  } while (!weakpointerp(obj));
-  return obj;
-}
-/* check_weakpointer(obj)
- > obj: an object
- < result: a weak-pointer, either the same as obj or a replacement
- can trigger GC */
-local inline object check_weakpointer (object obj) {
-  if (!weakpointerp(obj)) 
-    obj = check_weakpointer_replacement(obj);
-  return obj;
-}
-
-/* (WEAK-POINTER-VALUE weak-pointer) returns two values: The original value
- and T, if the value has not yet been garbage collected, else NIL and NIL. */
-LISPFUNNR(weak_pointer_value,1) {
-  var object wp = check_weakpointer(popSTACK());
-  if (weakpointer_broken_p(wp))
-    VALUES2(NIL,NIL);
-  else
-    VALUES2(TheWeakpointer(wp)->wp_value, T);
-}
-
-LISPFUNN(set_weak_pointer_value,2)
-{ /* (SETF (WEAK-POINTER-VALUE wp) value) */
-  var object wp = check_weakpointer(STACK_1);
-  var object value = STACK_0; skipSTACK(2);
-  if (!gcinvariant_object_p(value)) {
-    /* make sure wp is on the O(all_weakpointers) list */
-    if (!boundp(TheWeakpointer(wp)->wp_cdr)) { /* put wp on the list */
-      TheWeakpointer(wp)->wp_cdr = O(all_weakpointers);
-      O(all_weakpointers) = wp;
-    }
-  }
-  /* If value is gc-invariant, we leave wp where it is. For removing it
-     from O(all_weakpointers), this list ought to be a doubly-linked list.
-     Anyway, the next GC will remove it from the list. */
-  VALUES1(TheWeakpointer(wp)->wp_value = value);
-}
-
-/* ===========================================================================
  * Finalizer: */
 
 /* (FINALIZE object function &optional alive)

Index: predtype.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/predtype.d,v
retrieving revision 1.103
retrieving revision 1.104
diff -u -d -r1.103 -r1.104
--- predtype.d	18 May 2004 14:37:04 -0000	1.103
+++ predtype.d	19 May 2004 10:24:27 -0000	1.104
@@ -1648,8 +1648,12 @@
        #endif
         case Rectype_Weakpointer: /* Weak-Pointer */
           value1 = S(weak_pointer); break;
-        case Rectype_WeakKVT: /* Weak-Key-Value-Table */
-          value1 = S(weak_kvtable); break;
+        case Rectype_MutableWeakList: /* mutable Weak-List */
+          value1 = S(weak_list); break;
+        case Rectype_MutableWeakAlist: /* mutable Weak-Alist */
+          value1 = S(weak_alist); break;
+        case Rectype_Weakmapping: /* Weak-Mapping */
+          value1 = S(weak_mapping); break;
         case Rectype_Finalizer: /* Finalizer (should not occur) */
           value1 = S(finalizer); break;
        #ifdef SOCKET_STREAMS
@@ -1660,6 +1664,23 @@
         case Rectype_Yetanother: /* Yetanother -> YET-ANOTHER */
           value1 = S(yet_another); break;
        #endif
+        case Rectype_WeakList: /* Weak-List */
+          value1 = S(internal_weak_list); break;
+        case Rectype_WeakAnd: /* Weak-And-Relation */
+          value1 = S(weak_and_relation); break;
+        case Rectype_WeakOr: /* Weak-Or-Relation */
+          value1 = S(weak_or_relation); break;
+        case Rectype_WeakAndMapping: /* Weak-And-Mapping */
+          value1 = S(weak_and_mapping); break;
+        case Rectype_WeakOrMapping: /* Weak-Or-Mapping */
+          value1 = S(weak_or_mapping); break;
+        case Rectype_WeakAlist_Key:
+        case Rectype_WeakAlist_Value:
+        case Rectype_WeakAlist_Either:
+        case Rectype_WeakAlist_Both: /* Weak-Alist */
+          value1 = S(internal_weak_alist); break;
+        case Rectype_WeakKVT: /* Weak-Key-Value-Table */
+          value1 = S(weak_kvtable); break;
         default: goto unknown;
       }
       break;
@@ -1906,7 +1927,9 @@
         case Rectype_Fvariable: /* Foreign-Variable -> <t> */
        #endif
         case Rectype_Weakpointer: /* Weak-Pointer -> <t> */
-        case Rectype_WeakKVT: /* Weak-Key-Value-Table -> <t> */
+        case Rectype_MutableWeakList: /* mutable Weak-List -> <t> */
+        case Rectype_MutableWeakAlist: /* mutable Weak-Alist -> <t> */
+        case Rectype_Weakmapping: /* Weak-Mapping -> <t> */
         case Rectype_Finalizer: /* Finalizer -> <t> */
        #ifdef SOCKET_STREAMS
         case Rectype_Socket_Server: /* Socket-Server -> <t> */
@@ -1920,6 +1943,17 @@
         case Rectype_Yetanother: /* Yetanother -> <t> */
           value1 = O(class_t); break;
        #endif
+        case Rectype_WeakList: /* Weak-List -> <t> */
+        case Rectype_WeakAnd: /* Weak-And-Relation -> <t> */
+        case Rectype_WeakOr: /* Weak-Or-Relation -> <t> */
+        case Rectype_WeakAndMapping: /* Weak-And-Mapping -> <t> */
+        case Rectype_WeakOrMapping: /* Weak-Or-Mapping -> <t> */
+        case Rectype_WeakAlist_Key: /* Weak-Alist -> <t> */
+        case Rectype_WeakAlist_Value: /* Weak-Alist -> <t> */
+        case Rectype_WeakAlist_Either: /* Weak-Alist -> <t> */
+        case Rectype_WeakAlist_Both: /* Weak-Alist -> <t> */
+        case Rectype_WeakKVT: /* Weak-Key-Value-Table -> <t> */
+          value1 = O(class_t); break;
         default: goto unknown;
       }
       break;
@@ -2519,7 +2553,9 @@
  #endif
   enum_hs_realloc_instance,
   enum_hs_weakpointer,
-  enum_hs_weakkvt,
+  enum_hs_weak_list,
+  enum_hs_weak_alist,
+  enum_hs_weakmapping,
   enum_hs_finalizer,
  #ifdef SOCKET_STREAMS
   enum_hs_socket_server,
@@ -2527,6 +2563,13 @@
  #ifdef YET_ANOTHER_RECORD
   enum_hs_yetanother,
  #endif
+  enum_hs_internal_weak_list,
+  enum_hs_weak_and_relation,
+  enum_hs_weak_or_relation,
+  enum_hs_weak_and_mapping,
+  enum_hs_weak_or_mapping,
+  enum_hs_internal_weak_alist,
+  enum_hs_weakkvt,
   enum_hs_system_function,
   enum_hs_bignum,
   enum_hs_ratio,
@@ -2851,9 +2894,12 @@
        #endif
         case Rectype_Weakpointer: /* Weak-Pointer */
           pighole = &locals->builtins[(int)enum_hs_weakpointer]; break;
-        case Rectype_WeakKVT: /* weak-key-value-table */
-          pighole = &locals->builtins[(int)enum_hs_weakkvt];
-          break;
+        case Rectype_MutableWeakList: /* mutable Weak-List */
+          pighole = &locals->builtins[(int)enum_hs_weak_list]; break;
+        case Rectype_MutableWeakAlist: /* mutable Weak-Alist */
+          pighole = &locals->builtins[(int)enum_hs_weak_alist]; break;
+        case Rectype_Weakmapping: /* Weak-Mapping */
+          pighole = &locals->builtins[(int)enum_hs_weakmapping]; break;
         case Rectype_Finalizer: /* Finalizer */
           pighole = &locals->builtins[(int)enum_hs_finalizer]; break;
        #ifdef SOCKET_STREAMS
@@ -2864,6 +2910,24 @@
         case Rectype_Yetanother: /* Yetanother */
           pighole = &locals->builtins[(int)enum_hs_yetanother]; break;
        #endif
+        case Rectype_WeakList: /* Weak-List */
+          pighole = &locals->builtins[(int)enum_hs_internal_weak_list]; break;
+        case Rectype_WeakAnd: /* Weak-And-Relation */
+          pighole = &locals->builtins[(int)enum_hs_weak_and_relation]; break;
+        case Rectype_WeakOr: /* Weak-Or-Relation */
+          pighole = &locals->builtins[(int)enum_hs_weak_or_relation]; break;
+        case Rectype_WeakAndMapping: /* Weak-And-Mapping */
+          pighole = &locals->builtins[(int)enum_hs_weak_and_mapping]; break;
+        case Rectype_WeakOrMapping: /* Weak-Or-Mapping */
+          pighole = &locals->builtins[(int)enum_hs_weak_or_mapping]; break;
+        case Rectype_WeakAlist_Key:
+        case Rectype_WeakAlist_Value:
+        case Rectype_WeakAlist_Either:
+        case Rectype_WeakAlist_Both: /* Weak-Alist */
+          pighole = &locals->builtins[(int)enum_hs_internal_weak_alist]; break;
+        case Rectype_WeakKVT: /* Weak-Key-Value-Table */
+          pighole = &locals->builtins[(int)enum_hs_weakkvt];
+          break;
         default:
           pighole = &locals->builtins[(int)enum_hs_t]; break;
       }

Index: subr.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/subr.d,v
retrieving revision 1.169
retrieving revision 1.170
diff -u -d -r1.169 -r1.170
--- subr.d	11 May 2004 10:27:56 -0000	1.169
+++ subr.d	19 May 2004 10:24:26 -0000	1.170
@@ -826,10 +826,6 @@
 LISPFUNN(function_macro_p,1)
 LISPFUNN(function_macro_function,1)
 LISPFUNN(function_macro_expander,1)
-LISPFUN(make_weak_pointer,seclass_no_se,1,0,norest,nokey,0,NIL)
-LISPFUNNF(weak_pointer_p,1)
-LISPFUNNR(weak_pointer_value,1)
-LISPFUNN(set_weak_pointer_value,2)
 LISPFUN(finalize,seclass_default,2,1,norest,nokey,0,NIL)
 LISPFUNNF(structure_object_p,1)
 LISPFUNNF(std_instance_p,1)
@@ -846,6 +842,50 @@
 LISPFUN(pinitialize_instance,seclass_default,1,0,rest,nokey,0,NIL)
 LISPFUN(pmake_instance,seclass_default,1,0,rest,nokey,0,NIL)
 LISPFUNN(pchange_class,2)
+/* ---------- WEAK ---------- */
+LISPFUN(make_weak_pointer,seclass_no_se,1,0,norest,nokey,0,NIL)
+LISPFUNNF(weak_pointer_p,1)
+LISPFUNNR(weak_pointer_value,1)
+LISPFUNN(set_weak_pointer_value,2)
+LISPFUNN(make_weak_list,1)
+LISPFUNNF(weak_list_p,1)
+LISPFUNNR(weak_list_list,1)
+LISPFUNN(set_weak_list_list,2)
+LISPFUNN(make_weak_and_relation,1)
+LISPFUNNF(weak_and_relation_p,1)
+LISPFUNNR(weak_and_relation_list,1)
+LISPFUNN(make_weak_or_relation,1)
+LISPFUNNF(weak_or_relation_p,1)
+LISPFUNNR(weak_or_relation_list,1)
+LISPFUNN(make_weak_mapping,2)
+LISPFUNNF(weak_mapping_p,1)
+LISPFUNNR(weak_mapping_pair,1)
+LISPFUNNR(weak_mapping_value,1)
+LISPFUNN(set_weak_mapping_value,2)
+LISPFUNN(make_weak_and_mapping,2)
+LISPFUNNF(weak_and_mapping_p,1)
+LISPFUNNR(weak_and_mapping_pair,1)
+LISPFUNNR(weak_and_mapping_value,1)
+LISPFUNN(set_weak_and_mapping_value,2)
+LISPFUNN(make_weak_or_mapping,2)
+LISPFUNNF(weak_or_mapping_p,1)
+LISPFUNNR(weak_or_mapping_pair,1)
+LISPFUNNR(weak_or_mapping_value,1)
+LISPFUNN(set_weak_or_mapping_value,2)
+LISPFUN(make_weak_alist,seclass_read,0,0,norest,key,2,
+        (kw(type),kw(initial_contents)) )
+LISPFUNNF(weak_alist_p,1)
+LISPFUNNR(weak_alist_type,1)
+LISPFUNNR(weak_alist_contents,1)
+LISPFUNN(set_weak_alist_contents,2)
+LISPFUN(weak_alist_assoc,seclass_default,2,0,norest,key,3,
+        (kw(test),kw(test_not),kw(key)) )
+LISPFUN(weak_alist_rassoc,seclass_default,2,0,norest,key,3,
+        (kw(test),kw(test_not),kw(key)) )
+LISPFUN(weak_alist_value,seclass_default,2,0,norest,key,2,
+        (kw(test),kw(test_not)) )
+LISPFUN(set_weak_alist_value,seclass_default,3,0,norest,key,2,
+        (kw(test),kw(test_not)) )
 /* ---------- SEQUENCE ---------- */
 LISPFUNNR(sequencep,1)
 LISPFUNN(defseq,1)

Index: io.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/io.d,v
retrieving revision 1.222
retrieving revision 1.223
diff -u -d -r1.222 -r1.223
--- io.d	18 May 2004 14:30:57 -0000	1.222
+++ io.d	19 May 2004 10:24:24 -0000	1.223
@@ -8960,8 +8960,171 @@
       } else
         write_sstring_case(stream_,O(printstring_broken_weakpointer));
       break;
-    case Rectype_WeakKVT: # weak key-value table
-      pr_weakkvt(stream_,obj);
+    case Rectype_MutableWeakList: # #<WEAK-LIST (element1 ...)>
+      CHECK_PRINT_READABLY(obj);
+      LEVEL_CHECK;
+      {
+        pushSTACK(TheMutableWeakList(obj)->mwl_list); # save list
+        var gcv_object_t* wl_ = &STACK_0; # and memorize, where it is
+        var uintL wl_length = Lrecord_length(*wl_)-2;
+        UNREADABLE_START;
+        var uintL length_limit = get_print_length(); # *PRINT-LENGTH*
+        JUSTIFY_LAST(length_limit==0);
+        write_sstring_case(stream_,O(printstring_weak_list)); # "WEAK-LIST"
+        {
+          # check for attaining of *PRINT-LENGTH*:
+          if (0 >= length_limit) goto weak_list_end;
+          JUSTIFY_SPACE; # print Space
+          JUSTIFY_LAST(true);
+          # Now the list (element1 ...):
+          LEVEL_CHECK;
+          var uintL length = 0; # previous length := 0
+          KLAMMER_AUF; # '('
+          INDENT_START(get_indent_lists()); # indent by 1 character, because of '('
+          JUSTIFY_START(1);
+          # test for attaining of *PRINT-LENGTH* :
+          CHECK_LENGTH_LIMIT(length_limit==0,goto weak_list_end);
+          # test for attaining of *PRINT-LINES* :
+          CHECK_LINES_LIMIT(goto weak_list_end);
+          var uintL i1;
+          for (i1 = 0; i1 < wl_length; i1++)
+            if (!eq(TheWeakList(*wl_)->wl_elements[i1],unbound))
+              break;
+          if (i1 < wl_length) {
+            pushSTACK(TheWeakList(*wl_)->wl_elements[i1]);
+            loop {
+              var uintL i2;
+              for (i2 = i1+1; i2 < wl_length; i2++)
+                if (!eq(TheWeakList(*wl_)->wl_elements[i2],unbound))
+                  break;
+              JUSTIFY_LAST(i2 == wl_length);
+              var object element = STACK_0; # = TheWeakList(*wl_)->wl_elements[i1]
+              if (i2 < wl_length)
+                STACK_0 = TheWeakList(*wl_)->wl_elements[i2];
+              prin_object(stream_,element);
+              length++; # increment length
+              if (i2 == wl_length)
+                break;
+              JUSTIFY_SPACE; # print one Space
+              # check for attaining *PRINT-LENGTH* :
+              CHECK_LENGTH_LIMIT(length >= length_limit,break);
+              # check for attaining *PRINT-LINES* :
+              CHECK_LINES_LIMIT(break);
+              i1 = i2;
+            }
+            skipSTACK(1);
+          }
+          JUSTIFY_END_FILL;
+          INDENT_END;
+          KLAMMER_ZU;
+          LEVEL_END;
+        }
+      weak_list_end:
+        JUSTIFY_END_FILL;
+        UNREADABLE_END;
+        skipSTACK(1);
+      }
+      LEVEL_END;
+      break;
+    case Rectype_MutableWeakAlist: # #<WEAK-ALIST (pair1 ...)>
+      CHECK_PRINT_READABLY(obj);
+      LEVEL_CHECK;
+      {
+        pushSTACK(TheMutableWeakAlist(obj)->mwal_list); # save list
+        var gcv_object_t* wal_ = &STACK_0; # and memorize, where it is
+        var uintL wal_length = (Lrecord_length(*wal_)-2)/2;
+        UNREADABLE_START;
+        var uintL length_limit = get_print_length(); # *PRINT-LENGTH*
+        JUSTIFY_LAST(length_limit==0);
+        write_sstring_case(stream_,O(printstring_weak_alist)); # "WEAK-ALIST"
+        {
+          # check for attaining of *PRINT-LENGTH*:
+          if (0 >= length_limit) goto weak_alist_end;
+          JUSTIFY_SPACE; # print Space
+          JUSTIFY_LAST(true);
+          # Now the list (pair1 ...):
+          LEVEL_CHECK;
+          var uintL length = 0; # previous length := 0
+          KLAMMER_AUF; # '('
+          INDENT_START(get_indent_lists()); # indent by 1 character, because of '('
+          JUSTIFY_START(1);
+          # test for attaining of *PRINT-LENGTH* :
+          CHECK_LENGTH_LIMIT(length_limit==0,goto weak_alist_end);
+          # test for attaining of *PRINT-LINES* :
+          CHECK_LINES_LIMIT(goto weak_alist_end);
+          var uintL i1;
+          for (i1 = 0; i1 < wal_length; i1++)
+            if (!eq(TheWeakAlist(*wal_)->wal_data[2*i1+0],unbound))
+              break;
+          if (i1 < wal_length) {
+            pushSTACK(TheWeakAlist(*wal_)->wal_data[2*i1+0]);
+            pushSTACK(TheWeakAlist(*wal_)->wal_data[2*i1+1]);
+            loop {
+              var uintL i2;
+              for (i2 = i1+1; i2 < wal_length; i2++)
+                if (!eq(TheWeakAlist(*wal_)->wal_data[2*i2+0],unbound))
+                  break;
+              JUSTIFY_LAST(i2 == wal_length);
+              var object key = STACK_1; # = TheWeakAlist(*wal_)->wal_data[2*i1+0]
+              var object value = STACK_0; # = TheWeakAlist(*wal_)->wal_data[2*i1+1]
+              if (i2 < wal_length) {
+                STACK_1 = TheWeakAlist(*wal_)->wal_data[2*i2+0];
+                STACK_0 = TheWeakAlist(*wal_)->wal_data[2*i2+1];
+              }
+              pr_pair(stream_,key,value);
+              length++; # increment length
+              if (i2 == wal_length)
+                break;
+              JUSTIFY_SPACE; # print one Space
+              # check for attaining *PRINT-LENGTH* :
+              CHECK_LENGTH_LIMIT(length >= length_limit,break);
+              # check for attaining *PRINT-LINES* :
+              CHECK_LINES_LIMIT(break);
+              i1 = i2;
+            }
+            skipSTACK(2);
+          }
+          JUSTIFY_END_FILL;
+          INDENT_END;
+          KLAMMER_ZU;
+          LEVEL_END;
+        }
+      weak_alist_end:
+        JUSTIFY_END_FILL;
+        UNREADABLE_END;
+        skipSTACK(1);
+      }
+      LEVEL_END;
+      break;
+    case Rectype_Weakmapping: # #<WEAK-MAPPING (key . value)> or #<BROKEN WEAK-MAPPING>
+      CHECK_PRINT_READABLY(obj);
+      if (!eq(TheWeakmapping(obj)->wm_value,unbound)) {
+        LEVEL_CHECK;
+        {
+          pushSTACK(TheWeakmapping(obj)->wm_value); # save value
+          pushSTACK(TheWeakmapping(obj)->wm_key); # save key
+          var gcv_object_t* aux_ = &STACK_0; # and memorize, where they are
+          UNREADABLE_START;
+          var uintL length_limit = get_print_length(); # *PRINT-LENGTH*
+          JUSTIFY_LAST(length_limit==0);
+          write_sstring_case(stream_,O(printstring_weakmapping)); # "WEAK-MAPPING"
+          {
+            var uintL length = 0; # previous length := 0
+            # check for attaining of *PRINT-LENGTH*:
+            if (length >= length_limit) goto weakmapping_end;
+            JUSTIFY_SPACE; # print Space
+            JUSTIFY_LAST(true);
+            pr_pair(stream_,*(aux_ STACKop 0),*(aux_ STACKop 1)); # output (key . value) pair
+            length++; # increase previous length
+          }
+        weakmapping_end:
+          JUSTIFY_END_FILL;
+          UNREADABLE_END;
+          skipSTACK(2);
+        }
+        LEVEL_END;
+      } else
+        write_sstring_case(stream_,O(printstring_broken_weakmapping));
       break;
     case Rectype_Finalizer: # #<FINALIZER>
       CHECK_PRINT_READABLY(obj);
@@ -9030,6 +9193,138 @@
       LEVEL_END;
       break;
 #endif
+    case Rectype_WeakList: # #<INTERNAL-WEAK-LIST>
+      CHECK_PRINT_READABLY(obj);
+      write_sstring_case(stream_,O(printstring_internal_weak_list));
+      break;
+    case Rectype_WeakAnd: # #<WEAK-AND-RELATION keys-list> or #<BROKEN WEAK-AND-RELATION>
+      CHECK_PRINT_READABLY(obj);
+      if (!eq(TheWeakAnd(obj)->war_keys_list,unbound)) {
+        LEVEL_CHECK;
+        {
+          pushSTACK(TheWeakAnd(obj)->war_keys_list); # save keys list
+          var gcv_object_t* keys_list_ = &STACK_0; # and memorize, where it is
+          UNREADABLE_START;
+          var uintL length_limit = get_print_length(); # *PRINT-LENGTH*
+          JUSTIFY_LAST(length_limit==0);
+          write_sstring_case(stream_,O(printstring_weak_and_relation)); # "WEAK-AND-RELATION"
+          {
+            var uintL length = 0; # previous length := 0
+            # check for attaining of *PRINT-LENGTH*:
+            if (length >= length_limit) goto weak_and_relation_end;
+            JUSTIFY_SPACE; # print Space
+            JUSTIFY_LAST(true);
+            prin_object(stream_,*keys_list_); # output keys-list
+            length++; # increase previous length
+          }
+        weak_and_relation_end:
+          JUSTIFY_END_FILL;
+          UNREADABLE_END;
+          skipSTACK(1);
+        }
+        LEVEL_END;
+      } else
+        write_sstring_case(stream_,O(printstring_broken_weak_and_relation));
+      break;
+    case Rectype_WeakOr: # #<WEAK-OR-RELATION keys-list> or #<BROKEN WEAK-OR-RELATION>
+      CHECK_PRINT_READABLY(obj);
+      if (!eq(TheWeakOr(obj)->wor_keys_list,unbound)) {
+        LEVEL_CHECK;
+        {
+          pushSTACK(TheWeakOr(obj)->wor_keys_list); # save keys list
+          var gcv_object_t* keys_list_ = &STACK_0; # and memorize, where it is
+          UNREADABLE_START;
+          var uintL length_limit = get_print_length(); # *PRINT-LENGTH*
+          JUSTIFY_LAST(length_limit==0);
+          write_sstring_case(stream_,O(printstring_weak_or_relation)); # "WEAK-OR-RELATION"
+          {
+            var uintL length = 0; # previous length := 0
+            # check for attaining of *PRINT-LENGTH*:
+            if (length >= length_limit) goto weak_or_relation_end;
+            JUSTIFY_SPACE; # print Space
+            JUSTIFY_LAST(true);
+            prin_object(stream_,*keys_list_); # output keys-list
+            length++; # increase previous length
+          }
+        weak_or_relation_end:
+          JUSTIFY_END_FILL;
+          UNREADABLE_END;
+          skipSTACK(1);
+        }
+        LEVEL_END;
+      } else
+        write_sstring_case(stream_,O(printstring_broken_weak_or_relation));
+      break;
+    case Rectype_WeakAndMapping: # #<WEAK-AND-MAPPING (keys-list . value)> or #<BROKEN WEAK-AND-MAPPING>
+      CHECK_PRINT_READABLY(obj);
+      if (!eq(TheWeakAndMapping(obj)->wam_keys_list,unbound)) {
+        LEVEL_CHECK;
+        {
+          pushSTACK(TheWeakAndMapping(obj)->wam_value); # save value
+          pushSTACK(TheWeakAndMapping(obj)->wam_keys_list); # save keys-list
+          var gcv_object_t* aux_ = &STACK_0; # and memorize, where they are
+          UNREADABLE_START;
+          var uintL length_limit = get_print_length(); # *PRINT-LENGTH*
+          JUSTIFY_LAST(length_limit==0);
+          write_sstring_case(stream_,O(printstring_weak_and_mapping)); # "WEAK-AND-MAPPING"
+          {
+            var uintL length = 0; # previous length := 0
+            # check for attaining of *PRINT-LENGTH*:
+            if (length >= length_limit) goto weak_and_mapping_end;
+            JUSTIFY_SPACE; # print Space
+            JUSTIFY_LAST(true);
+            pr_pair(stream_,*(aux_ STACKop 0),*(aux_ STACKop 1)); # output (keys-list . value) pair
+            length++; # increase previous length
+          }
+        weak_and_mapping_end:
+          JUSTIFY_END_FILL;
+          UNREADABLE_END;
+          skipSTACK(2);
+        }
+        LEVEL_END;
+      } else
+        write_sstring_case(stream_,O(printstring_broken_weak_and_mapping));
+      break;
+    case Rectype_WeakOrMapping: # #<WEAK-OR-MAPPING (keys-list . value)> or #<BROKEN WEAK-OR-MAPPING>
+      CHECK_PRINT_READABLY(obj);
+      if (!eq(TheWeakOrMapping(obj)->wom_keys_list,unbound)) {
+        LEVEL_CHECK;
+        {
+          pushSTACK(TheWeakOrMapping(obj)->wom_value); # save value
+          pushSTACK(TheWeakOrMapping(obj)->wom_keys_list); # save keys-list
+          var gcv_object_t* aux_ = &STACK_0; # and memorize, where they are
+          UNREADABLE_START;
+          var uintL length_limit = get_print_length(); # *PRINT-LENGTH*
+          JUSTIFY_LAST(length_limit==0);
+          write_sstring_case(stream_,O(printstring_weak_or_mapping)); # "WEAK-OR-MAPPING"
+          {
+            var uintL length = 0; # previous length := 0
+            # check for attaining of *PRINT-LENGTH*:
+            if (length >= length_limit) goto weak_or_mapping_end;
+            JUSTIFY_SPACE; # print Space
+            JUSTIFY_LAST(true);
+            pr_pair(stream_,*(aux_ STACKop 0),*(aux_ STACKop 1)); # output (keys-list . value) pair
+            length++; # increase previous length
+          }
+        weak_or_mapping_end:
+          JUSTIFY_END_FILL;
+          UNREADABLE_END;
+          skipSTACK(2);
+        }
+        LEVEL_END;
+      } else
+        write_sstring_case(stream_,O(printstring_broken_weak_or_mapping));
+      break;
+    case Rectype_WeakAlist_Key:
+    case Rectype_WeakAlist_Value:
+    case Rectype_WeakAlist_Either:
+    case Rectype_WeakAlist_Both: # #<INTERNAL-WEAK-ALIST>
+      CHECK_PRINT_READABLY(obj);
+      write_sstring_case(stream_,O(printstring_internal_weak_alist));
+      break;
+    case Rectype_WeakKVT: # weak key-value table
+      pr_weakkvt(stream_,obj);
+      break;
     default:
       pushSTACK(S(print));
       fehler(serious_condition,

Index: spvw.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/spvw.d,v
retrieving revision 1.281
retrieving revision 1.282
diff -u -d -r1.281 -r1.282
--- spvw.d	17 May 2004 16:47:47 -0000	1.281
+++ spvw.d	19 May 2004 10:24:26 -0000	1.282
@@ -2640,6 +2640,7 @@
   }
  #endif
   init_subr_tab_1(); # initialize subr_tab
+  markwatchset = NULL; markwatchset_allocated = markwatchset_size = 0;
   if (argv_memfile==NULL) # manual initialization:
     initmem();
   else # load memory file:

Index: init.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/src/init.lisp,v
retrieving revision 1.133
retrieving revision 1.134
diff -u -d -r1.133 -r1.134
--- init.lisp	14 May 2004 22:38:51 -0000	1.133
+++ init.lisp	19 May 2004 10:24:29 -0000	1.134
@@ -337,6 +337,19 @@
    function-macro foreign-pointer symbol-macro symbol-macro-expand designator
    address special-operator finalize finalizer
    weak-pointer make-weak-pointer weak-pointer-p weak-pointer-value
+   weak-list make-weak-list weak-list-p weak-list-list
+   weak-and-relation make-weak-and-relation weak-and-relation-p
+   weak-and-relation-list
+   weak-or-relation make-weak-or-relation weak-or-relation-p
+   weak-or-relation-list
+   weak-mapping make-weak-mapping weak-mapping-p weak-mapping-pair
+   weak-mapping-value
+   weak-and-mapping make-weak-and-mapping weak-and-mapping-p
+   weak-and-mapping-pair weak-and-mapping-value
+   weak-or-mapping make-weak-or-mapping weak-or-mapping-p weak-or-mapping-pair
+   weak-or-mapping-value
+   weak-alist make-weak-alist weak-alist-p weak-alist-type weak-alist-contents
+   weak-alist-assoc weak-alist-rassoc weak-alist-value
    read-integer read-float write-integer write-float
    read-byte-lookahead read-byte-will-hang-p read-byte-no-hang
    read-char-will-hang-p

Index: spvw_garcol.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/spvw_garcol.d,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -d -r1.73 -r1.74
--- spvw_garcol.d	16 May 2004 18:46:30 -0000	1.73
+++ spvw_garcol.d	19 May 2004 10:24:26 -0000	1.74
@@ -57,413 +57,9 @@
   #define IF_DEBUG_GC_MARK(statement)  /*nop*/
 #endif
 
-local void gc_mark (object obj)
-{
-  var object dies = obj; /* current object */
-  var object vorg = nullobj; /* predecessor-object */
-  IF_DEBUG_GC_MARK(fprintf(stderr,"gc_mark obj = 0x%"PRIoint"x\n", as_oint(obj)));
-
-#define down_pair()                                                     \
-  if (in_old_generation(dies,typecode(dies),1))                         \
-    goto up; /* do not mark older generation */                         \
-  { var gcv_object_t* dies_ = (gcv_object_t*)ThePointer(dies);          \
-    if (marked(dies_)) goto up; /* marked -> go up */                   \
-      mark(dies_); /* mark */                                           \
-  }                                                                     \
-  { var object dies_ = objectplus(dies,(soint)(sizeof(cons_)-sizeof(gcv_object_t))<<(oint_addr_shift-addr_shift)); \
-    /* start with the last pointer */                                   \
-    var object nachf = *(gcv_object_t*)ThePointer(dies_); /* successor */ \
-    *(gcv_object_t*)ThePointer(dies_) = vorg; /* store predecessor */   \
-    vorg = dies_; /* current object becomes new predecessor */          \
-    dies = nachf; /* successor becomes current object */                \
-    goto down; /* and de...
 
[truncated message content]