Fix inline GC check

slava 2006-11-09 05:15:02 +00:00
parent 4de33f68cc
commit 3c149fecf0
4 changed files with 10 additions and 8 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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