[rucksack-cvs] CVS rucksack

alemmens alemmens at common-lisp.net
Thu Aug 3 11:39:39 UTC 2006


Update of /project/rucksack/cvsroot/rucksack
In directory clnet:/tmp/cvs-serv18160

Modified Files:
	garbage-collector.lisp heap.lisp object-table.lisp 
	transactions.lisp 
Log Message:
Let SETF functions give correct return values.  (From Edi Weitz.)


--- /project/rucksack/cvsroot/rucksack/garbage-collector.lisp	2006/08/03 11:31:17	1.13
+++ /project/rucksack/cvsroot/rucksack/garbage-collector.lisp	2006/08/03 11:39:39	1.14
@@ -1,4 +1,4 @@
-;; $Id: garbage-collector.lisp,v 1.13 2006/08/03 11:31:17 alemmens Exp $
+;; $Id: garbage-collector.lisp,v 1.14 2006/08/03 11:39:39 alemmens Exp $
 
 (in-package :rucksack)
 
@@ -385,7 +385,8 @@
 
 (defun (setf object-alive-p) (value object-table object-id)
   (setf (object-info object-table object-id) 
-        (if value :live-object :dead-object)))
+        (if value :live-object :dead-object))
+  value)
 
 (defun object-alive-p (object-table object-id)
   (eql (object-info object-table object-id) :live-object))
--- /project/rucksack/cvsroot/rucksack/heap.lisp	2006/08/03 10:59:52	1.7
+++ /project/rucksack/cvsroot/rucksack/heap.lisp	2006/08/03 11:39:39	1.8
@@ -1,4 +1,4 @@
-;; $Id: heap.lisp,v 1.7 2006/08/03 10:59:52 alemmens Exp $
+;; $Id: heap.lisp,v 1.8 2006/08/03 11:39:39 alemmens Exp $
 
 (in-package :rucksack)
 
@@ -107,7 +107,8 @@
 (defun (setf pointer-value) (value pointer heap)
   (file-position (heap-stream heap) pointer)
   (write-unsigned-bytes value (cell-buffer heap) (heap-stream heap)
-                        +pointer-size+))
+                        +pointer-size+)
+  value)
 
 ;;
 ;; Expanding the heap
--- /project/rucksack/cvsroot/rucksack/object-table.lisp	2006/05/16 22:01:27	1.2
+++ /project/rucksack/cvsroot/rucksack/object-table.lisp	2006/08/03 11:39:39	1.3
@@ -1,4 +1,4 @@
-;; $Id: object-table.lisp,v 1.2 2006/05/16 22:01:27 alemmens Exp $
+;; $Id: object-table.lisp,v 1.3 2006/08/03 11:39:39 alemmens Exp $
 
 (in-package :rucksack)
 
@@ -86,7 +86,8 @@
                    (+ (block-header-size object-table)
                       +nr-object-info-octets+
                       (object-id-to-block id object-table)))
-    (serialize position stream)))
+    (serialize position stream))
+  position)
 
 (defun object-heap-position (object-table id)
   (let ((stream (heap-stream object-table)))
@@ -116,7 +117,8 @@
                     (:dead-object +dead-object+)
                     (:live-object +live-object+)
                     (:reserved +reserved-object+))))
-      (serialize-marker marker stream))))
+      (serialize-marker marker stream)))
+  info)
 
 
 ;;
--- /project/rucksack/cvsroot/rucksack/transactions.lisp	2006/05/20 10:41:47	1.3
+++ /project/rucksack/cvsroot/rucksack/transactions.lisp	2006/08/03 11:39:39	1.4
@@ -1,4 +1,4 @@
-;; $Id: transactions.lisp,v 1.3 2006/05/20 10:41:47 alemmens Exp $
+;; $Id: transactions.lisp,v 1.4 2006/08/03 11:39:39 alemmens Exp $
 
 (in-package :rucksack)
 
@@ -292,7 +292,8 @@
 OLD-BLOCK."
   (let ((stream (heap-stream heap)))
     (file-position stream (+ young-block (block-header-size heap)))
-    (serialize-previous-version-pointer old-block stream)))
+    (serialize-previous-version-pointer old-block stream))
+  old-block)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Rolling back




More information about the rucksack-cvs mailing list