PowerPC support work in progress

db4
Slava Pestov 2008-01-09 01:33:40 -05:00
parent 85c9f78790
commit 028e0075d8
14 changed files with 27 additions and 48 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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);
}

View File

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

View File

@ -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);
}
}

View File

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

View File

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

View File

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

View File

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