From 4e246161076d4a2e3f9ff5f9e72dcca30a8013e5 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Thu, 3 Jan 2019 07:17:32 +0000 Subject: [PATCH] Use another indirection for representation of promises. The pairs never change, so merely loading the pair object from the cell indirection gives us an atomic snapshot of it. This way, there is no need for without-interrupts in promise-forced?. This makes each promise cost one more word (previously: one word to represent plus three words of heap space; now one word to represent plus four words of heap space), but reducing without-interrupts is a big win -- this halves the time of test-promise.scm on my machine. Of course, on a parallel system, the without-interrupts in %force is still not enough (and we'll need the cell-contentses to be load-acquire operations, not just loads). --- src/runtime/boot.scm | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/src/runtime/boot.scm b/src/runtime/boot.scm index 33a226a8e..86e465989 100644 --- a/src/runtime/boot.scm +++ b/src/runtime/boot.scm @@ -433,25 +433,25 @@ USA. (define (promise? object) (and (cell? object) - (object-type? (ucode-type delayed) (cell-contents object)))) + (cell? (cell-contents object)) + (object-type? (ucode-type delayed) + (cell-contents (cell-contents object))))) (define (make-promise object) - (make-cell (system-pair-cons (ucode-type delayed) #t object))) + (make-cell (make-cell (system-pair-cons (ucode-type delayed) #t object)))) (define (make-unforced-promise thunk) ;(guarantee thunk? thunk 'make-unforced-promise) - (make-cell (system-pair-cons (ucode-type delayed) #f thunk))) + (make-cell (make-cell (system-pair-cons (ucode-type delayed) #f thunk)))) (define (%promise-parts promise) - (without-interrupts - (lambda () - (let ((p (cell-contents promise))) - (values (system-pair-car p) - (system-pair-cdr p)))))) + (let ((p (cell-contents (cell-contents promise)))) + (values (system-pair-car p) + (system-pair-cdr p)))) (define (promise-forced? promise) (guarantee promise? promise 'promise-forced?) - (system-pair-car (cell-contents promise))) + (system-pair-car (cell-contents (cell-contents promise)))) (define (promise-value promise) (guarantee promise? promise 'promise-value) @@ -472,12 +472,16 @@ USA. (guarantee promise? promise* 'force) (without-interrupts (lambda () - (let ((p (cell-contents promise))) - (if (not (system-pair-car p)) - (let ((p* (cell-contents promise*))) - (system-pair-set-car! p (system-pair-car p*)) - (system-pair-set-cdr! p (system-pair-cdr p*)) - (set-cell-contents! promise* p)))))) + (let ((q (cell-contents promise))) + (if (not (system-pair-car (cell-contents q))) + (let ((q* (cell-contents promise*))) + ;; Reduce the chain of indirections by one link so + ;; that we don't accumulate space. + (set-cell-contents! q (cell-contents q*)) + ;; Point promise* at the same chain of + ;; indirections as promise so that forcing + ;; promise* will yield the same result. + (set-cell-contents! promise* q)))))) (%force promise))))) (define-print-method promise? -- 2.25.1