PowerPC support work in progress
							parent
							
								
									85c9f78790
								
							
						
					
					
						commit
						028e0075d8
					
				| 
						 | 
				
			
			@ -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 ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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);
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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);
 | 
			
		||||
		}
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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);
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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);
 | 
			
		||||
		}
 | 
			
		||||
	}
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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);
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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;
 | 
			
		||||
}
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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);
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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);
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue