GC checks now save and restore registers

diff --git a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
new file mode 100644 (file)
index 0000000..e5be2d9
--- /dev/null
+++ b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
@@ -0,0 +1,74 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: namespaces accessors math.order assocs kernel sequences
+combinators make classes words cpu.architecture
+compiler.cfg.instructions compiler.cfg.registers
+compiler.cfg.stack-frame ;
+IN: compiler.cfg.build-stack-frame
+
+SYMBOL: frame-required?
+
+SYMBOL: spill-counts
+
+GENERIC: compute-stack-frame* ( insn -- )
+
+: request-stack-frame ( stack-frame -- )
+    stack-frame [ max-stack-frame ] change ;
+
+M: ##stack-frame compute-stack-frame*
+    frame-required? on
+    stack-frame>> request-stack-frame ;
+
+M: ##call compute-stack-frame*
+    word>> sub-primitive>> [ frame-required? on ] unless ;
+
+M: _gc compute-stack-frame*
+    frame-required? on
+    stack-frame new swap gc-root-size>> >>gc-root-size
+    request-stack-frame ;
+
+M: _spill-counts compute-stack-frame*
+    counts>> stack-frame get (>>spill-counts) ;
+
+M: insn compute-stack-frame*
+    class frame-required? word-prop [
+        frame-required? on
+    ] when ;
+
+\ _spill t frame-required? set-word-prop
+\ ##fixnum-add t frame-required? set-word-prop
+\ ##fixnum-sub t frame-required? set-word-prop
+\ ##fixnum-mul t frame-required? set-word-prop
+\ ##fixnum-add-tail f frame-required? set-word-prop
+\ ##fixnum-sub-tail f frame-required? set-word-prop
+\ ##fixnum-mul-tail f frame-required? set-word-prop
+
+: compute-stack-frame ( insns -- )
+    frame-required? off
+    T{ stack-frame } clone stack-frame set
+    [ compute-stack-frame* ] each
+    stack-frame get dup stack-frame-size >>total-size drop ;
+
+GENERIC: insert-pro/epilogues* ( insn -- )
+
+M: ##stack-frame insert-pro/epilogues* drop ;
+
+M: ##prologue insert-pro/epilogues*
+    drop frame-required? get [ stack-frame get _prologue ] when ;
+
+M: ##epilogue insert-pro/epilogues*
+    drop frame-required? get [ stack-frame get _epilogue ] when ;
+
+M: insn insert-pro/epilogues* , ;
+
+: insert-pro/epilogues ( insns -- insns )
+    [ [ insert-pro/epilogues* ] each ] { } make ;
+
+: build-stack-frame ( mr -- mr )
+    [
+        [
+            [ compute-stack-frame ]
+            [ insert-pro/epilogues ]
+            bi
+        ] change-instructions
+    ] with-scope ;

diff --git a/basis/compiler/cfg/build-stack-frame/summary.txt b/basis/compiler/cfg/build-stack-frame/summary.txt
new file mode 100644 (file)
index 0000000..1ad913a
--- /dev/null
+++ b/basis/compiler/cfg/build-stack-frame/summary.txt
@@ -0,0 +1 @@
+Computing stack frame size and layout

diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor
index 38075c24a3aceee51f4ed155b76f638153d674ae..d323263fc7342496c51667e26c3c1de56503408b 100755 (executable)
--- a/basis/compiler/cfg/builder/builder.factor
+++ b/basis/compiler/cfg/builder/builder.factor
@@ -15,6 +15,7 @@ compiler.cfg.iterator
 compiler.cfg.utilities
 compiler.cfg.registers
 compiler.cfg.intrinsics
+compiler.cfg.stack-frame
 compiler.cfg.instructions
 compiler.alien ;
 IN: compiler.cfg.builder

diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor
index 1484b3ec7204fab276409aa20502793e7481e086..cdd767ef8df260cab4764ef8f11fd735ff05900b 100644 (file)
--- a/basis/compiler/cfg/def-use/def-use.factor
+++ b/basis/compiler/cfg/def-use/def-use.factor
@@ -31,6 +31,7 @@ M: ##compare-imm temp-vregs temp>> 1array ;
 M: ##compare-float temp-vregs temp>> 1array ;
 M: ##fixnum-mul temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
 M: ##fixnum-mul-tail temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
+M: ##gc temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
 M: _dispatch temp-vregs temp>> 1array ;
 M: insn temp-vregs drop f ;
 
@@ -51,7 +52,6 @@ M: ##alien-getter uses-vregs src>> 1array ;
 M: ##alien-setter uses-vregs [ src>> ] [ value>> ] bi 2array ;
 M: ##fixnum-overflow uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
 M: ##phi uses-vregs inputs>> ;
-M: ##gc uses-vregs live-in>> ;
 M: _conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
 M: _compare-imm-branch uses-vregs src1>> 1array ;
 M: _dispatch uses-vregs src>> 1array ;

diff --git a/basis/compiler/cfg/gc-checks/gc-checks.factor b/basis/compiler/cfg/gc-checks/gc-checks.factor
index 91e79ea2dd26fc07c2d5b9496d085e8477fea909..417691412624c0124121b035b4d64520923ca002 100644 (file)
--- a/basis/compiler/cfg/gc-checks/gc-checks.factor
+++ b/basis/compiler/cfg/gc-checks/gc-checks.factor
@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel sequences assocs
 cpu.architecture compiler.cfg.rpo
-compiler.cfg.liveness compiler.cfg.instructions ;
+compiler.cfg.liveness compiler.cfg.instructions
+compiler.cfg.hats ;
 IN: compiler.cfg.gc-checks
 
 : gc? ( bb -- ? )
@@ -13,9 +14,7 @@ IN: compiler.cfg.gc-checks
 
 : insert-gc-check ( basic-block -- )
     dup gc? [
-        dup
-        [ swap object-pointer-regs \ ##gc new-insn prefix ]
-        change-instructions drop
+        [ i i f f \ ##gc new-insn prefix ] change-instructions drop
     ] [ drop ] if ;
 
 : insert-gc-checks ( cfg -- cfg' )

diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 314a66ba9c281e701fe645132b2dc330b4b611db..fe853cf490ec6b1e2849e87a3d7d0fb789dce06e 100644 (file)
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -52,12 +52,6 @@ INSN: ##inc-d { n integer } ;
 INSN: ##inc-r { n integer } ;
 
 ! Subroutine calls
-TUPLE: stack-frame
-{ params integer }
-{ return integer }
-{ total-size integer }
-spill-counts ;
-
 INSN: ##stack-frame stack-frame ;
 INSN: ##call word { height integer } ;
 INSN: ##jump word ;
@@ -223,7 +217,7 @@ INSN: ##compare-imm < ##binary-imm cc temp ;
 INSN: ##compare-float-branch < ##conditional-branch ;
 INSN: ##compare-float < ##binary cc temp ;
 
-INSN: ##gc live-in ;
+INSN: ##gc { temp1 vreg } { temp2 vreg } live-registers live-spill-slots ;
 
 ! Instructions used by machine IR only.
 INSN: _prologue stack-frame ;
@@ -243,6 +237,10 @@ INSN: _compare-imm-branch label { src1 vreg } { src2 integer } cc ;
 
 INSN: _compare-float-branch < _conditional-branch ;
 
+TUPLE: spill-slot n ; C: <spill-slot> spill-slot
+
+INSN: _gc { temp1 vreg } { temp2 vreg } gc-roots gc-root-count gc-root-size ;
+
 ! These instructions operate on machine registers and not
 ! virtual registers
 INSN: _spill src class n ;

diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
index c7e3380f83635d584bec2fcc069b12b4be27df2c..0de350c215d27bbbca2333f0c0856e91e16cbd98 100644 (file)
--- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -58,17 +58,34 @@ SYMBOL: unhandled-intervals
         ] [ 2drop ] if
     ] if ;
 
-GENERIC: assign-registers-in-insn ( insn -- )
+GENERIC: assign-before ( insn -- )
+
+GENERIC: assign-after ( insn -- )
 
 : all-vregs ( insn -- vregs )
     [ defs-vregs ] [ temp-vregs ] [ uses-vregs ] tri 3append ;
 
-M: vreg-insn assign-registers-in-insn
+M: vreg-insn assign-before
     active-intervals get seq>> over all-vregs '[ vreg>> _ member? ] filter
     [ [ vreg>> ] [ reg>> ] bi ] { } map>assoc
     >>regs drop ;
 
-M: insn assign-registers-in-insn drop ;
+M: insn assign-before drop ;
+
+: compute-live-registers ( -- regs )
+    active-intervals get seq>> [ [ vreg>> ] [ reg>> ] bi ] { } map>assoc ;
+
+: compute-live-spill-slots ( -- spill-slots )
+    unhandled-intervals get
+    heap-values [ reload-from>> ] filter
+    [ [ vreg>> ] [ reload-from>> ] bi ] { } map>assoc ;
+
+M: ##gc assign-after
+    compute-live-registers >>live-registers
+    compute-live-spill-slots >>live-spill-slots
+    drop ;
+
+M: insn assign-after drop ;
 
 : <active-intervals> ( -- obj )
     V{ } clone active-intervals boa ;
@@ -82,10 +99,13 @@ M: insn assign-registers-in-insn drop ;
     [
         [
             [
-                [ insn#>> activate-new-intervals ]
-                [ [ assign-registers-in-insn ] [ , ] bi ]
-                [ insn#>> expire-old-intervals ]
-                tri
+                {
+                    [ insn#>> activate-new-intervals ]
+                    [ assign-before ]
+                    [ , ]
+                    [ insn#>> expire-old-intervals ]
+                    [ assign-after ]
+                } cleave
             ] each
         ] V{ } make
     ] change-instructions drop ;

diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor
index 53ca56907d9871649c44cb375de97dc0a40cb8b3..9e222f1832e2fb82eb715f8b0e5a39c677e6bebb 100755 (executable)
--- a/basis/compiler/cfg/linearization/linearization.factor
+++ b/basis/compiler/cfg/linearization/linearization.factor
@@ -1,11 +1,11 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math accessors sequences namespaces make
-combinators assocs
-cpu.architecture
+combinators assocs arrays locals cpu.architecture
 compiler.cfg
 compiler.cfg.rpo
 compiler.cfg.liveness
+compiler.cfg.stack-frame
 compiler.cfg.instructions ;
 IN: compiler.cfg.linearization
 
@@ -68,6 +68,57 @@ M: ##dispatch linearize-insn
     [ successors>> [ number>> _dispatch-label ] each ]
     bi* ;
 
+: gc-root-registers ( n live-registers -- n )
+    [
+        [ second 2array , ]
+        [ first reg-class>> reg-size + ]
+        2bi
+    ] each ;
+
+: gc-root-spill-slots ( n live-spill-slots -- n )
+    [
+        dup first reg-class>> int-regs eq? [
+            [ second <spill-slot> 2array , ]
+            [ first reg-class>> reg-size + ]
+            2bi
+        ] [ drop ] if
+    ] each ;
+
+: oop-registers ( regs -- regs' )
+    [ first reg-class>> int-regs eq? ] filter ;
+
+: data-registers ( regs -- regs' )
+    [ first reg-class>> double-float-regs eq? ] filter ;
+
+:: compute-gc-roots ( live-registers live-spill-slots -- alist )
+    [
+        0
+        ! we put float registers last; the GC doesn't actually scan them
+        live-registers oop-registers gc-root-registers
+        live-spill-slots gc-root-spill-slots
+        live-registers data-registers gc-root-registers
+        drop
+    ] { } make ;
+
+: count-gc-roots ( live-registers live-spill-slots -- n )
+    ! Size of GC root area, minus the float registers
+    [ oop-registers length ] bi@ + ;
+
+M: ##gc linearize-insn
+    nip
+    [
+        [ temp1>> ]
+        [ temp2>> ]
+        [
+            [ live-registers>> ] [ live-spill-slots>> ] bi
+            [ compute-gc-roots ]
+            [ count-gc-roots ]
+            [ gc-roots-size ]
+            2tri
+        ] tri
+        _gc
+    ] with-regs ;
+
 : linearize-basic-blocks ( cfg -- insns )
     [
         [ [ linearize-basic-block ] each-basic-block ]

diff --git a/basis/compiler/cfg/mr/mr.factor b/basis/compiler/cfg/mr/mr.factor
index 49f7c793e5e327e3c53f49edfc71b21b6d474691..9f6a62090c42549ebb508fa2fc4787bfc011ff89 100644 (file)
--- a/basis/compiler/cfg/mr/mr.factor
+++ b/basis/compiler/cfg/mr/mr.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: compiler.cfg.linearization compiler.cfg.two-operand
 compiler.cfg.liveness compiler.cfg.gc-checks compiler.cfg.linear-scan
-compiler.cfg.stack-frame compiler.cfg.rpo ;
+compiler.cfg.build-stack-frame compiler.cfg.rpo ;
 IN: compiler.cfg.mr
 
 : build-mr ( cfg -- mr )

diff --git a/basis/compiler/cfg/stack-frame/authors.txt b/basis/compiler/cfg/stack-frame/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /dev/null
+++ b/basis/compiler/cfg/stack-frame/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file

diff --git a/basis/compiler/cfg/stack-frame/stack-frame.factor b/basis/compiler/cfg/stack-frame/stack-frame.factor
index fd11260f97ff39559a040b9de8dc1b434ac5b0ce..5cb5762b786ee965267f45df9556e761275eab07 100644 (file)
--- a/basis/compiler/cfg/stack-frame/stack-frame.factor
+++ b/basis/compiler/cfg/stack-frame/stack-frame.factor
@@ -1,72 +1,55 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces accessors math.order assocs kernel sequences
-combinators make classes words cpu.architecture
-compiler.cfg.instructions compiler.cfg.registers ;
+USING: math math.order namespaces accessors kernel layouts combinators
+combinators.smart assocs sequences cpu.architecture ;
 IN: compiler.cfg.stack-frame
 
-SYMBOL: frame-required?
+TUPLE: stack-frame
+{ params integer }
+{ return integer }
+{ total-size integer }
+{ gc-root-size integer }
+spill-counts ;
 
-SYMBOL: spill-counts
+! Stack frame utilities
+: param-base ( -- n )
+    stack-frame get [ params>> ] [ return>> ] bi + ;
 
-GENERIC: compute-stack-frame* ( insn -- )
+: spill-float-offset ( n -- offset )
+    double-float-regs reg-size * ;
 
-: max-stack-frame ( frame1 frame2 -- frame3 )
-    [ stack-frame new ] 2dip
-        [ [ params>> ] bi@ max >>params ]
-        [ [ return>> ] bi@ max >>return ]
-        2bi ;
-
-M: ##stack-frame compute-stack-frame*
-    frame-required? on
-    stack-frame>> stack-frame [ max-stack-frame ] change ;
-
-M: ##call compute-stack-frame*
-    word>> sub-primitive>> [ frame-required? on ] unless ;
-
-M: _spill-counts compute-stack-frame*
-    counts>> stack-frame get (>>spill-counts) ;
-
-M: insn compute-stack-frame*
-    class frame-required? word-prop [
-        frame-required? on
-    ] when ;
+: spill-integer-base ( -- n )
+    stack-frame get spill-counts>> double-float-regs [ swap at ] keep reg-size *
+    param-base + ;
 
-\ _spill t frame-required? set-word-prop
-\ ##gc t frame-required? set-word-prop
-\ ##fixnum-add t frame-required? set-word-prop
-\ ##fixnum-sub t frame-required? set-word-prop
-\ ##fixnum-mul t frame-required? set-word-prop
-\ ##fixnum-add-tail f frame-required? set-word-prop
-\ ##fixnum-sub-tail f frame-required? set-word-prop
-\ ##fixnum-mul-tail f frame-required? set-word-prop
+: spill-integer-offset ( n -- offset )
+    cells spill-integer-base + ;
 
-: compute-stack-frame ( insns -- )
-    frame-required? off
-    T{ stack-frame } clone stack-frame set
-    [ compute-stack-frame* ] each
-    stack-frame get dup stack-frame-size >>total-size drop ;
+: spill-area-size ( stack-frame -- n )
+    spill-counts>> [ swap reg-size * ] { } assoc>map sum ;
 
-GENERIC: insert-pro/epilogues* ( insn -- )
+: gc-root-base ( -- n )
+    stack-frame get spill-area-size
+    param-base + ;
 
-M: ##stack-frame insert-pro/epilogues* drop ;
+: gc-root-offset ( n -- n' ) gc-root-base + ;
 
-M: ##prologue insert-pro/epilogues*
-    drop frame-required? get [ stack-frame get _prologue ] when ;
+: gc-roots-size ( live-registers live-spill-slots -- n )
+    [ keys [ reg-class>> reg-size ] sigma ] bi@ + ;
 
-M: ##epilogue insert-pro/epilogues*
-    drop frame-required? get [ stack-frame get _epilogue ] when ;
-
-M: insn insert-pro/epilogues* , ;
-
-: insert-pro/epilogues ( insns -- insns )
-    [ [ insert-pro/epilogues* ] each ] { } make ;
-
-: build-stack-frame ( mr -- mr )
+: (stack-frame-size) ( stack-frame -- n )
     [
-        [
-            [ compute-stack-frame ]
-            [ insert-pro/epilogues ]
-            bi
-        ] change-instructions
-    ] with-scope ;
+        {
+            [ spill-area-size ]
+            [ gc-root-size>> ]
+            [ params>> ]
+            [ return>> ]
+        } cleave
+    ] sum-outputs ;
+
+: max-stack-frame ( frame1 frame2 -- frame3 )
+    [ stack-frame new ] 2dip
+        [ [ params>> ] bi@ max >>params ]
+        [ [ return>> ] bi@ max >>return ]
+        [ [ gc-root-size>> ] bi@ max >>gc-root-size ]
+        2tri ;
\ No newline at end of file

diff --git a/basis/compiler/cfg/stack-frame/summary.txt b/basis/compiler/cfg/stack-frame/summary.txt
deleted file mode 100644 (file)
index 1ad913a..0000000
--- a/basis/compiler/cfg/stack-frame/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-Computing stack frame size and layout

diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 3962902c6257134f15b8705650fb83270cfe1226..7bdaace1db3c37388dc6f6ca12d20a6c9fa54549 100755 (executable)
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -10,6 +10,7 @@ compiler.errors
 compiler.alien
 compiler.cfg
 compiler.cfg.instructions
+compiler.cfg.stack-frame
 compiler.cfg.registers
 compiler.cfg.builder
 compiler.codegen.fixup
@@ -234,7 +235,13 @@ M: ##write-barrier generate-insn
     [ table>> register ]
     tri %write-barrier ;
 
-M: ##gc generate-insn drop %gc ;
+M: _gc generate-insn
+    {
+        [ temp1>> register ]
+        [ temp2>> register ]
+        [ gc-roots>> ]
+        [ gc-root-count>> ]
+    } cleave %gc ;
 
 M: ##loop-entry generate-insn drop %loop-entry ;
 
@@ -243,16 +250,6 @@ M: ##alien-global generate-insn
     %alien-global ;
 
 ! ##alien-invoke
-GENERIC: reg-size ( register-class -- n )
-
-M: int-regs reg-size drop cell ;
-
-M: single-float-regs reg-size drop 4 ;
-
-M: double-float-regs reg-size drop 8 ;
-
-M: stack-params reg-size drop "void*" heap-size ;
-
 GENERIC: reg-class-variable ( register-class -- symbol )
 
 M: reg-class reg-class-variable ;

diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index f7f91524c38374bc6ca71d243d8f413b0a681445..805ba4fd71e7d75c2f2ee98455c942a489ef1c18 100644 (file)
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -12,12 +12,22 @@ SINGLETON: double-float-regs
 UNION: float-regs single-float-regs double-float-regs ;
 UNION: reg-class int-regs float-regs ;
 
-! Mapping from register class to machine registers
-HOOK: machine-registers cpu ( -- assoc )
-
 ! A pseudo-register class for parameters spilled on the stack
 SINGLETON: stack-params
 
+GENERIC: reg-size ( register-class -- n )
+
+M: int-regs reg-size drop cell ;
+
+M: single-float-regs reg-size drop 4 ;
+
+M: double-float-regs reg-size drop 8 ;
+
+M: stack-params reg-size drop cell ;
+
+! Mapping from register class to machine registers
+HOOK: machine-registers cpu ( -- assoc )
+
 ! Return values of this class go here
 GENERIC: return-reg ( register-class -- reg )
 
@@ -119,7 +129,7 @@ HOOK: %alien-global cpu ( dst symbol library -- )
 
 HOOK: %allot cpu ( dst size class temp -- )
 HOOK: %write-barrier cpu ( src card# table -- )
-HOOK: %gc cpu ( -- )
+HOOK: %gc cpu ( temp1 temp2 live-registers live-spill-slots -- )
 
 HOOK: %prologue cpu ( n -- )
 HOOK: %epilogue cpu ( n -- )

diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 0b9b4e8ddf48d9c935d8dfff5763c3dc8e525e80..3a7221c2390358ce83f292134706a7cd557c0774 100644 (file)
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel math namespaces make sequences
 system layouts alien alien.c-types alien.accessors alien.structs
@@ -6,7 +6,7 @@ slots splitting assocs combinators locals cpu.x86.assembler
 cpu.x86 cpu.architecture compiler.constants
 compiler.codegen compiler.codegen.fixup
 compiler.cfg.instructions compiler.cfg.builder
-compiler.cfg.intrinsics ;
+compiler.cfg.intrinsics compiler.cfg.stack-frame ;
 IN: cpu.x86.64
 
 M: x86.64 machine-registers

diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 1a2c2e3ee19e962cb217a51f6a1cdce4211f1332..375ea32940710d3e1f698b8f078ea9cf65ba4cea 100644 (file)
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -6,7 +6,7 @@ kernel kernel.private math memory namespaces make sequences
 words system layouts combinators math.order fry locals
 compiler.constants compiler.cfg.registers
 compiler.cfg.instructions compiler.cfg.intrinsics
-compiler.codegen compiler.codegen.fixup ;
+compiler.cfg.stack-frame compiler.codegen compiler.codegen.fixup ;
 IN: cpu.x86
 
 << enable-fixnum-log2 >>
@@ -17,6 +17,32 @@ M: label JUMPcc [ 0 ] dip JUMPcc rc-relative label-fixup ;
 
 M: x86 two-operand? t ;
 
+HOOK: stack-reg cpu ( -- reg )
+
+HOOK: reserved-area-size cpu ( -- n )
+
+: stack@ ( n -- op ) stack-reg swap [+] ;
+
+: param@ ( n -- op ) reserved-area-size + stack@ ;
+
+: spill-integer@ ( n -- op ) spill-integer-offset param@ ;
+
+: spill-float@ ( n -- op ) spill-float-offset param@ ;
+
+: gc-root@ ( n -- op ) gc-root-offset param@ ;
+
+: decr-stack-reg ( n -- )
+    dup 0 = [ drop ] [ stack-reg swap SUB ] if ;
+
+: incr-stack-reg ( n -- )
+    dup 0 = [ drop ] [ stack-reg swap ADD ] if ;
+
+: align-stack ( n -- n' )
+    os macosx? cpu x86.64? or [ 16 align ] when ;
+
+M: x86 stack-frame-size ( stack-frame -- i )
+    (stack-frame-size) 3 cells reserved-area-size + + align-stack ;
+
 HOOK: temp-reg-1 cpu ( -- reg )
 HOOK: temp-reg-2 cpu ( -- reg )
 
@@ -45,20 +71,6 @@ M: x86 %replace loc>operand swap MOV ;
 M: x86 %inc-d ( n -- ) ds-reg (%inc) ;
 M: x86 %inc-r ( n -- ) rs-reg (%inc) ;
 
-: align-stack ( n -- n' )
-    os macosx? cpu x86.64? or [ 16 align ] when ;
-
-HOOK: reserved-area-size cpu ( -- n )
-
-M: x86 stack-frame-size ( stack-frame -- i )
-    [ spill-counts>> [ swap reg-size * ] { } assoc>map sum ]
-    [ params>> ]
-    [ return>> ]
-    tri + +
-    3 cells +
-    reserved-area-size +
-    align-stack ;
-
 M: x86 %call ( word -- ) 0 CALL rc-relative rel-word-pic ;
 
 : xt-tail-pic-offset ( -- n )
@@ -492,29 +504,58 @@ M:: x86 %write-barrier ( src card# table -- )
     table table [] MOV
     table card# [+] card-mark <byte> MOV ;
 
-M: x86 %gc ( -- )
+:: check-nursery ( temp1 temp2 -- )
+    temp1 load-zone-ptr
+    temp2 temp1 cell [+] MOV
+    temp2 1024 ADD
+    temp1 temp1 3 cells [+] MOV
+    temp2 temp1 CMP ;
+
+GENERIC# save-gc-root 1 ( gc-root operand temp -- )
+
+M:: spill-slot save-gc-root ( gc-root spill-slot temp -- )
+    temp spill-slot n>> spill-integer@ MOV
+    gc-root gc-root@ temp MOV ;
+
+M:: word save-gc-root ( gc-root register temp -- )
+    gc-root gc-root@ register MOV ;
+
+: save-gc-roots ( gc-roots temp -- )
+    '[ _ save-gc-root ] assoc-each ;
+
+GENERIC# load-gc-root 1 ( gc-root operand temp -- )
+
+M:: spill-slot load-gc-root ( gc-root spill-slot temp -- )
+    temp gc-root gc-root@ MOV
+    spill-slot n>> spill-integer@ temp MOV ;
+
+M:: word load-gc-root ( gc-root register temp -- )
+    register gc-root gc-root@ MOV ;
+
+: load-gc-roots ( gc-roots temp -- )
+    '[ _ load-gc-root ] assoc-each ;
+
+:: call-gc ( gc-root-count -- )
+    ! Pass pointer to start of GC roots as first parameter
+    param-reg-1 gc-root-base param@ LEA
+    ! Pass number of roots as second parameter
+    param-reg-2 gc-root-count MOV
+    ! Call GC
+    %prepare-alien-invoke
+    "inline_gc" f %alien-invoke ;
+
+M:: x86 %gc ( temp1 temp2 gc-roots gc-root-count -- )
     "end" define-label
-    temp-reg-1 load-zone-ptr
-    temp-reg-2 temp-reg-1 cell [+] MOV
-    temp-reg-2 1024 ADD
-    temp-reg-1 temp-reg-1 3 cells [+] MOV
-    temp-reg-2 temp-reg-1 CMP
+    temp1 temp2 check-nursery
     "end" get JLE
-    %prepare-alien-invoke
-    "minor_gc" f %alien-invoke
+    gc-roots temp1 save-gc-roots
+    gc-root-count call-gc
+    gc-roots temp1 load-gc-roots
     "end" resolve-label ;
 
 M: x86 %alien-global
     [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
 
-HOOK: stack-reg cpu ( -- reg )
-
-: decr-stack-reg ( n -- )
-    dup 0 = [ drop ] [ stack-reg swap SUB ] if ;
-
-: incr-stack-reg ( n -- )
-    dup 0 = [ drop ] [ stack-reg swap ADD ] if ;
-
 M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
 
 :: %boolean ( dst temp word -- )
@@ -568,28 +609,6 @@ M: x86 %compare-float-branch ( label cc src1 src2 -- )
         { cc/= [ JNE ] }
     } case ;
 
-: stack@ ( n -- op ) stack-reg swap [+] ;
-
-: param@ ( n -- op ) reserved-area-size + stack@ ;
-
-: spill-integer-base ( stack-frame -- n )
-    [ params>> ] [ return>> ] bi + reserved-area-size + ;
-
-: spill-integer@ ( n -- op )
-    cells
-    stack-frame get spill-integer-base
-    + stack@ ;
-
-: spill-float-base ( stack-frame -- n )
-    [ spill-integer-base ]
-    [ spill-counts>> int-regs swap at int-regs reg-size * ]
-    bi + ;
-
-: spill-float@ ( n -- op )
-    double-float-regs reg-size *
-    stack-frame get spill-float-base
-    + stack@ ;
-
 M: x86 %spill-integer ( src n -- ) spill-integer@ swap MOV ;
 M: x86 %reload-integer ( dst n -- ) spill-integer@ MOV ;
 

diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor
index f2ccaad1b4439178339e786950cd5f7654bfa4a8..becfb6826d3ea7b0da0b1d5fd0b30d3ac46f8e6b 100644 (file)
--- a/basis/heaps/heaps.factor
+++ b/basis/heaps/heaps.factor
@@ -192,6 +192,9 @@ M: heap heap-pop ( heap -- value key )
     [ dup heap-pop swap 2array ]
     produce nip ;
 
+: heap-values ( heap -- alist )
+    data>> [ value>> ] { } map-as ;
+
 : slurp-heap ( heap quot: ( elt -- ) -- )
     over heap-empty? [ 2drop ] [
         [ [ heap-pop drop ] dip call ] [ slurp-heap ] 2bi

diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp
index bcf6387639dd3645d4b55243254f104d013efea6..6631a046acd21e6f33a871accc91d35af1cdfebc 100755 (executable)
--- a/vm/data_gc.cpp
+++ b/vm/data_gc.cpp
@@ -680,9 +680,15 @@ PRIMITIVE(become)
        compile_all_words();
 }
 
-VM_C_API void minor_gc()
+VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size)
 {
+       for(cell i = 0; i < gc_roots_size; i++)
+               gc_local_push((cell)&gc_roots_base[i]);
+
        garbage_collection(data->nursery(),false,0);
+
+       for(cell i = 0; i < gc_roots_size; i++)
+               gc_local_pop();
 }
 
 }

diff --git a/vm/data_gc.hpp b/vm/data_gc.hpp
index 2d6a1ab897c1b360110da7dc5caee64dbd501903..334ad5a2bb572659147d6621f5f86660acade3c7 100755 (executable)
--- a/vm/data_gc.hpp
+++ b/vm/data_gc.hpp
@@ -143,6 +143,6 @@ inline static void check_tagged_pointer(cell tagged)
 #endif
 }
 
-VM_C_API void minor_gc();
+VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size);
 
 }