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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-12-16 02:28:21 -06:00
parent e909f7b290 de75909550
commit 7dd4ad44c4
12 changed files with 73 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/cpu/ppc/assembler/assembler.factor
View File

@ -204,6 +204,6 @@ MTSPR: CTR 9
: (SRWI) ( d a b -- d a b x y ) 32 over - swap 31 ; inline
: SRWI ( d a b -- ) (SRWI) RLWINM ;
: SRWI. ( d a b -- ) (SRWI) RLWINM. ;
: LOAD32 ( n r -- ) >r w>h/h r> tuck LIS dup rot ORI ;
: LOAD32 ( n r -- ) [ w>h/h ] dip tuck LIS dup rot ORI ;
: immediate? ( n -- ? ) HEX: -8000 HEX: 7fff between? ;
: LOAD ( n r -- ) over immediate? [ LI ] [ LOAD32 ] if ;

4
basis/cpu/ppc/assembler/backend/backend.factor
View File

@ -79,8 +79,8 @@ M: label (B) 0 -rot (B) rc-relative-ppc-3 label-fixup ;
GENERIC: BC ( a b c -- )
M: integer BC 0 0 16 b-insn ;
M: word BC >r 0 BC r> rc-relative-ppc-2 rel-word ;
M: label BC >r 0 BC r> rc-relative-ppc-2 label-fixup ;
M: word BC [ 0 BC ] dip rc-relative-ppc-2 rel-word ;
M: label BC [ 0 BC ] dip rc-relative-ppc-2 label-fixup ;
: CREATE-B ( -- word ) scan "B" prepend create-in ;

49
basis/cpu/ppc/ppc.factor
View File

@ -467,19 +467,21 @@ M: ppc %gc
M: ppc %prologue ( n -- )
0 11 LOAD32 rc-absolute-ppc-2/2 rel-this
0 MFLR
1 1 pick neg ADDI
11 1 pick xt-save STW
dup 11 LI
11 1 pick next-save STW
0 1 rot lr-save + STW ;
{
[ [ 1 1 ] dip neg ADDI ]
[ [ 11 1 ] dip xt-save STW ]
[ 11 LI ]
[ [ 11 1 ] dip next-save STW ]
[ [ 0 1 ] dip lr-save + STW ]
} cleave ;
M: ppc %epilogue ( n -- )
#! At the end of each word that calls a subroutine, we store
#! the previous link register value in r0 by popping it off
#! the stack, set the link register to the contents of r0,
#! and jump to the link register.
0 1 pick lr-save + LWZ
1 1 rot ADDI
[ [ 0 1 ] dip lr-save + LWZ ]
[ [ 1 1 ] dip ADDI ] bi
0 MTLR ;
:: (%boolean) ( dst temp word -- )
@ -541,17 +543,17 @@ GENERIC: STF ( src dst off reg-class -- )
M: single-float-regs STF drop STFS ;
M: double-float-regs STF drop STFD ;
M: float-regs %save-param-reg >r 1 rot local@ r> STF ;
M: float-regs %save-param-reg [ 1 rot local@ ] dip STF ;
GENERIC: LF ( dst src off reg-class -- )
M: single-float-regs LF drop LFS ;
M: double-float-regs LF drop LFD ;
M: float-regs %load-param-reg >r 1 rot local@ r> LF ;
M: float-regs %load-param-reg [ 1 rot local@ ] dip LF ;
M: stack-params %load-param-reg ( stack reg reg-class -- )
drop >r 0 1 rot local@ LWZ 0 1 r> param@ STW ;
drop [ 0 1 rot local@ LWZ 0 1 ] dip param@ STW ;
: next-param@ ( n -- x ) param@ stack-frame get total-size>> + ;
@ -559,8 +561,8 @@ M: stack-params %save-param-reg ( stack reg reg-class -- )
#! Funky. Read the parameter from the caller's stack frame.
#! This word is used in callbacks
drop
0 1 rot next-param@ LWZ
0 1 rot local@ STW ;
[ 0 1 ] dip next-param@ LWZ
[ 0 1 ] dip local@ STW ;
M: ppc %prepare-unbox ( -- )
! First parameter is top of stack
@ -580,14 +582,14 @@ M: ppc %unbox-long-long ( n func -- )
f %alien-invoke
! Store the return value on the C stack
[
3 1 pick local@ STW
4 1 rot cell + local@ STW
[ [ 3 1 ] dip local@ STW ]
[ [ 4 1 ] dip cell + local@ STW ] bi
] when* ;
M: ppc %unbox-large-struct ( n c-type -- )
! Value must be in r3
! Compute destination address and load struct size
[ 4 1 rot local@ ADDI ] [ heap-size 5 LI ] bi*
[ [ 4 1 ] dip local@ ADDI ] [ heap-size 5 LI ] bi*
! Call the function
"to_value_struct" f %alien-invoke ;
@ -595,15 +597,16 @@ M: ppc %box ( n reg-class func -- )
! If the source is a stack location, load it into freg #0.
! If the source is f, then we assume the value is already in
! freg #0.
>r
over [ 0 over param-reg swap %load-param-reg ] [ 2drop ] if
r> f %alien-invoke ;
[ over [ 0 over param-reg swap %load-param-reg ] [ 2drop ] if ] dip
f %alien-invoke ;
M: ppc %box-long-long ( n func -- )
>r [
3 1 pick local@ LWZ
4 1 rot cell + local@ LWZ
] when* r> f %alien-invoke ;
[
[
[ [ 3 1 ] dip local@ LWZ ]
[ [ 4 1 ] dip cell + local@ LWZ ] bi
] when*
] dip f %alien-invoke ;
: struct-return@ ( n -- n )
[ stack-frame get params>> ] unless* local@ ;
@ -616,7 +619,7 @@ M: ppc %prepare-box-struct ( -- )
M: ppc %box-large-struct ( n c-type -- )
! If n = f, then we're boxing a returned struct
! Compute destination address and load struct size
[ 3 1 rot struct-return@ ADDI ] [ heap-size 4 LI ] bi*
[ [ 3 1 ] dip struct-return@ ADDI ] [ heap-size 4 LI ] bi*
! Call the function
"box_value_struct" f %alien-invoke ;

