diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index c387c4ed8d..672ed9ce02 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/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>> ] - [ temp2>> ] - [ gc-roots>> ] - [ gc-root-count>> ] - [ uninitialized-locs>> ] - } cleave %gc ; + [ [ "no-gc" get ] dip [ temp1>> ] [ temp2>> ] bi %check-nursery ] + [ [ uninitialized-locs>> ] [ temp1>> ] bi wipe-locs ] + [ [ gc-roots>> ] [ temp1>> ] bi save-gc-roots ] + [ gc-root-count>> %call-gc ] + [ [ gc-roots>> ] [ temp1>> ] bi load-gc-roots ] + } cleave + "no-gc" resolve-label ; M: _loop-entry generate-insn drop %loop-entry ; diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index b22e91056f..e4c8f3246d 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/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 -- ) diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 4fad6d4efc..34b1b63581 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -435,42 +435,19 @@ M:: x86 %write-barrier ( src card# table -- ) table table [] MOV table card# [+] card-mark 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 -- ) - temp spill-slot n>> spill-integer@ MOV - gc-root gc-root@ temp MOV ; +M: x86 %load-gc-root ( gc-root register -- ) swap gc-root@ 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 ; - -: wipe-locs ( locs -- ) - ! See explanation in compiler.cfg.stacks.uninitialized - [ 0 ] dip [ %replace ] with each ; - -:: call-gc ( gc-root-count -- ) +M:: x86 %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 ;