From 42a528bb28bda17aaaf83aefd9d23da650b60d66 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Sun, 16 Nov 2014 12:37:17 +0100
Subject: [PATCH] compiler.codegen.gc-maps: docs and tests

---
 .../codegen/gc-maps/gc-maps-docs.factor       |  4 ++
 .../codegen/gc-maps/gc-maps-tests.factor      | 62 ++++++++++++++++++-
 basis/compiler/codegen/gc-maps/gc-maps.factor |  2 -
 3 files changed, 63 insertions(+), 5 deletions(-)

diff --git a/basis/compiler/codegen/gc-maps/gc-maps-docs.factor b/basis/compiler/codegen/gc-maps/gc-maps-docs.factor
index bd1d3ec0aa..a52c1fd44d 100644
--- a/basis/compiler/codegen/gc-maps/gc-maps-docs.factor
+++ b/basis/compiler/codegen/gc-maps/gc-maps-docs.factor
@@ -70,4 +70,8 @@ HELP: serialize-gc-maps
 { $values { "byte-array" byte-array } }
 { $description "Serializes the gc-maps that have been registered in the " { $link gc-maps } " variable into a byte-array." } ;
 
+HELP: gc-map-here
+{ $values { "gc-map" gc-map } }
+{ $description "Registers the gc map in the " { $link gc-maps } " dynamic variable at the current compiled offset." } ;
+
 ABOUT: "compiler.codegen.gc-maps"
diff --git a/basis/compiler/codegen/gc-maps/gc-maps-tests.factor b/basis/compiler/codegen/gc-maps/gc-maps-tests.factor
index 2dbf5ea3c9..a7bb819a3a 100644
--- a/basis/compiler/codegen/gc-maps/gc-maps-tests.factor
+++ b/basis/compiler/codegen/gc-maps/gc-maps-tests.factor
@@ -1,6 +1,6 @@
-USING: namespaces byte-arrays make compiler.codegen.gc-maps
-compiler.codegen.relocation bit-arrays accessors classes.struct
-tools.test kernel math sequences alien.c-types
+USING: accessors alien.c-types arrays classes.struct byte-arrays make
+namespaces compiler.cfg.stack-frame compiler.codegen.gc-maps
+compiler.codegen.relocation bit-arrays tools.test kernel math sequences
 specialized-arrays boxes compiler.cfg.instructions system
 cpu.architecture vm ;
 SPECIALIZED-ARRAY: uint
@@ -73,6 +73,62 @@ M: fake-cpu gc-root-offset ;
 [ t ] [ "result" get length "expect" get length = ] unit-test
 [ t ] [ "result" get "expect" get = ] unit-test
 
+
+cpu x86.64? [
+    x86.64 \ cpu set
+
+    ! gc-root-offsets
+    { { 1 3 } } [
+        T{ stack-frame { spill-area-base 0 } } stack-frame [
+            T{ gc-map
+               { gc-roots {
+                   T{ spill-slot { n 0 } }
+                   T{ spill-slot { n 16 } }
+               } }
+            } gc-root-offsets
+        ] with-variable
+    ] unit-test
+
+    { { 6 10 } } [
+        T{ stack-frame { spill-area-base 32 } } stack-frame [
+            T{ gc-map
+               { gc-roots {
+                   T{ spill-slot { n 8 } }
+                   T{ spill-slot { n 40 } }
+               } }
+            } gc-root-offsets
+        ] with-variable
+    ] unit-test
+
+    ! scrub-d scrub-r check-d check-r gc-roots
+    { { 0 0 0 0 5 } } [
+        T{ stack-frame { spill-area-base 0 } } stack-frame [
+            T{ gc-map
+               { gc-roots {
+                   T{ spill-slot { n 0 } }
+                   T{ spill-slot { n 24 } }
+               } }
+            } 1array gc-maps set
+            [ emit-gc-info-bitmaps ] B{ } make drop
+        ] with-variable
+    ] unit-test
+
+    ! scrub-d scrub-r check-d check-r gc-roots
+    { { 0 0 0 0 9 } } [
+        T{ stack-frame { spill-area-base 32 } } stack-frame [
+            T{ gc-map
+               { gc-roots {
+                   T{ spill-slot { n 0 } }
+                   T{ spill-slot { n 24 } }
+               } }
+            } 1array gc-maps set
+            [ emit-gc-info-bitmaps ] B{ } make drop
+        ] with-variable
+    ] unit-test
+
+    fake-cpu \ cpu set
+] when
+
 ! gc-map-needed?
 { t t } [
     T{ gc-map { scrub-d { 0 1 1 1 0 } } { scrub-r { 1 0 } } } gc-map-needed?
diff --git a/basis/compiler/codegen/gc-maps/gc-maps.factor b/basis/compiler/codegen/gc-maps/gc-maps.factor
index d5a9c0fe8c..4c92429ce9 100644
--- a/basis/compiler/codegen/gc-maps/gc-maps.factor
+++ b/basis/compiler/codegen/gc-maps/gc-maps.factor
@@ -9,8 +9,6 @@ IN: compiler.codegen.gc-maps
 SYMBOLS: return-addresses gc-maps ;
 
 : gc-map-needed? ( gc-map/f -- ? )
-    ! If there are no stack locations to scrub or check, and no GC
-    ! roots, there's no point storing the GC map.
     dup [ tuple-slots [ empty? ] all? not ] when ;
 
 : gc-map-here ( gc-map -- )