From: Taylor R Campbell <campbell@mumble.net>
Date: Wed, 7 Jul 2010 19:34:05 +0000 (+0000)
Subject: Add O(1) ADD-TO-POPULATION!/UNSAFE to the runtime (unexported).
X-Git-Tag: 20100708-Gtk~7
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=72be8b1c205c0e0bafee6ddc0876166026534d05;p=mit-scheme.git

Add O(1) ADD-TO-POPULATION!/UNSAFE to the runtime (unexported).

This does not check whether the population already holds the object
to be added; hence it is unsafe.

Change MAKE-1D-TABLE and MAKE-THREAD to use it: newly allocated
objects are guaranteed not to be in the population.
---

diff --git a/src/runtime/poplat.scm b/src/runtime/poplat.scm
index 9e4e0b206..5b9375403 100644
--- a/src/runtime/poplat.scm
+++ b/src/runtime/poplat.scm
@@ -73,6 +73,12 @@ USA.
   (and (pair? object)
        (eq? (car object) population-tag)))
 
+(define (add-to-population!/unsafe population object)
+  (set-cdr! population
+	    (system-pair-cons weak-cons-type
+			      (canonicalize object)
+			      (cdr population))))
+
 (define (add-to-population! population object)
   (let ((object (canonicalize object)))
     (let loop ((previous population) (this (cdr population)))
diff --git a/src/runtime/prop1d.scm b/src/runtime/prop1d.scm
index 19a445233..3a56dcbfd 100644
--- a/src/runtime/prop1d.scm
+++ b/src/runtime/prop1d.scm
@@ -43,7 +43,7 @@ USA.
 
 (define (make-1d-table)
   (let ((table (list 1d-table-tag)))
-    (add-to-population! population-of-1d-tables table)
+    (add-to-population!/unsafe population-of-1d-tables table)
     table))
 
 (define (1d-table? object)
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 354c3148a..063d4ca6e 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2955,6 +2955,8 @@ USA.
 	  map-over-population!
 	  population?
 	  remove-from-population!)
+  (export (runtime)
+	  add-to-population!/unsafe)
   (initialization (initialize-package!)))
 
 (define-package (runtime pretty-printer)
diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 991352956..40d52be22 100644
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -108,7 +108,7 @@ USA.
     (set-thread/continuation! thread continuation)
     (set-thread/root-state-point! thread
 				  (current-state-point state-space:local))
-    (add-to-population! thread-population thread)
+    (add-to-population!/unsafe thread-population thread)
     (thread-running thread)
     thread))