Fix inline GC check
parent
4de33f68cc
commit
3c149fecf0
|
@ -9,7 +9,6 @@
|
||||||
- x86: load-allot-ptr doesn't have a stack effect? why?
|
- x86: load-allot-ptr doesn't have a stack effect? why?
|
||||||
- mov 0x0(%esi),%ecx why?
|
- mov 0x0(%esi),%ecx why?
|
||||||
- mac intel: perhaps its not a good idea using ebx as allot-tmp-reg
|
- mac intel: perhaps its not a good idea using ebx as allot-tmp-reg
|
||||||
- RNG is broken
|
|
||||||
- %allot-bignum-signed-2 still has issues on ppc
|
- %allot-bignum-signed-2 still has issues on ppc
|
||||||
- fix %allot-bignum-signed-1/2 on x86
|
- fix %allot-bignum-signed-1/2 on x86
|
||||||
|
|
||||||
|
|
|
@ -5,7 +5,7 @@ USING: arrays generic hashtables inference io kernel math
|
||||||
namespaces prettyprint sequences vectors words ;
|
namespaces prettyprint sequences vectors words ;
|
||||||
|
|
||||||
! Set this to t so that end-basic-block compiles a GC check
|
! Set this to t so that end-basic-block compiles a GC check
|
||||||
SYMBOL: maybe-gc
|
: maybe-gc ( n -- ) \ maybe-gc get push ;
|
||||||
|
|
||||||
! Register allocation
|
! Register allocation
|
||||||
|
|
||||||
|
@ -136,10 +136,12 @@ SYMBOL: phantom-r
|
||||||
|
|
||||||
: end-basic-block ( -- )
|
: end-basic-block ( -- )
|
||||||
finalize-contents finalize-heights
|
finalize-contents finalize-heights
|
||||||
maybe-gc get [
|
\ maybe-gc get dup empty? [
|
||||||
maybe-gc off
|
drop
|
||||||
|
] [
|
||||||
|
delete-all
|
||||||
"simple_gc" f %alien-invoke
|
"simple_gc" f %alien-invoke
|
||||||
] when ;
|
] if ;
|
||||||
|
|
||||||
: used-vregs ( -- seq ) phantoms append [ vreg? ] subset ;
|
: used-vregs ( -- seq ) phantoms append [ vreg? ] subset ;
|
||||||
|
|
||||||
|
@ -154,13 +156,14 @@ SYMBOL: phantom-r
|
||||||
drop ;
|
drop ;
|
||||||
|
|
||||||
: init-templates ( -- )
|
: init-templates ( -- )
|
||||||
maybe-gc off
|
V{ } clone \ maybe-gc set
|
||||||
<phantom-datastack> phantom-d set
|
<phantom-datastack> phantom-d set
|
||||||
<phantom-callstack> phantom-r set
|
<phantom-callstack> phantom-r set
|
||||||
compute-free-vregs ;
|
compute-free-vregs ;
|
||||||
|
|
||||||
: keep-templates ( quot -- )
|
: keep-templates ( quot -- )
|
||||||
[
|
[
|
||||||
|
V{ } clone \ maybe-gc set
|
||||||
phantom-d [ clone ] change
|
phantom-d [ clone ] change
|
||||||
phantom-r [ clone ] change
|
phantom-r [ clone ] change
|
||||||
compute-free-vregs
|
compute-free-vregs
|
||||||
|
|
|
@ -9,7 +9,7 @@ USING: kernel assembler kernel-internals namespaces math ;
|
||||||
: %allot ( header size -- )
|
: %allot ( header size -- )
|
||||||
#! Store a pointer to 'size' bytes allocated from the
|
#! Store a pointer to 'size' bytes allocated from the
|
||||||
#! nursery in r11.
|
#! nursery in r11.
|
||||||
maybe-gc on
|
dup maybe-gc
|
||||||
8 align ! align the size
|
8 align ! align the size
|
||||||
12 load-zone-ptr ! nusery -> r12
|
12 load-zone-ptr ! nusery -> r12
|
||||||
11 12 cell LWZ ! nursery.here -> r11
|
11 12 cell LWZ ! nursery.here -> r11
|
||||||
|
|
|
@ -21,7 +21,7 @@ USING: kernel assembler kernel-internals namespaces math ;
|
||||||
allot-tmp-reg [] swap tag-header MOV ;
|
allot-tmp-reg [] swap tag-header MOV ;
|
||||||
|
|
||||||
: %allot ( header size quot -- )
|
: %allot ( header size quot -- )
|
||||||
maybe-gc on
|
dup maybe-gc
|
||||||
swap >r >r
|
swap >r >r
|
||||||
allot-tmp-reg PUSH
|
allot-tmp-reg PUSH
|
||||||
load-allot-ptr
|
load-allot-ptr
|
||||||
|
|
Loading…
Reference in New Issue