[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