2
basis/unix/bsd/netbsd/netbsd.factor
View File

@ -1,4 +1,4 @@
USING: alien.syntax alien.c-types math vocabs.loader constants ;
USING: alien.syntax alien.c-types math vocabs.loader constants alias ;
IN: unix
CONSTANT: FD_SETSIZE 256

2
basis/unix/bsd/openbsd/openbsd.factor
View File

@ -1,4 +1,4 @@
USING: alien.syntax constants ;
USING: alien.syntax constants alias ;
IN: unix
CONSTANT: FD_SETSIZE 1024

6
basis/unix/linux/epoll/epoll.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: unix.linux.epoll
USING: alien.syntax math ;
USING: alien.syntax math constants ;
FUNCTION: int epoll_create ( int size ) ;
@ -28,5 +28,5 @@ CONSTANT: EPOLLWRBAND HEX: 200
CONSTANT: EPOLLMSG HEX: 400
CONSTANT: EPOLLERR HEX: 008
CONSTANT: EPOLLHUP HEX: 010
CONSTANT: EPOLLONESHOT 30 2^
CONSTANT: EPOLLET 31 2^
: EPOLLONESHOT ( -- n ) 30 2^ ; inline
: EPOLLET ( -- n ) 31 2^ ; inline

2
basis/unix/statfs/freebsd/freebsd.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax ;
USING: alien.syntax constants ;
IN: unix.statfs.freebsd
CONSTANT: MFSNAMELEN 16 ! length of type name including null */

2
basis/unix/statfs/openbsd/openbsd.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax ;
USING: alien.syntax constants ;
IN: unix.statfs.openbsd
CONSTANT: MFSNAMELEN 16

2
basis/unix/statvfs/linux/linux.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax ;
USING: alien.syntax constants ;
IN: unix.statvfs.linux
C-STRUCT: statvfs64

2
basis/unix/utmpx/utmpx.factor
View File

@ -3,7 +3,7 @@
USING: alien.c-types alien.syntax combinators continuations
io.encodings.string io.encodings.utf8 kernel sequences strings
unix calendar system accessors unix.time calendar.unix
vocabs.loader ;
vocabs.loader constants ;
IN: unix.utmpx
CONSTANT: EMPTY 0

0
core/syntax/tags.txt
View File

68
vm/cpu-ppc.S
View File

@ -5,44 +5,44 @@ in the public domain. */
#define DS_REG r29
DEF(void,primitive_fixnum_add,(void)):
lwz r3,0(DS_REG)
lwz r4,-4(DS_REG)
subi DS_REG,DS_REG,4
li r0,0
mtxer r0
addo. r5,r3,r4
bso add_overflow
stw r5,0(DS_REG)
blr
lwz r3,0(DS_REG)
lwz r4,-4(DS_REG)
subi DS_REG,DS_REG,4
li r0,0
mtxer r0
addo. r5,r3,r4
bso add_overflow
stw r5,0(DS_REG)
blr
add_overflow:
b MANGLE(overflow_fixnum_add)
DEF(void,primitive_fixnum_subtract,(void)):
lwz r3,-4(DS_REG)
lwz r4,0(DS_REG)
subi DS_REG,DS_REG,4
li r0,0
mtxer r0
subfo. r5,r4,r3
lwz r3,-4(DS_REG)
lwz r4,0(DS_REG)
subi DS_REG,DS_REG,4
li r0,0
mtxer r0
subfo. r5,r4,r3
bso sub_overflow
stw r5,0(DS_REG)
blr
stw r5,0(DS_REG)
blr
sub_overflow:
b MANGLE(overflow_fixnum_subtract)
b MANGLE(overflow_fixnum_subtract)
DEF(void,primitive_fixnum_multiply,(void)):
lwz r3,0(DS_REG)
lwz r4,-4(DS_REG)
subi DS_REG,DS_REG,4
srawi r3,r3,3
mullwo. r5,r3,r4
bso multiply_overflow
stw r5,0(DS_REG)
blr
lwz r3,0(DS_REG)
lwz r4,-4(DS_REG)
subi DS_REG,DS_REG,4
srawi r3,r3,3
mullwo. r5,r3,r4
bso multiply_overflow
stw r5,0(DS_REG)
blr
multiply_overflow:
srawi r4,r4,3
b MANGLE(overflow_fixnum_multiply)
srawi r4,r4,3
b MANGLE(overflow_fixnum_multiply)
/* Note that the XT is passed to the quotation in r11 */
#define CALL_OR_JUMP_QUOT \
lwz r11,9(r3) /* load quotation-xt slot */ XX \
@ -116,8 +116,9 @@ DEF(void,c_to_factor,(CELL quot)):
SAVE_INT(r26,13)
SAVE_INT(r27,14)
SAVE_INT(r28,15)
SAVE_INT(r31,16)
SAVE_FP(f14,20) /* save FPRs */
SAVE_FP(f14,20) /* save FPRs */
SAVE_FP(f15,22)
SAVE_FP(f16,24)
SAVE_FP(f17,26)
@ -141,7 +142,7 @@ DEF(void,c_to_factor,(CELL quot)):
mr r3,r1 /* pass call stack pointer as an argument */
bl MANGLE(save_callstack_bottom)
RESTORE_INT(r3,19) /* restore quotation */
RESTORE_INT(r3,19) /* restore quotation */
CALL_QUOT
RESTORE_FP(f31,54)
@ -161,9 +162,10 @@ DEF(void,c_to_factor,(CELL quot)):
RESTORE_FP(f17,26)
RESTORE_FP(f16,24)
RESTORE_FP(f15,22)
RESTORE_FP(f14,20) /* save FPRs */
RESTORE_FP(f14,20) /* save FPRs */
RESTORE_INT(r28,15) /* restore GPRs */
RESTORE_INT(r31,16) /* restore GPRs */
RESTORE_INT(r28,15)
RESTORE_INT(r27,14)
RESTORE_INT(r26,13)
RESTORE_INT(r25,12)