Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
18929373b9
|
|
@ -15,7 +15,10 @@ IN: cpu.ppc
|
|||
|
||||
! PowerPC register assignments:
|
||||
! r2-r12: integer vregs
|
||||
! r15-r29
|
||||
! r13: data stack
|
||||
! r14: retain stack
|
||||
! r15: VM pointer
|
||||
! r16-r29: integer vregs
|
||||
! r30: integer scratch
|
||||
! f0-f29: float vregs
|
||||
! f30: float scratch
|
||||
|
|
@ -31,18 +34,9 @@ enable-float-intrinsics
|
|||
\ ##float>integer t frame-required? set-word-prop
|
||||
>>
|
||||
|
||||
: %load-vm-addr ( reg -- )
|
||||
0 swap LOAD32 0 rc-absolute-ppc-2/2 rel-vm ;
|
||||
|
||||
: %load-vm-field-addr ( reg symbol -- )
|
||||
[ 0 swap LOAD32 ] dip
|
||||
vm-field-offset rc-absolute-ppc-2/2 rel-vm ;
|
||||
|
||||
M: ppc %vm-field-ptr ( dst field -- ) %load-vm-field-addr ;
|
||||
|
||||
M: ppc machine-registers
|
||||
{
|
||||
{ int-regs $[ 2 12 [a,b] 15 29 [a,b] append ] }
|
||||
{ int-regs $[ 2 12 [a,b] 16 29 [a,b] append ] }
|
||||
{ float-regs $[ 0 29 [a,b] ] }
|
||||
} ;
|
||||
|
||||
|
|
@ -59,6 +53,14 @@ M: ppc %alien-global ( register symbol dll -- )
|
|||
|
||||
CONSTANT: ds-reg 13
|
||||
CONSTANT: rs-reg 14
|
||||
CONSTANT: vm-reg 15
|
||||
|
||||
: %load-vm-addr ( reg -- ) vm-reg MR ;
|
||||
|
||||
: %load-vm-field-addr ( reg symbol -- )
|
||||
[ vm-reg ] dip vm-field-offset ADDI ;
|
||||
|
||||
M: ppc %vm-field-ptr ( dst field -- ) %load-vm-field-addr ;
|
||||
|
||||
GENERIC: loc-reg ( loc -- reg )
|
||||
|
||||
|
|
@ -593,6 +595,31 @@ M:: ppc %load-param-reg ( stack reg rep -- )
|
|||
M: ppc %pop-stack ( n -- )
|
||||
[ 3 ] dip <ds-loc> loc>operand LWZ ;
|
||||
|
||||
M: ppc %push-stack ( -- )
|
||||
ds-reg ds-reg 4 ADDI
|
||||
int-regs return-reg ds-reg 0 STW ;
|
||||
|
||||
:: %load-context-datastack ( dst -- )
|
||||
! Load context struct
|
||||
dst "ctx" %vm-field-ptr
|
||||
dst dst 0 LWZ
|
||||
! Load context datastack pointer
|
||||
dst dst "datastack" context-field-offset ADDI ;
|
||||
|
||||
M: ppc %push-context-stack ( -- )
|
||||
11 %load-context-datastack
|
||||
12 11 0 LWZ
|
||||
12 12 4 ADDI
|
||||
12 11 0 STW
|
||||
int-regs return-reg 12 0 STW ;
|
||||
|
||||
M: ppc %pop-context-stack ( -- )
|
||||
11 %load-context-datastack
|
||||
12 11 0 LWZ
|
||||
int-regs return-reg 12 0 LWZ
|
||||
12 12 4 SUBI
|
||||
12 11 0 STW ;
|
||||
|
||||
M: ppc %unbox ( n rep func -- )
|
||||
! Value must be in r3
|
||||
4 %load-vm-addr
|
||||
|
|
@ -652,17 +679,15 @@ M: ppc %box-large-struct ( n c-type -- )
|
|||
! Call the function
|
||||
"from_value_struct" f %alien-invoke ;
|
||||
|
||||
M:: ppc %save-context ( temp1 temp2 callback-allowed? -- )
|
||||
M:: ppc %save-context ( temp1 temp2 -- )
|
||||
#! Save Factor stack pointers in case the C code calls a
|
||||
#! callback which does a GC, which must reliably trace
|
||||
#! all roots.
|
||||
temp1 "ctx" %load-vm-field-addr
|
||||
temp1 temp1 0 LWZ
|
||||
1 temp1 0 STW
|
||||
callback-allowed? [
|
||||
ds-reg temp1 8 STW
|
||||
rs-reg temp1 12 STW
|
||||
] when ;
|
||||
ds-reg temp1 8 STW
|
||||
rs-reg temp1 12 STW ;
|
||||
|
||||
M: ppc %alien-invoke ( symbol dll -- )
|
||||
[ 11 ] 2dip %alien-global 11 MTLR BLRL ;
|
||||
|
|
@ -674,11 +699,11 @@ M: ppc %alien-callback ( quot -- )
|
|||
|
||||
M: ppc %prepare-alien-indirect ( -- )
|
||||
3 %load-vm-addr
|
||||
"unbox_alien" f %alien-invoke
|
||||
15 3 MR ;
|
||||
"from_alien" f %alien-invoke
|
||||
16 3 MR ;
|
||||
|
||||
M: ppc %alien-indirect ( -- )
|
||||
15 MTLR BLRL ;
|
||||
16 MTLR BLRL ;
|
||||
|
||||
M: ppc %callback-value ( ctype -- )
|
||||
! Save top of data stack
|
||||
|
|
|
|||
|
|
@ -291,7 +291,7 @@ ERROR: invalid-color-type/bit-depth loading-png ;
|
|||
{ 8 16 } validate-bit-depth ;
|
||||
|
||||
: pad-bitmap ( image -- image )
|
||||
dup dim>> first 4 divisor? [
|
||||
dup dim>> second 4 divisor? [
|
||||
dup [ bytes-per-pixel ]
|
||||
[ dim>> first * ]
|
||||
[ dim>> first 4 mod ] tri
|
||||
|
|
|
|||
10
vm/cpu-ppc.S
10
vm/cpu-ppc.S
|
|
@ -221,18 +221,22 @@ DEF(void,c_to_factor,(cell quot, void *vm)):
|
|||
blr
|
||||
|
||||
DEF(void,set_callstack,(void *vm, stack_frame *to, stack_frame *from, cell length, void *memcpy)):
|
||||
/* Compute new stack pointer */
|
||||
/* Save VM pointer in non-volatile register */
|
||||
mr VM_REG,r3
|
||||
|
||||
/* Compute new stack pointer */
|
||||
sub r1,r4,r6
|
||||
|
||||
/* Call memcpy() */
|
||||
mr r4,r1
|
||||
mr r3,r1
|
||||
mr r4,r5
|
||||
mr r5,r6
|
||||
stwu r1,-64(r1)
|
||||
mtlr r7
|
||||
blrl
|
||||
lwz r1,0(r1)
|
||||
|
||||
/* Load context */
|
||||
mr VM_REG,r3
|
||||
lwz r16,0(VM_REG)
|
||||
|
||||
/* Load ctx->datastack */
|
||||
|
|
|
|||
|
|
@ -57,7 +57,7 @@ u64 nano_count()
|
|||
hi += 1;
|
||||
lo = count.LowPart;
|
||||
|
||||
return (((u64)hi << 32) | (u64)lo)*(1000000000/frequency.QuadPart);
|
||||
return (u64)((((u64)hi << 32) | (u64)lo)*(1000000000.0/frequency.QuadPart));
|
||||
}
|
||||
|
||||
void sleep_nanos(u64 nsec)
|
||||
|
|
|
|||
|
|
@ -182,7 +182,12 @@ void quotation_jit::iterate_quotation()
|
|||
/* Primitive calls */
|
||||
if(primitive_call_p(i,length))
|
||||
{
|
||||
/* On PowerPC, the VM pointer is stored as a register; on other
|
||||
platforms, the RT_VM relocation is used and it needs an offset
|
||||
parameter */
|
||||
#ifndef FACTOR_PPC
|
||||
parameter(tag_fixnum(0));
|
||||
#endif
|
||||
parameter(obj.value());
|
||||
emit(parent->special_objects[JIT_PRIMITIVE]);
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue