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

Fix stack effect declarations

db4
sheeple 2008-09-01 19:06:00 -05:00
parent 03ab685d93
commit c8cecf8768
2 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
basis/cpu/ppc/architecture/architecture.factor
View File

@ -18,13 +18,13 @@ IN: cpu.ppc.architecture
: ds-reg 14 ; inline : ds-reg 14 ; inline
: rs-reg 15 ; inline : rs-reg 15 ; inline
: reserved-area-size : reserved-area-size ( -- n )
os { os {
{ linux [ 2 ] } { linux [ 2 ] }
{ macosx [ 6 ] } { macosx [ 6 ] }
} case cells ; foldable } case cells ; foldable
: lr-save : lr-save ( -- n )
os { os {
{ linux [ 1 ] } { linux [ 1 ] }
{ macosx [ 2 ] } { macosx [ 2 ] }
@ -32,12 +32,12 @@ IN: cpu.ppc.architecture
: param@ ( n -- x ) reserved-area-size + ; inline : param@ ( n -- x ) reserved-area-size + ; inline
: param-save-size 8 cells ; foldable : param-save-size ( -- n ) 8 cells ; foldable
: local@ ( n -- x ) : local@ ( n -- x )
reserved-area-size param-save-size + + ; inline reserved-area-size param-save-size + + ; inline
: factor-area-size 2 cells ; : factor-area-size ( -- n ) 2 cells ; foldable
: next-save ( n -- i ) cell - ; : next-save ( n -- i ) cell - ;
@ -96,9 +96,9 @@ M: ppc %epilogue ( n -- )
1 1 rot ADDI 1 1 rot ADDI
0 MTLR ; 0 MTLR ;
: (%call) 11 MTLR BLRL ; : (%call) ( -- ) 11 MTLR BLRL ;
: (%jump) 11 MTCTR BCTR ; : (%jump) ( -- ) 11 MTCTR BCTR ;
: %load-dlsym ( symbol dll register -- ) : %load-dlsym ( symbol dll register -- )
0 swap LOAD32 rc-absolute-ppc-2/2 rel-dlsym ; 0 swap LOAD32 rc-absolute-ppc-2/2 rel-dlsym ;
@ -218,7 +218,7 @@ M: ppc %box-long-long ( n func -- )
4 1 rot cell + local@ LWZ 4 1 rot cell + local@ LWZ
] when* r> f %alien-invoke ; ] when* r> f %alien-invoke ;
: temp@ stack-frame* factor-area-size - swap - ; : temp@ ( m -- n ) stack-frame* factor-area-size - swap - ;
: struct-return@ ( size n -- n ) [ local@ ] [ temp@ ] ?if ; : struct-return@ ( size n -- n ) [ local@ ] [ temp@ ] ?if ;

10
basis/cpu/ppc/intrinsics/intrinsics.factor
View File

@ -11,17 +11,17 @@ math.floats.private classes slots.private combinators
compiler.constants ; compiler.constants ;
IN: cpu.ppc.intrinsics IN: cpu.ppc.intrinsics
: %slot-literal-known-tag : %slot-literal-known-tag ( -- out value offset )
"val" operand "val" operand
"obj" operand "obj" operand
"n" get cells "n" get cells
"obj" get operand-tag - ; "obj" get operand-tag - ;
: %slot-literal-any-tag : %slot-literal-any-tag ( -- out value offset )
"obj" operand "scratch1" operand %untag "obj" operand "scratch1" operand %untag
"val" operand "scratch1" operand "n" get cells ; "val" operand "scratch1" operand "n" get cells ;
: %slot-any : %slot-any ( -- out value offset )
"obj" operand "scratch1" operand %untag "obj" operand "scratch1" operand %untag
"offset" operand "n" operand 1 SRAWI "offset" operand "n" operand 1 SRAWI
"scratch1" operand "val" operand "offset" operand ; "scratch1" operand "val" operand "offset" operand ;
@ -188,7 +188,7 @@ IN: cpu.ppc.intrinsics
} }
} define-intrinsics } define-intrinsics
: generate-fixnum-mod : generate-fixnum-mod ( -- )
#! PowerPC doesn't have a MOD instruction; so we compute #! PowerPC doesn't have a MOD instruction; so we compute
#! x-(x/y)*y. Puts the result in "s" operand. #! x-(x/y)*y. Puts the result in "s" operand.
"s" operand "r" operand "y" operand MULLW "s" operand "r" operand "y" operand MULLW
@ -259,7 +259,7 @@ IN: cpu.ppc.intrinsics
\ fixnum+ \ ADD \ ADDO. overflow-template \ fixnum+ \ ADD \ ADDO. overflow-template
\ fixnum- \ SUBF \ SUBFO. overflow-template \ fixnum- \ SUBF \ SUBFO. overflow-template
: generate-fixnum/i : generate-fixnum/i ( -- )
#! This VOP is funny. If there is an overflow, it falls #! This VOP is funny. If there is an overflow, it falls
#! through to the end, and the result is in "x" operand. #! through to the end, and the result is in "x" operand.
#! Otherwise it jumps to the "no-overflow" label and the #! Otherwise it jumps to the "no-overflow" label and the