steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Update non-optimizing compiler for new PowerPC calling convention

release
Slava Pestov 2007-10-05 04:17:38 -04:00
parent 1fc02ab69d
commit 6fb134f1aa
11 changed files with 78 additions and 159 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

100
core/cpu/ppc/bootstrap.factor
View File

@ -17,85 +17,85 @@ big-endian on
: temp-reg 6 ; : temp-reg 6 ;
: xt-reg 11 ; : xt-reg 11 ;
: param-save-size 8 bootstrap-cells ; : factor-area-size 4 bootstrap-cells ;
: local@
bootstrap-cells reserved-area-size param-save-size + + ;
: array-save 0 local@ ;
: scan-save 1 local@ ;
: xt-save 2 local@ ;
: stack-frame : stack-frame
3 local@ 4 bootstrap-cells align ; factor-area-size c-area-size + 4 bootstrap-cells align ;
: next-save stack-frame bootstrap-cell - ;
: xt-save stack-frame 2 bootstrap-cells - ;
: scan-save stack-frame 3 bootstrap-cells - ;
: array-save stack-frame 4 bootstrap-cells - ;
[ [
temp-reg quot-reg quot-array@ LWZ ! load array temp-reg quot-reg quot-array@ LWZ ! load array
scan-reg temp-reg scan@ ADDI ! initialize scan pointer scan-reg temp-reg scan@ ADDI ! initialize scan pointer
] { } make jit-setup set ] { } make jit-setup set
[ [
1 1 stack-frame neg STWU ! store back link 0 MFLR
0 MFLR ! load return address into r0 1 1 stack-frame neg ADDI
temp-reg 1 array-save STW ! save array xt-reg 1 xt-save STW ! save XT
xt-reg 1 xt-save STW ! save XT xt-reg 1 factor-area-size neg ADDI
0 1 lr-save stack-frame + STW ! save return address xt-reg 1 next-save STW ! save forward chain pointer
temp-reg 1 array-save STW ! save array
0 1 lr-save stack-frame + STW ! save return address
] { } make jit-prolog set ] { } make jit-prolog set
[ [
temp-reg scan-reg 4 LWZU ! load literal and advance temp-reg scan-reg 4 LWZU ! load literal and advance
temp-reg ds-reg 4 STWU ! push literal temp-reg ds-reg 4 STWU ! push literal
] { } make jit-push-literal set ] { } make jit-push-literal set
[ [
temp-reg scan-reg 4 LWZU ! load wrapper and advance temp-reg scan-reg 4 LWZU ! load wrapper and advance
temp-reg dup wrapper@ LWZ ! load wrapped object temp-reg dup wrapper@ LWZ ! load wrapped object
temp-reg ds-reg 4 STWU ! push wrapped object temp-reg ds-reg 4 STWU ! push wrapped object
] { } make jit-push-wrapper set ] { } make jit-push-wrapper set
[ [
4 1 MR ! pass stack pointer to primitive 4 1 MR ! pass stack pointer to primitive
] { } make jit-word-primitive-jump set ] { } make jit-word-primitive-jump set
[ [
4 1 MR ! pass stack pointer to primitive 4 1 MR ! pass stack pointer to primitive
] { } make jit-word-primitive-call set ] { } make jit-word-primitive-call set
: load-xt ( -- ) : load-xt ( -- )
xt-reg word-reg word-xt@ LWZ ; xt-reg word-reg word-xt@ LWZ ;
: jit-call : jit-call
scan-reg 1 scan-save STW ! save scan pointer scan-reg 1 scan-save STW ! save scan pointer
xt-reg MTLR ! pass XT to callee xt-reg MTLR ! pass XT to callee
BLRL ! call BLRL ! call
scan-reg 1 scan-save LWZ ! restore scan pointer scan-reg 1 scan-save LWZ ! restore scan pointer
; ;
: jit-jump : jit-jump
xt-reg MTCTR BCTR ; xt-reg MTCTR BCTR ;
[ [
word-reg scan-reg 4 LWZU ! load word and advance word-reg scan-reg 4 LWZU ! load word and advance
load-xt load-xt
jit-call jit-call
] { } make jit-word-call set ] { } make jit-word-call set
[ [
word-reg scan-reg 4 LWZ ! load word word-reg scan-reg 4 LWZ ! load word
load-xt ! jump to word XT load-xt ! jump to word XT
jit-jump jit-jump
] { } make jit-word-jump set ] { } make jit-word-jump set
: load-branch : load-branch
temp-reg ds-reg 0 LWZ ! load boolean temp-reg ds-reg 0 LWZ ! load boolean
0 temp-reg \ f tag-number CMPI ! compare it with f 0 temp-reg \ f tag-number CMPI ! compare it with f
quot-reg scan-reg MR ! point quot-reg at false branch quot-reg scan-reg MR ! point quot-reg at false branch
2 BNE ! skip next insn if its not f 2 BNE ! skip next insn if its not f
quot-reg dup 4 ADDI ! point quot-reg at true branch quot-reg dup 4 ADDI ! point quot-reg at true branch
quot-reg dup 4 LWZ ! load the branch quot-reg dup 4 LWZ ! load the branch
ds-reg dup 4 SUBI ! pop boolean ds-reg dup 4 SUBI ! pop boolean
scan-reg dup 12 ADDI ! advance scan pointer scan-reg dup 12 ADDI ! advance scan pointer
xt-reg quot-reg quot-xt@ LWZ ! load quotation-xt xt-reg quot-reg quot-xt@ LWZ ! load quotation-xt
; ;
[ [
@ -107,20 +107,20 @@ big-endian on
] { } make jit-if-call set ] { } make jit-if-call set
[ [
temp-reg ds-reg 0 LWZ ! load index temp-reg ds-reg 0 LWZ ! load index
temp-reg dup 1 SRAWI ! turn it into an array offset temp-reg dup 1 SRAWI ! turn it into an array offset
ds-reg dup 4 SUBI ! pop index ds-reg dup 4 SUBI ! pop index
scan-reg dup 4 LWZ ! load array scan-reg dup 4 LWZ ! load array
temp-reg dup scan-reg ADD ! compute quotation location temp-reg dup scan-reg ADD ! compute quotation location
quot-reg temp-reg array-start LWZ ! load quotation quot-reg temp-reg array-start LWZ ! load quotation
xt-reg quot-reg quot-xt@ LWZ ! load quotation-xt xt-reg quot-reg quot-xt@ LWZ ! load quotation-xt
jit-jump ! execute quotation jit-jump ! execute quotation
] { } make jit-dispatch set ] { } make jit-dispatch set
[ [
0 1 lr-save stack-frame + LWZ ! load return address 0 1 lr-save stack-frame + LWZ ! load return address
1 1 stack-frame ADDI ! pop stack frame 1 1 stack-frame ADDI ! pop stack frame
0 MTLR ! get ready to return 0 MTLR ! get ready to return
] { } make jit-epilog set ] { } make jit-epilog set
[ BLR ] { } make jit-return set [ BLR ] { } make jit-return set

