Inline allocators now GC check!

diff --git a/library/compiler/generator/architecture.factor b/library/compiler/generator/architecture.factor
index 0e634a0c32fc7976354b4c79395cb33227353294..04bf6010876a54c281b1a8497b0b4ebc2f074787 100644 (file)
--- a/library/compiler/generator/architecture.factor
+++ b/library/compiler/generator/architecture.factor
@@ -55,7 +55,7 @@ DEFER: %jump-label ( label -- )
 DEFER: %jump-t ( label vreg -- )
 
 ! Jump table of addresses (one cell each) is right after this
-DEFER: %dispatch ( vreg -- )
+DEFER: %dispatch ( -- )
 
 ! Jump table entry
 DEFER: %target ( label -- )

diff --git a/library/compiler/generator/generator.factor b/library/compiler/generator/generator.factor
index f50a81c99bd922d6cdc27b75d53a1de46e86d4ee..51f86af8a01d6fc27de804541a30038bb337e9f9 100644 (file)
--- a/library/compiler/generator/generator.factor
+++ b/library/compiler/generator/generator.factor
@@ -153,24 +153,19 @@ M: #call-label generate-node
 
 ! #dispatch
 : dispatch-head ( node -- label/node )
-    #! Output the jump table insn and return a list of
-    #! label/branch pairs.
-    [ end-basic-block %dispatch ] H{
-        { +input+ { { f "n" } } }
-        { +scratch+ { { f "scratch" } } }
-    } with-template
+    #! Return a list of label/branch pairs.
     node-children [ <label> dup %target 2array ] map ;
 
 : dispatch-body ( label/node -- )
     <label> swap [
-        first2 resolve-label generate-nodes
+        first2 resolve-label generate-branch
         dup %jump-label
-    ] each resolve-label ;
+    ] each resolve-label init-templates ;
 
 M: #dispatch generate-node
     #! The parameter is a list of nodes, each one is a branch to
     #! take in case the top of stack has that type.
-    dispatch-head dispatch-body iterate-next ;
+    %dispatch dispatch-head dispatch-body iterate-next ;
 
 ! #push
 UNION: immediate fixnum POSTPONE: f ;

diff --git a/library/compiler/generator/templates.factor b/library/compiler/generator/templates.factor
index 74b360e7732d188621884c03d2b2d77d04f5ae36..7fec3e2aace7b728e309fa81f037ceb7919397d7 100644 (file)
--- a/library/compiler/generator/templates.factor
+++ b/library/compiler/generator/templates.factor
@@ -4,6 +4,9 @@ IN: compiler
 USING: arrays generic hashtables inference io kernel math
 namespaces prettyprint sequences vectors words ;
 
+! Set this to t so that end-basic-block compiles a GC check
+SYMBOL: maybe-gc
+
 ! Register allocation
 
 ! Hash mapping reg-classes to mutable vectors
@@ -131,7 +134,12 @@ SYMBOL: phantom-r
 : finalize-contents ( -- )
     phantoms 2dup flush-locs [ vregs>stack ] 2apply ;
 
-: end-basic-block ( -- ) finalize-contents finalize-heights ;
+: end-basic-block ( -- )
+    finalize-contents finalize-heights
+    maybe-gc get [
+        maybe-gc off
+        "simple_gc" f %alien-invoke
+    ] when ;
 
 : used-vregs ( -- seq ) phantoms append [ vreg? ] subset ;
 
@@ -146,6 +154,7 @@ SYMBOL: phantom-r
     drop ;
 
 : init-templates ( -- )
+    maybe-gc off
     <phantom-datastack> phantom-d set
     <phantom-callstack> phantom-r set
     compute-free-vregs ;

diff --git a/library/compiler/ppc/allot.factor b/library/compiler/ppc/allot.factor
index c79a04f1f5eb5d4dd512577effd589af251a08b9..0c2e9487b924534bb8fed6f70927ef49bdfb9b3f 100644 (file)
--- a/library/compiler/ppc/allot.factor
+++ b/library/compiler/ppc/allot.factor
@@ -9,6 +9,7 @@ USING: kernel assembler kernel-internals namespaces math ;
 : %allot ( header size -- )
     #! Store a pointer to 'size' bytes allocated from the
     #! nursery in r11.
+    maybe-gc on
     8 align ! align the size
     12 load-zone-ptr ! nusery -> r12
     11 12 cell LWZ ! nursery.here -> r11

diff --git a/library/compiler/ppc/architecture.factor b/library/compiler/ppc/architecture.factor
index b48b3833eb85761a0d91f940dc3be4dfc32e92c9..d6a309e8c12cb9a4478b13b40bd1e65664034882 100644 (file)
--- a/library/compiler/ppc/architecture.factor
+++ b/library/compiler/ppc/architecture.factor
@@ -77,12 +77,17 @@ M: object load-literal
 : %dispatch ( -- )
     #! The value 20 is a magic number. It is the length of the
     #! instruction sequence that follows
