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 -- d a b x y ) 32 over - swap 31 ; inline
: SRWI ( d a b -- ) (SRWI) RLWINM ; : SRWI ( d a b -- ) (SRWI) RLWINM ;
: 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? ; : immediate? ( n -- ? ) HEX: -8000 HEX: 7fff between? ;
: LOAD ( n r -- ) over immediate? [ LI ] [ LOAD32 ] if ; : 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 -- ) GENERIC: BC ( a b c -- )
M: integer BC 0 0 16 b-insn ; M: integer BC 0 0 16 b-insn ;
M: word BC >r 0 BC r> rc-relative-ppc-2 rel-word ; M: word BC [ 0 BC ] dip rc-relative-ppc-2 rel-word ;
M: label BC >r 0 BC r> rc-relative-ppc-2 label-fixup ; M: label BC [ 0 BC ] dip rc-relative-ppc-2 label-fixup ;
: CREATE-B ( -- word ) scan "B" prepend create-in ; : 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 -- ) M: ppc %prologue ( n -- )
0 11 LOAD32 rc-absolute-ppc-2/2 rel-this 0 11 LOAD32 rc-absolute-ppc-2/2 rel-this
0 MFLR 0 MFLR
1 1 pick neg ADDI {
11 1 pick xt-save STW [ [ 1 1 ] dip neg ADDI ]
dup 11 LI [ [ 11 1 ] dip xt-save STW ]
11 1 pick next-save STW [ 11 LI ]
0 1 rot lr-save + STW ; [ [ 11 1 ] dip next-save STW ]
[ [ 0 1 ] dip lr-save + STW ]
} cleave ;
M: ppc %epilogue ( n -- ) M: ppc %epilogue ( n -- )
#! At the end of each word that calls a subroutine, we store #! At the end of each word that calls a subroutine, we store
#! the previous link register value in r0 by popping it off #! the previous link register value in r0 by popping it off
#! the stack, set the link register to the contents of r0, #! the stack, set the link register to the contents of r0,
#! and jump to the link register. #! and jump to the link register.
0 1 pick lr-save + LWZ [ [ 0 1 ] dip lr-save + LWZ ]
1 1 rot ADDI [ [ 1 1 ] dip ADDI ] bi
0 MTLR ; 0 MTLR ;
:: (%boolean) ( dst temp word -- ) :: (%boolean) ( dst temp word -- )
@ -541,17 +543,17 @@ GENERIC: STF ( src dst off reg-class -- )
M: single-float-regs STF drop STFS ; M: single-float-regs STF drop STFS ;
M: double-float-regs STF drop STFD ; 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 -- ) GENERIC: LF ( dst src off reg-class -- )
M: single-float-regs LF drop LFS ; M: single-float-regs LF drop LFS ;
M: double-float-regs LF drop LFD ; 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 -- ) 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>> + ; : 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. #! Funky. Read the parameter from the caller's stack frame.
#! This word is used in callbacks #! This word is used in callbacks
drop drop
0 1 rot next-param@ LWZ [ 0 1 ] dip next-param@ LWZ
0 1 rot local@ STW ; [ 0 1 ] dip local@ STW ;
M: ppc %prepare-unbox ( -- ) M: ppc %prepare-unbox ( -- )
! First parameter is top of stack ! First parameter is top of stack
@ -580,14 +582,14 @@ M: ppc %unbox-long-long ( n func -- )
f %alien-invoke f %alien-invoke
! Store the return value on the C stack ! Store the return value on the C stack
[ [
3 1 pick local@ STW [ [ 3 1 ] dip local@ STW ]
4 1 rot cell + local@ STW [ [ 4 1 ] dip cell + local@ STW ] bi
] when* ; ] when* ;
M: ppc %unbox-large-struct ( n c-type -- ) M: ppc %unbox-large-struct ( n c-type -- )
! Value must be in r3 ! Value must be in r3
! Compute destination address and load struct size ! 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 ! Call the function
"to_value_struct" f %alien-invoke ; "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 a stack location, load it into freg #0.
! If the source is f, then we assume the value is already in ! If the source is f, then we assume the value is already in
! freg #0. ! freg #0.
>r [ over [ 0 over param-reg swap %load-param-reg ] [ 2drop ] if ] dip
over [ 0 over param-reg swap %load-param-reg ] [ 2drop ] if f %alien-invoke ;
r> f %alien-invoke ;
M: ppc %box-long-long ( n func -- ) M: ppc %box-long-long ( n func -- )
>r [ [
3 1 pick local@ LWZ [
4 1 rot cell + local@ LWZ [ [ 3 1 ] dip local@ LWZ ]
] when* r> f %alien-invoke ; [ [ 4 1 ] dip cell + local@ LWZ ] bi
] when*
] dip f %alien-invoke ;
: struct-return@ ( n -- n ) : struct-return@ ( n -- n )
[ stack-frame get params>> ] unless* local@ ; [ stack-frame get params>> ] unless* local@ ;
@ -616,7 +619,7 @@ M: ppc %prepare-box-struct ( -- )
M: ppc %box-large-struct ( n c-type -- ) M: ppc %box-large-struct ( n c-type -- )
! If n = f, then we're boxing a returned struct ! If n = f, then we're boxing a returned struct
! Compute destination address and load struct size ! 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 ! Call the function
"box_value_struct" f %alien-invoke ; "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 IN: unix
CONSTANT: FD_SETSIZE 256 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 IN: unix
CONSTANT: FD_SETSIZE 1024 CONSTANT: FD_SETSIZE 1024

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

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

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

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

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

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

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

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

0
core/syntax/tags.txt
View File

4
vm/cpu-ppc.S
View File

@ -116,6 +116,7 @@ DEF(void,c_to_factor,(CELL quot)):
SAVE_INT(r26,13) SAVE_INT(r26,13)
SAVE_INT(r27,14) SAVE_INT(r27,14)
SAVE_INT(r28,15) 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(f15,22)
@ -163,7 +164,8 @@ DEF(void,c_to_factor,(CELL quot)):
RESTORE_FP(f15,22) 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(r27,14)
RESTORE_INT(r26,13) RESTORE_INT(r26,13)
RESTORE_INT(r25,12) RESTORE_INT(r25,12)