2
core/cpu/ppc/linux/bootstrap.factor
View File

@ -3,7 +3,7 @@
USING: parser layouts system ; USING: parser layouts system ;
IN: bootstrap.ppc IN: bootstrap.ppc
: reserved-area-size 2 bootstrap-cells ; : c-area-size 10 bootstrap-cells ;
: lr-save bootstrap-cell ; : lr-save bootstrap-cell ;
"resource:core/cpu/ppc/bootstrap.factor" run-file "resource:core/cpu/ppc/bootstrap.factor" run-file

2
core/cpu/ppc/macosx/bootstrap.factor
View File

@ -3,7 +3,7 @@
USING: parser layouts system ; USING: parser layouts system ;
IN: bootstrap.ppc IN: bootstrap.ppc
: reserved-area-size 6 bootstrap-cells ; : c-area-size 14 bootstrap-cells ;
: lr-save 2 bootstrap-cells ; : lr-save 2 bootstrap-cells ;
"resource:core/cpu/ppc/bootstrap.factor" run-file "resource:core/cpu/ppc/bootstrap.factor" run-file

38
vm/callstack.c
View File

@ -12,15 +12,9 @@ void iterate_callstack(CELL top, CELL bottom, CELL base, CALLSTACK_ITER iterator
{ {
CELL delta = (bottom - base); CELL delta = (bottom - base);
#ifdef CALLSTACK_UP_P
F_STACK_FRAME *frame = (F_STACK_FRAME *)bottom - 1; F_STACK_FRAME *frame = (F_STACK_FRAME *)bottom - 1;
#define ITERATING_P (CELL)frame >= top
#else
F_STACK_FRAME *frame = (F_STACK_FRAME *)top;
#define ITERATING_P (CELL)frame < bottom
#endif
while(ITERATING_P) while((CELL)frame >= top)
{ {
F_STACK_FRAME *next = REBASE_FRAME_SUCCESSOR(frame,delta); F_STACK_FRAME *next = REBASE_FRAME_SUCCESSOR(frame,delta);
iterator(frame); iterator(frame);
@ -55,7 +49,6 @@ called by continuation implementation, and user code shouldn't
be calling it at all, so we leave it as it is for now. */ be calling it at all, so we leave it as it is for now. */
F_STACK_FRAME *capture_start(void) F_STACK_FRAME *capture_start(void)
{ {
#ifdef CALLSTACK_UP_P
F_STACK_FRAME *frame = stack_chain->callstack_bottom - 1; F_STACK_FRAME *frame = stack_chain->callstack_bottom - 1;
while(frame >= stack_chain->callstack_top while(frame >= stack_chain->callstack_top
&& FRAME_SUCCESSOR(frame) >= stack_chain->callstack_top) && FRAME_SUCCESSOR(frame) >= stack_chain->callstack_top)
@ -63,9 +56,6 @@ F_STACK_FRAME *capture_start(void)
frame = FRAME_SUCCESSOR(frame); frame = FRAME_SUCCESSOR(frame);
} }
return frame + 1; return frame + 1;
#else
return FRAME_SUCCESSOR(stack_chain->callstack_top);
#endif
} }
DEFINE_PRIMITIVE(callstack) DEFINE_PRIMITIVE(callstack)
@ -152,13 +142,8 @@ CELL frame_scan(F_STACK_FRAME *frame)
void stack_frame_to_array(F_STACK_FRAME *frame) void stack_frame_to_array(F_STACK_FRAME *frame)
{ {
#ifdef CALLSTACK_UP_P
set_array_nth(array,frame_index++,frame_executing(frame)); set_array_nth(array,frame_index++,frame_executing(frame));
set_array_nth(array,frame_index++,frame_scan(frame)); set_array_nth(array,frame_index++,frame_scan(frame));
#else
set_array_nth(array,frame_index--,frame_scan(frame));
set_array_nth(array,frame_index--,frame_executing(frame));
#endif
} }
DEFINE_PRIMITIVE(callstack_to_array) DEFINE_PRIMITIVE(callstack_to_array)
@ -174,11 +159,7 @@ DEFINE_PRIMITIVE(callstack_to_array)
/* frame_count is equal to the total length now */ /* frame_count is equal to the total length now */
#ifdef CALLSTACK_UP_P
frame_index = 0; frame_index = 0;
#else
frame_index = frame_count - 1;
#endif
iterate_callstack_object(stack,stack_frame_to_array); iterate_callstack_object(stack,stack_frame_to_array);
@ -187,7 +168,6 @@ DEFINE_PRIMITIVE(callstack_to_array)
F_STACK_FRAME *innermost_stack_frame(F_CALLSTACK *callstack) F_STACK_FRAME *innermost_stack_frame(F_CALLSTACK *callstack)
{ {
#ifdef CALLSTACK_UP_P
CELL top = (CELL)(callstack + 1); CELL top = (CELL)(callstack + 1);
CELL bottom = top + untag_fixnum_fast(callstack->length); CELL bottom = top + untag_fixnum_fast(callstack->length);
CELL base = callstack->bottom; CELL base = callstack->bottom;
@ -200,9 +180,6 @@ F_STACK_FRAME *innermost_stack_frame(F_CALLSTACK *callstack)
frame = REBASE_FRAME_SUCCESSOR(frame,delta); frame = REBASE_FRAME_SUCCESSOR(frame,delta);
return frame; return frame;
#else
return FIRST_STACK_FRAME(callstack);
#endif
} }
/* Some primitives implementing a limited form of callstack mutation. /* Some primitives implementing a limited form of callstack mutation.
@ -244,26 +221,17 @@ DEFINE_PRIMITIVE(set_innermost_stack_frame_quot)
CELL scan = inner->scan - inner->array; CELL scan = inner->scan - inner->array;
#ifdef CALLSTACK_UP_P
CELL top = (CELL)(callstack + 1); CELL top = (CELL)(callstack + 1);
CELL bottom = top + untag_fixnum_fast(callstack->length); CELL bottom = top + untag_fixnum_fast(callstack->length);
CELL base = callstack->bottom; CELL base = callstack->bottom;
CELL delta = (bottom - base); CELL delta = (bottom - base);
F_STACK_FRAME *next = REBASE_FRAME_SUCCESSOR(inner,delta); CELL offset = FRAME_RETURN_ADDRESS(inner,delta) - inner->xt;
CELL offset = *(XT *)(next + 1) - inner->xt;
#else
CELL offset = inner->return_address - inner->xt;
#endif
inner->array = quot->array; inner->array = quot->array;
inner->scan = quot->array + scan; inner->scan = quot->array + scan;
inner->xt = quot->xt; inner->xt = quot->xt;
#ifdef CALLSTACK_UP_P FRAME_RETURN_ADDRESS(inner,delta) = quot->xt + offset;
*(XT *)(next + 1) = quot->xt + offset;
#else
inner->return_address = quot->xt + offset;
#endif
} }

1
vm/callstack.h
View File

@ -2,6 +2,7 @@ F_FASTCALL void save_callstack_bottom(F_STACK_FRAME *callstack_bottom);
#define FIRST_STACK_FRAME(stack) (F_STACK_FRAME *)((stack) + 1) #define FIRST_STACK_FRAME(stack) (F_STACK_FRAME *)((stack) + 1)
#define FRAME_SUCCESSOR(frame) (frame)->next
#define REBASE_FRAME_SUCCESSOR(frame,delta) (F_STACK_FRAME *)((CELL)FRAME_SUCCESSOR(frame) + delta) #define REBASE_FRAME_SUCCESSOR(frame,delta) (F_STACK_FRAME *)((CELL)FRAME_SUCCESSOR(frame) + delta)
typedef void (*CALLSTACK_ITER)(F_STACK_FRAME *frame); typedef void (*CALLSTACK_ITER)(F_STACK_FRAME *frame);

4
vm/cpu-ppc.S
View File

@ -146,8 +146,6 @@ DEF(void,primitive_execute,(void)):
subi r14,r14,4 /* pop word from data stack */ subi r14,r14,4 /* pop word from data stack */
bctr /* go */ bctr /* go */
#define SCAN_SAVE (RESERVED_SIZE + PARAM_SIZE + 4)
/* We pass a function pointer to memcpy in r6 to work around a Mac OS X ABI /* We pass a function pointer to memcpy in r6 to work around a Mac OS X ABI
limitation which would otherwise require us to do a bizzaro PC-relative limitation which would otherwise require us to do a bizzaro PC-relative
trampoline to retrieve the function address */ trampoline to retrieve the function address */
@ -159,8 +157,6 @@ DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, voi
blrl /* go */ blrl /* go */
lwz r1,0(r1) /* tear down fake stack frame */ lwz r1,0(r1) /* tear down fake stack frame */
lwz r0,LR_SAVE(r1) /* we have restored the stack; load return address */ lwz r0,LR_SAVE(r1) /* we have restored the stack; load return address */
/* load quotation scan pointer */
lwz r5,SCAN_SAVE(r1)
mtlr r0 /* prepare to return to restored callstack */ mtlr r0 /* prepare to return to restored callstack */
blr /* go */ blr /* go */

20
vm/cpu-ppc.h
View File

@ -1,3 +1,21 @@
typedef struct _F_STACK_FRAME
{
/* In compiled quotation frames, the quot->array slot.
In compiled word frames, unused. */
CELL array;
/* In compiled quotation frames, position within the array.
In compiled word frames, unused. */
CELL scan;
/* In all compiled frames, the XT on entry. */
XT xt;
/* Pointer to the next stack frame; frames are chained from
the bottom on up */
struct _F_STACK_FRAME *next;
} F_STACK_FRAME;
#define FACTOR_CPU_STRING "ppc" #define FACTOR_CPU_STRING "ppc"
#define F_FASTCALL #define F_FASTCALL
@ -13,5 +31,3 @@ void set_callstack(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *me
void throw_impl(CELL quot, F_STACK_FRAME *rewind); void throw_impl(CELL quot, F_STACK_FRAME *rewind);
void lazy_jit_compile(CELL quot); void lazy_jit_compile(CELL quot);
void flush_icache(CELL start, CELL len); void flush_icache(CELL start, CELL len);
#define FRAME_SUCCESSOR(frame) (frame)->previous

4
vm/cpu-x86.h
View File

@ -16,9 +16,7 @@ typedef struct _F_STACK_FRAME
XT xt; XT xt;
} F_STACK_FRAME; } F_STACK_FRAME;
#define CALLSTACK_UP_P #define FRAME_RETURN_ADDRESS(frame,delta) *(XT *)(REBASE_FRAME_SUCCESSOR(frame,delta) + 1)
#define FRAME_SUCCESSOR(frame) (frame)->next
INLINE void flush_icache(CELL start, CELL len) {} INLINE void flush_icache(CELL start, CELL len) {}

7
vm/image.c
View File

@ -186,12 +186,7 @@ void fixup_stack_frame(F_STACK_FRAME *frame)
frame->scan = scan + frame->array; frame->scan = scan + frame->array;
} }
#ifdef CALLSTACK_UP_P code_fixup(&FRAME_RETURN_ADDRESS(frame,delta));
F_STACK_FRAME *next = REBASE_FRAME_SUCCESSOR(frame,delta);
code_fixup((XT *)(next + 1));
#else
code_fixup(&frame->return_address);
#endif
} }
void fixup_callstack_object(F_CALLSTACK *stack) void fixup_callstack_object(F_CALLSTACK *stack)