-    "n" operand dup 1 SRAWI
-    0 "scratch" operand LOAD32 rel-absolute-2/2 rel-here
-    "n" operand dup "scratch" operand ADD
-    "n" operand dup 20 LWZ
-    "n" operand MTLR
-    BLR ;
+    [
+        "n" operand dup 1 SRAWI
+        0 "scratch" operand LOAD32 rel-absolute-2/2 rel-here
+        "n" operand dup "scratch" operand ADD
+        "n" operand dup 20 LWZ
+        "n" operand MTLR
+        BLR
+    ] H{
+        { +input+ { { f "n" } } }
+        { +scratch+ { { f "scratch" } } }
+    } with-template ;
 
 : %target ( label -- ) 0 , rel-absolute-cell rel-label ;
 

diff --git a/library/compiler/x86/allot.factor b/library/compiler/x86/allot.factor
index c24bddc7502af800aa543dd041dbdae2652c8c4f..26de9994e38b4104e3dacfbf803695da514bb819 100644 (file)
--- a/library/compiler/x86/allot.factor
+++ b/library/compiler/x86/allot.factor
@@ -21,6 +21,7 @@ USING: kernel assembler kernel-internals namespaces math ;
     allot-tmp-reg [] swap tag-header MOV ;
 
 : %allot ( header size quot -- )
+    maybe-gc on
     swap >r >r
     allot-tmp-reg PUSH
     load-allot-ptr

diff --git a/library/compiler/x86/architecture.factor b/library/compiler/x86/architecture.factor
index 5d891c8ace9d7811aedc201ba7333b4455a450ab..75832c9ec81b2d21c2ca129e6079749d1ef1473b 100644 (file)
--- a/library/compiler/x86/architecture.factor
+++ b/library/compiler/x86/architecture.factor
@@ -114,21 +114,26 @@ M: object load-literal
     #! Compile a piece of code that jumps to an offset in a
     #! jump table indexed by the fixnum at the top of the stack.
     #! The jump table must immediately follow this macro.
-    ! Untag and multiply to get a jump table offset
-    "end" define-label
-    "n" operand fixnum>slot@
-    ! Add to jump table base. We use a temporary register since
-    ! on AMD64 we have to load a 64-bit immediate. On x86, this
-    ! is redundant.
-    "scratch" operand HEX: ffffffff MOV
-    "end" get rel-absolute-cell rel-label
-    "n" operand "scratch" operand ADD
-    ! Jump to jump table entry
-    "n" operand [] JMP
-    ! Align for better performance
-    compile-aligned
-    ! Fix up jump table pointer
-    "end" resolve-label ;
+    [
+        ! Untag and multiply to get a jump table offset
+        "end" define-label
+        "n" operand fixnum>slot@
+        ! Add to jump table base. We use a temporary register
+        ! since on AMD64 we have to load a 64-bit immediate. On
+        ! x86, this is redundant.
+        "scratch" operand HEX: ffffffff MOV
+        "end" get rel-absolute-cell rel-label
+        "n" operand "scratch" operand ADD
+        ! Jump to jump table entry
+        "n" operand [] JMP
+        ! Align for better performance
+        compile-aligned
+        ! Fix up jump table pointer
+        "end" resolve-label
+    ] H{
+        { +input+ { { f "n" } } }
+        { +scratch+ { { f "scratch" } } }
+    } with-template ;
 
 : %target ( label -- ) 0 cell, rel-absolute-cell rel-label ;
 

diff --git a/library/test/kernel.factor b/library/test/kernel.factor
index 59b6fdfc9beb3e328e0b6c2ec5b3ac7e12b82aef..34102ebed3c6ac203f88896a4d10d91d10ff3008 100644 (file)
--- a/library/test/kernel.factor
+++ b/library/test/kernel.factor
@@ -7,12 +7,12 @@ sequences test errors math-internals ;
 
 ! some primitives are missing GC checks
 [ ] [ 1000000 [ drop H{ } clone >n n> drop ] each ] unit-test
-! [ ] [ 1.0 10000000 [ drop 1.0 * ] each ] unit-test
+[ ] [ 1.0 10000000 [ 1.0 * ] times drop ] unit-test
 [ ] [ 268435455 >fixnum 10000000 [ dup dup + drop ] times drop ] unit-test
 [ ] [ 268435455 >fixnum 10000000 [ dup dup fixnum+ drop ] times drop ] unit-test
 [ ] [ 10000000 [ drop 1/3 >fixnum drop ] each ] unit-test
 [ ] [ 10000000 [ drop 1/3 >bignum drop ] each ] unit-test
-! [ ] [ 10000000 [ drop 1/3 >float drop ] each ] unit-test
+[ ] [ 10000000 [ drop 1/3 >float drop ] each ] unit-test
 
 ! Don't leak extra roots if error is thrown
 [ ] [ 10000 [ [ -1 f <array> ] catch drop ] times ] unit-test