diff --git a/core/compiler/compiler.factor b/core/compiler/compiler.factor index 0be3aa5362..e83fbd925c 100755 --- a/core/compiler/compiler.factor +++ b/core/compiler/compiler.factor @@ -57,7 +57,7 @@ compiled-crossref global [ H{ } assoc-like ] change-at ] computing-dependencies ; : compile-failed ( word error -- ) - dup inference-error? [ rethrow ] unless + ! dup inference-error? [ rethrow ] unless f pick compiled get set-at swap compiler-error ; diff --git a/core/compiler/errors/errors.factor b/core/compiler/errors/errors.factor index 106b69893b..c53937b9d9 100755 --- a/core/compiler/errors/errors.factor +++ b/core/compiler/errors/errors.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007 Slava Pestov. +! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces assocs prettyprint io sequences sorting continuations debugger math ; @@ -24,6 +24,8 @@ SYMBOL: with-compiler-errors? GENERIC: compiler-warning? ( error -- ? ) +M: object compiler-warning? drop f ; + : (:errors) ( -- assoc ) compiler-errors get-global [ nip compiler-warning? not ] assoc-subset ; diff --git a/core/cpu/ppc/architecture/architecture.factor b/core/cpu/ppc/architecture/architecture.factor index 8bd9ca505d..e93d092b10 100755 --- a/core/cpu/ppc/architecture/architecture.factor +++ b/core/cpu/ppc/architecture/architecture.factor @@ -3,7 +3,8 @@ USING: alien.c-types cpu.ppc.assembler cpu.architecture generic kernel kernel.private math memory namespaces sequences words assocs generator generator.registers generator.fixup system -layouts classes words.private alien combinators ; +layouts classes words.private alien combinators +compiler.constants ; IN: cpu.ppc.architecture TUPLE: ppc-backend ; @@ -37,7 +38,7 @@ TUPLE: ppc-backend ; : local@ ( n -- x ) reserved-area-size param-save-size + + ; inline -: factor-area-size 4 cells ; +: factor-area-size 2 cells ; : next-save ( n -- i ) cell - ; @@ -77,7 +78,7 @@ M: ppc-backend load-indirect ( obj reg -- ) dup 0 LWZ ; M: ppc-backend %save-word-xt ( -- ) - 0 11 LOAD32 rc-absolute-ppc-2/2 rel-current-word ; + 0 11 LOAD32 rc-absolute-ppc-2/2 rel-this ; M: ppc-backend %prologue ( n -- ) 0 MFLR @@ -99,35 +100,15 @@ M: ppc-backend %epilogue ( n -- ) : %load-dlsym ( symbol dll register -- ) 0 swap LOAD32 rc-absolute-ppc-2/2 rel-dlsym ; -M: ppc-backend %profiler-prologue ( word -- ) - 3 load-indirect - 4 3 profile-count-offset LWZ - 4 4 1 v>operand ADDI - 4 3 profile-count-offset STW ; - M: ppc-backend %call-label ( label -- ) BL ; M: ppc-backend %jump-label ( label -- ) B ; -: %prepare-primitive ( word -- ) - #! Save stack pointer to stack_chain->callstack_top, load XT - 4 1 MR - 0 11 LOAD32 - rc-absolute-ppc-2/2 rel-word ; - -: (%call) 11 MTLR BLRL ; - -M: ppc-backend %call-primitive ( word -- ) - %prepare-primitive (%call) ; - -: (%jump) 11 MTCTR BCTR ; - -M: ppc-backend %jump-primitive ( word -- ) - %prepare-primitive (%jump) ; - M: ppc-backend %jump-t ( label -- ) 0 "flag" operand f v>operand CMPI BNE ; +: (%call) 11 MTLR BLRL ; + : dispatch-template ( word-table# quot -- ) [ >r @@ -145,7 +126,7 @@ M: ppc-backend %call-dispatch ( word-table# -- ) [ (%call) ] dispatch-template ; M: ppc-backend %jump-dispatch ( word-table# -- ) - [ %epilogue-later (%jump) ] dispatch-template ; + [ %epilogue-later 11 MTCTR BCTR ] dispatch-template ; M: ppc-backend %return ( -- ) %epilogue-later BLR ; diff --git a/core/cpu/ppc/bootstrap.factor b/core/cpu/ppc/bootstrap.factor index 616f77c3da..dcaee7290a 100755 --- a/core/cpu/ppc/bootstrap.factor +++ b/core/cpu/ppc/bootstrap.factor @@ -29,7 +29,7 @@ big-endian on temp-reg dup 0 LWZ ! Bump profiling counter aux-reg temp-reg profile-count-offset LWZ - aux-reg dup 1 tag-fixnum ADD + aux-reg dup 1 tag-fixnum ADDI aux-reg temp-reg profile-count-offset STW ! Load word->code aux-reg temp-reg word-code-offset LWZ diff --git a/core/cpu/ppc/intrinsics/intrinsics.factor b/core/cpu/ppc/intrinsics/intrinsics.factor index e1d86db178..86db66a61f 100755 --- a/core/cpu/ppc/intrinsics/intrinsics.factor +++ b/core/cpu/ppc/intrinsics/intrinsics.factor @@ -8,7 +8,7 @@ generator generator.registers generator.fixup sequences.private sbufs vectors system layouts math.floats.private classes tuples tuples.private sbufs.private vectors.private strings.private slots.private combinators bit-arrays -float-arrays ; +float-arrays compiler.constants ; IN: cpu.ppc.intrinsics : %slot-literal-known-tag diff --git a/core/cpu/ppc/ppc.factor b/core/cpu/ppc/ppc.factor index 0c677cbe51..901b339d7e 100755 --- a/core/cpu/ppc/ppc.factor +++ b/core/cpu/ppc/ppc.factor @@ -13,5 +13,3 @@ namespaces alien.c-types kernel system combinators ; } cond T{ ppc-backend } compiler-backend set-global - -6 cells profiler-prologue set-global diff --git a/vm/callstack.c b/vm/callstack.c index 762dabe07e..25219d1569 100755 --- a/vm/callstack.c +++ b/vm/callstack.c @@ -216,8 +216,7 @@ DEFINE_PRIMITIVE(set_innermost_stack_frame_quot) REGISTER_UNTAGGED(callstack); REGISTER_UNTAGGED(quot); - if(quot->compiledp == F) - jit_compile(tag_object(quot)); + jit_compile(tag_object(quot),true); UNREGISTER_UNTAGGED(quot); UNREGISTER_UNTAGGED(callstack); diff --git a/vm/code_heap.c b/vm/code_heap.c index ecce29229f..7cfdffe8ca 100755 --- a/vm/code_heap.c +++ b/vm/code_heap.c @@ -303,10 +303,10 @@ void set_word_code(F_WORD *word, F_COMPILED *compiled) } /* Allocates memory */ -void default_word_code(F_WORD *word) +void default_word_code(F_WORD *word, bool relocate) { REGISTER_UNTAGGED(word); - jit_compile(word->def); + jit_compile(word->def,relocate); UNREGISTER_UNTAGGED(word); word->code = untag_quotation(word->def)->code; @@ -336,7 +336,7 @@ DEFINE_PRIMITIVE(modify_code_heap) { REGISTER_UNTAGGED(alist); REGISTER_UNTAGGED(word); - default_word_code(word); + default_word_code(word,false); UNREGISTER_UNTAGGED(word); UNREGISTER_UNTAGGED(alist); } diff --git a/vm/code_heap.h b/vm/code_heap.h index e741cf1a75..c8e41d3fbe 100755 --- a/vm/code_heap.h +++ b/vm/code_heap.h @@ -56,7 +56,7 @@ typedef struct { void relocate_code_block(F_COMPILED *relocating, CELL code_start, CELL reloc_start, CELL literals_start, CELL words_start, CELL words_end); -void default_word_code(F_WORD *word); +void default_word_code(F_WORD *word, bool relocate); void set_word_code(F_WORD *word, F_COMPILED *compiled); diff --git a/vm/factor.c b/vm/factor.c index d8fdad4dfd..0754067b95 100755 --- a/vm/factor.c +++ b/vm/factor.c @@ -44,7 +44,7 @@ void do_stage1_init(void) if(type_of(obj) == WORD_TYPE) { F_WORD *word = untag_object(obj); - default_word_code(word); + default_word_code(word,false); update_word_xt(word); } } diff --git a/vm/profiler.c b/vm/profiler.c index 402f7e2a0d..f9dbda860a 100755 --- a/vm/profiler.c +++ b/vm/profiler.c @@ -13,7 +13,7 @@ F_COMPILED *compile_profiling_stub(F_WORD *word) CELL rel_type = allot_cell(to_fixnum(array_nth(quadruple,2)) | (to_fixnum(array_nth(quadruple,1)) << 8)); - CELL rel_offset = array_nth(quadruple,3); + CELL rel_offset = array_nth(quadruple,3) * compiled_code_format(); CELL relocation = allot_array_2(rel_type,rel_offset); diff --git a/vm/quotations.c b/vm/quotations.c index b1948fa8a8..1e3fa8a47a 100755 --- a/vm/quotations.c +++ b/vm/quotations.c @@ -52,7 +52,7 @@ F_REL rel_to_emit(CELL name, CELL code_format, CELL code_length, rel.type = to_fixnum(rel_type) | (to_fixnum(rel_class) << 8) | (rel_argument << 16); - rel.offset = code_length * code_format + to_fixnum(offset); + rel.offset = (code_length + to_fixnum(offset)) * code_format; } return rel; @@ -95,7 +95,7 @@ void set_quot_xt(F_QUOTATION *quot, F_COMPILED *code) } /* Might GC */ -void jit_compile(CELL quot) +void jit_compile(CELL quot, bool relocate) { if(untag_quotation(quot)->compiledp != F) return; @@ -230,11 +230,10 @@ void jit_compile(CELL quot) untag_object(words), untag_object(literals)); - /* We must do this before relocate_code_block(), so that - relocation knows the quotation's XT. */ set_quot_xt(untag_object(quot),compiled); - iterate_code_heap_step(compiled,relocate_code_block); + if(relocate) + iterate_code_heap_step(compiled,relocate_code_block); UNREGISTER_ROOT(words); UNREGISTER_ROOT(literals); @@ -352,7 +351,7 @@ F_FASTCALL CELL primitive_jit_compile(CELL quot, F_STACK_FRAME *stack) { stack_chain->callstack_top = stack; REGISTER_ROOT(quot); - jit_compile(quot); + jit_compile(quot,true); UNREGISTER_ROOT(quot); return quot; } diff --git a/vm/quotations.h b/vm/quotations.h index 0466ff1f9b..d975d9e0f5 100755 --- a/vm/quotations.h +++ b/vm/quotations.h @@ -1,5 +1,5 @@ void set_quot_xt(F_QUOTATION *quot, F_COMPILED *code); -void jit_compile(CELL quot); +void jit_compile(CELL quot, bool relocate); F_FASTCALL CELL primitive_jit_compile(CELL quot, F_STACK_FRAME *stack); F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset); void uncurry(CELL obj); diff --git a/vm/types.c b/vm/types.c index 70d754caea..d70c1623f4 100755 --- a/vm/types.c +++ b/vm/types.c @@ -511,7 +511,7 @@ F_WORD *allot_word(CELL vocab, CELL name) word->profiling = NULL; REGISTER_UNTAGGED(word); - default_word_code(word); + default_word_code(word,true); UNREGISTER_UNTAGGED(word); REGISTER_UNTAGGED(word);