27
vm/os-linux-ppc.h
View File

@ -1,29 +1,4 @@
typedef struct _F_STACK_FRAME #define FRAME_RETURN_ADDRESS(frame,delta) *((XT *)(REBASE_FRAME_SUCCESSOR(frame,delta) + 1) + 1)
{
struct _F_STACK_FRAME *previous;
/* Callee stores our LR here */
XT return_address;
/* ===== 32 bytes saved register area ===== */
CELL padding5[8];
/* ===== 16 byte local variable area ===== */
/* In compiled quotation frames, the quot->array slot.
In compiled word frames, unused. */
CELL array;
/* In compiled quotation frames, position within the array.
In compiled word frames, unused. */
CELL scan;
/* In all compiled frames, the XT on entry. */
XT xt;
/* ===== 12 byte padding to make it 16 byte aligned ===== */
CELL padding6[3];
} F_STACK_FRAME;
#define UAP_PROGRAM_COUNTER(ucontext) \ #define UAP_PROGRAM_COUNTER(ucontext) \
(((ucontext_t *)(ucontext))->uc_mcontext.uc_regs->gregs[PT_NIP]) (((ucontext_t *)(ucontext))->uc_mcontext.uc_regs->gregs[PT_NIP])

32
vm/os-macosx-ppc.h
View File

