Move a bunch of GC check generation logic to platform-independent side

basis/compiler/codegen/codegen.factor

@@ -4,7 +4,7 @@ USING: namespaces make math math.order math.parser sequences accessors
 kernel kernel.private layouts assocs words summary arrays
 combinators classes.algebra alien alien.c-types alien.structs
 alien.strings alien.arrays alien.complex alien.libraries sets libc
-continuations.private fry cpu.architecture classes
+continuations.private fry cpu.architecture classes locals
 source-files.errors
 compiler.errors
 compiler.alien
@@ -215,14 +215,44 @@ M: ##write-barrier generate-insn
     [ table>> ]
     tri %write-barrier ;
 
+! GC checks
+: wipe-locs ( locs temp -- )
+    '[
+        _
+        [ 0 %load-immediate ]
+        [ swap [ %replace ] with each ] bi
+    ] unless-empty ;
+
+GENERIC# save-gc-root 1 ( gc-root operand temp -- )
+
+M:: spill-slot save-gc-root ( gc-root operand temp -- )
+    temp operand n>> %reload-integer
+    gc-root temp %save-gc-root ;
+
+M: object save-gc-root drop %save-gc-root ;
+
+: 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 operand temp -- )
+    gc-root temp %load-gc-root
+    temp operand n>> %spill-integer ;
+
+M: object load-gc-root drop %load-gc-root ;
+
+: load-gc-roots ( gc-roots temp -- ) '[ _ load-gc-root ] assoc-each ;
+
 M: _gc generate-insn
+    "no-gc" define-label
     {
-        [ temp1>> ]
+        [ [ "no-gc" get ] dip [ temp1>> ] [ temp2>> ] bi %check-nursery ]
-        [ temp2>> ]
+        [ [ uninitialized-locs>> ] [ temp1>> ] bi wipe-locs ]
-        [ gc-roots>> ]
+        [ [ gc-roots>> ] [ temp1>> ] bi save-gc-roots ]
-        [ gc-root-count>> ]
+        [ gc-root-count>> %call-gc ]
-        [ uninitialized-locs>> ]
+        [ [ gc-roots>> ] [ temp1>> ] bi load-gc-roots ]
-    } cleave %gc ;
+    } cleave
+    "no-gc" resolve-label ;
 
 M: _loop-entry generate-insn drop %loop-entry ;
 

basis/cpu/architecture/architecture.factor

@@ -128,7 +128,12 @@ HOOK: %alien-global cpu ( dst symbol library -- )
 
 HOOK: %allot cpu ( dst size class temp -- )
 HOOK: %write-barrier cpu ( src card# table -- )
-HOOK: %gc cpu ( temp1 temp2 live-registers live-spill-slots uninitialized-locs -- )
+
+! GC checks
+HOOK: %check-nursery cpu ( label temp1 temp2 -- )
+HOOK: %save-gc-root cpu ( gc-root register -- )
+HOOK: %load-gc-root cpu ( gc-root register -- )
+HOOK: %call-gc cpu ( gc-root-count -- )
 
 HOOK: %prologue cpu ( n -- )
 HOOK: %epilogue cpu ( n -- )

basis/cpu/x86/x86.factor

@@ -435,42 +435,19 @@ M:: x86 %write-barrier ( src card# table -- )
     table table [] MOV
     table card# [+] card-mark <byte> MOV ;
 
-:: check-nursery ( temp1 temp2 -- )
+M:: x86 %check-nursery ( label temp1 temp2 -- )
     temp1 load-zone-ptr
     temp2 temp1 cell [+] MOV
     temp2 1024 ADD
     temp1 temp1 3 cells [+] MOV
-    temp2 temp1 CMP ;
+    temp2 temp1 CMP
+    label JLE ;
 
-GENERIC# save-gc-root 1 ( gc-root operand temp -- )
+M: x86 %save-gc-root ( gc-root register -- ) [ gc-root@ ] dip MOV ;
 
-M:: spill-slot save-gc-root ( gc-root spill-slot temp -- )
+M: x86 %load-gc-root ( gc-root register -- ) swap gc-root@ MOV ;
-    temp spill-slot n>> spill-integer@ MOV
-    gc-root gc-root@ temp MOV ;
 
-M:: word save-gc-root ( gc-root register temp -- )
+M:: x86 %call-gc ( gc-root-count -- )
-    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 ;
-
-: wipe-locs ( locs -- )
-    ! See explanation in compiler.cfg.stacks.uninitialized
-    [ 0 ] dip [ %replace ] with 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
@@ -479,16 +456,6 @@ M:: word load-gc-root ( gc-root register temp -- )
     %prepare-alien-invoke
     "inline_gc" f %alien-invoke ;
 
-M:: x86 %gc ( temp1 temp2 gc-roots gc-root-count uninitialized-locs -- )
-    "end" define-label
-    temp1 temp2 check-nursery
-    "end" get JLE
-    gc-roots temp1 save-gc-roots
-    uninitialized-locs wipe-locs
-    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 ;