@ -1,34 +1,4 @@
typedef struct _F_STACK_FRAME { #define FRAME_RETURN_ADDRESS(frame,delta) *((XT *)(REBASE_FRAME_SUCCESSOR(frame,delta) + 1) + 2)
/* ===== 24 bytes reserved ===== */
struct _F_STACK_FRAME *previous;
CELL padding1;
/* Callee stores our LR here */
XT return_address;
CELL padding2;
CELL padding3;
CELL padding4;
/* ===== 32 bytes saved register area ===== */
CELL padding5[8];
/* ===== 16 byte local variable area ===== */
/* In compiled quotation frames, the quot->array slot.
In compiled word frames, unused. */
CELL array;
/* In compiled quotation frames, position within the array.
In compiled word frames, unused. */
CELL scan;
/* In all compiled frames, the XT on entry. */
XT xt;
/* ===== 12 byte padding to make it 16 byte aligned ===== */
CELL padding6[3];
} F_STACK_FRAME;
#define MACH_EXC_STATE_TYPE ppc_exception_state_t #define MACH_EXC_STATE_TYPE ppc_exception_state_t
#define MACH_EXC_STATE_FLAVOR PPC_EXCEPTION_STATE #define MACH_EXC_STATE_FLAVOR PPC_EXCEPTION_STATE