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

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

db4
John Benediktsson 2011-06-14 08:45:16 -07:00
parent 7337e38848 40c45e08ca
commit 6104f8f159
126 changed files with 6294 additions and 2722 deletions
basis
alien
bootstrap/image
classes/struct
command-line
compiler
cfg
codegen/fixup
constants
cpu
editors
io
backend/unix
directories/unix
listener
math
blas/config
floats/env/ppc
smtp
stack-checker/known-words
tools
disassembler/gdb
scaffold
ui
backend/gtk
gadgets
unix/linux/epoll
build-support
core
Show More

14
GNUmakefile
View File

@ -1,8 +1,6 @@
ifdef CONFIG
CC = gcc
CPP = g++
AR = ar
LD = ld
VERSION = 0.94
@ -85,7 +83,8 @@ help:
@echo "freebsd-x86-64"
@echo "linux-x86-32"
@echo "linux-x86-64"
@echo "linux-ppc"
@echo "linux-ppc-32"
@echo "linux-ppc-64"
@echo "linux-arm"
@echo "openbsd-x86-32"
@echo "openbsd-x86-64"
@ -141,8 +140,11 @@ linux-x86-32:
linux-x86-64:
$(MAKE) $(ALL) CONFIG=vm/Config.linux.x86.64
linux-ppc:
$(MAKE) $(ALL) CONFIG=vm/Config.linux.ppc
linux-ppc-32:
$(MAKE) $(ALL) CONFIG=vm/Config.linux.ppc.32
linux-ppc-64:
$(MAKE) $(ALL) CONFIG=vm/Config.linux.ppc.64
linux-arm:
$(MAKE) $(ALL) CONFIG=vm/Config.linux.arm
@ -197,7 +199,7 @@ vm/ffi_test.o: vm/ffi_test.c
$(TOOLCHAIN_PREFIX)$(CPP) -c $(CFLAGS) -o $@ $<
.S.o:
$(TOOLCHAIN_PREFIX)$(CC) -x assembler-with-cpp -c $(CFLAGS) -o $@ $<
$(TOOLCHAIN_PREFIX)$(CC) -c $(CFLAGS) -o $@ $<
.mm.o:
$(TOOLCHAIN_PREFIX)$(CPP) -c $(CFLAGS) -o $@ $<

2
basis/alien/c-types/c-types.factor
View File

@ -436,7 +436,7 @@ M: pointer c-type
\ uint c-type \ size_t typedef
] if
cpu ppc? \ uint \ uchar ? c-type clone
cpu ppc? os macosx? and \ uint \ uchar ? c-type clone
[ >c-bool ] >>unboxer-quot
[ c-bool> ] >>boxer-quot
object >>boxed-class

4
basis/alien/libraries/libraries.factor
View File

@ -9,6 +9,8 @@ IN: alien.libraries
: dlsym ( name dll -- alien ) [ string>symbol ] dip (dlsym) ;
: dlsym-raw ( name dll -- alien ) [ string>symbol ] dip (dlsym-raw) ;
SYMBOL: libraries
libraries [ H{ } clone ] initialize
@ -48,7 +50,7 @@ M: library dispose dll>> [ dispose ] when* ;
ERROR: no-such-symbol name library ;
: address-of ( name library -- value )
2dup load-library dlsym [ 2nip ] [ no-such-symbol ] if* ;
2dup load-library dlsym-raw [ 2nip ] [ no-such-symbol ] if* ;
SYMBOL: deploy-libraries

13
basis/alien/parser/parser.factor
View File

@ -179,5 +179,16 @@ PREDICATE: alien-callback-type-word < typedef-word
swap [ name>> current-library get ] dip
'[ _ _ address-of 0 _ alien-value ] ;
: define-global ( type word -- )
: set-global-quot ( type word -- quot )
swap [ name>> current-library get ] dip
'[ _ _ address-of 0 _ set-alien-value ] ;
: define-global-getter ( type word -- )
[ nip ] [ global-quot ] 2bi (( -- value )) define-declared ;
: define-global-setter ( type word -- )
[ nip name>> "set-" prepend create-in ]
[ set-global-quot ] 2bi (( obj -- )) define-declared ;
: define-global ( type word -- )
[ define-global-getter ] [ define-global-setter ] 2bi ;

2
basis/alien/syntax/syntax-docs.factor
View File

@ -122,7 +122,7 @@ HELP: typedef
HELP: C-GLOBAL:
{ $syntax "C-GLOBAL: type name" }
{ $values { "type" "a C type" } { "name" "a C global variable name" } }
{ $description "Defines a new word named " { $snippet "name" } " which accesses a global variable in the current library, set with " { $link POSTPONE: LIBRARY: } "." } ;
{ $description "Defines a getter " { $snippet "name" } " and setter " { $snippet "set-name" } " for the global value in the current library, set with " { $link POSTPONE: LIBRARY: } "." } ;
ARTICLE: "alien.enums" "Enumeration types"
"The " { $vocab-link "alien.enums" } " vocab contains the implementation for " { $link POSTPONE: ENUM: } " C types, and provides words for converting between enum singletons and integers. It is possible to dispatch off of members of an enum."

11
basis/bootstrap/image/image.factor
View File

@ -15,10 +15,13 @@ generalizations ;
IN: bootstrap.image
: arch ( os cpu -- arch )
[ "winnt" = "winnt" "unix" ? ] dip "-" glue ;
2dup [ winnt? ] [ ppc? ] bi* or [
[ drop unix ] dip
] unless
[ name>> ] [ name>> ] bi* "-" glue ;
: my-arch ( -- arch )
os name>> cpu name>> arch ;
os cpu arch ;
: boot-image-name ( arch -- string )
"boot." ".image" surround ;
@ -29,6 +32,7 @@ IN: bootstrap.image
: images ( -- seq )
{
"winnt-x86.32" "unix-x86.32"
"linux-ppc.32" "linux-ppc.64"
"winnt-x86.64" "unix-x86.64"
} ;
@ -127,6 +131,9 @@ SYMBOL: jit-literals
: jit-dlsym ( name rc -- )
rt-dlsym jit-rel string>symbol jit-parameter f jit-parameter ;
: jit-dlsym-toc ( name rc -- )
rt-dlsym-toc jit-rel string>symbol jit-parameter f jit-parameter ;
:: jit-conditional ( test-quot false-quot -- )
[ 0 test-quot call ] B{ } make length :> len
building get length jit-offset get + len +

9
basis/classes/struct/struct-tests.factor
View File

@ -460,8 +460,13 @@ cpu ppc? [
{ y int }
{ x longlong } ;
[ 12 ] [ ppc-align-test-2 heap-size ] unit-test
[ 4 ] [ "x" ppc-align-test-2 offset-of ] unit-test
cpu ppc? 4 cell = and os macosx? and [
[ 12 ] [ ppc-align-test-2 heap-size ] unit-test
[ 4 ] [ "x" ppc-align-test-2 offset-of ] unit-test
] [
[ 16 ] [ ppc-align-test-2 heap-size ] unit-test
[ 8 ] [ "x" ppc-align-test-2 offset-of ] unit-test
] if
] when
STRUCT: struct-test-delegate

28
basis/command-line/command-line-docs.factor
View File

@ -2,13 +2,13 @@ USING: help.markup help.syntax parser vocabs.loader strings ;
IN: command-line
HELP: run-bootstrap-init
{ $description "Runs the bootstrap initialization file in the user's home directory, unless the " { $snippet "-no-user-init" } " command line switch was given. This file is named " { $snippet ".factor-boot-rc" } " on Unix and " { $snippet "factor-boot-rc" } " on Windows." } ;
{ $description "Runs the bootstrap initialization file in the user's home directory, unless the " { $snippet "-no-user-init" } " command line switch was given. This file is named " { $snippet ".factor-boot-rc" } "." } ;
HELP: run-user-init
{ $description "Runs the startup initialization file in the user's home directory, unless the " { $snippet "-no-user-init" } " command line switch was given. This file is named " { $snippet ".factor-rc" } " on Unix and " { $snippet "factor-rc" } " on Windows." } ;
{ $description "Runs the startup initialization file in the user's home directory, unless the " { $snippet "-no-user-init" } " command line switch was given. This file is named " { $snippet ".factor-rc" } "." } ;
HELP: load-vocab-roots
{ $description "Loads the newline-separated list of additional vocabulary roots from the file named " { $snippet ".factor-roots" } " on Unix and " { $snippet "factor-roots" } " on Windows." } ;
{ $description "Loads the newline-separated list of additional vocabulary roots from the file named " { $snippet ".factor-roots" } "." } ;
HELP: param
{ $values { "param" string } }
@ -92,21 +92,21 @@ ARTICLE: "standard-cli-args" "Command line switches for general usage"
{ { $snippet "-quiet" } { "If set, " { $link run-file } " and " { $link require } " will not print load messages." } }
} ;
ARTICLE: "factor-boot-rc" "Bootstrap initialization file"
"The bootstrap initialization file is named " { $snippet "factor-boot-rc" } " on Windows and " { $snippet ".factor-boot-rc" } " on Unix. This file can contain " { $link require } " calls for vocabularies you use frequently, and other such long-running tasks that you do not want to perform every time Factor starts."
ARTICLE: ".factor-boot-rc" "Bootstrap initialization file"
"The bootstrap initialization file is named " { $snippet ".factor-boot-rc" } ". This file can contain " { $link require } " calls for vocabularies you use frequently, and other such long-running tasks that you do not want to perform every time Factor starts."
$nl
"A word to run this file from an existing Factor session:"
{ $subsections run-bootstrap-init }
"For example, if you changed " { $snippet ".factor-boot-rc" } " and do not want to bootstrap again, you can just invoke " { $link run-bootstrap-init } " in the listener." ;
ARTICLE: "factor-rc" "Startup initialization file"
"The startup initialization file is named " { $snippet "factor-rc" } " on Windows and " { $snippet ".factor-rc" } " on Unix. If it exists, it is run every time Factor starts."
ARTICLE: ".factor-rc" "Startup initialization file"
"The startup initialization file is named " { $snippet ".factor-rc" } ". If it exists, it is run every time Factor starts."
$nl
"A word to run this file from an existing Factor session:"
{ $subsections run-user-init } ;
ARTICLE: "factor-roots" "Additional vocabulary roots file"
"The vocabulary roots file is named " { $snippet "factor-roots" } " on Windows and " { $snippet ".factor-roots" } " on Unix. If it exists, it is loaded every time Factor starts. It contains a newline-separated list of " { $link "vocabs.roots" } "."
ARTICLE: ".factor-roots" "Additional vocabulary roots file"
"The vocabulary roots file is named " { $snippet ".factor-roots" } " on Windows and " { $snippet ".factor-roots" } " on Unix. If it exists, it is loaded every time Factor starts. It contains a newline-separated list of " { $link "vocabs.roots" } "."
$nl
"A word to run this file from an existing Factor session:"
{ $subsections load-vocab-roots } ;
@ -114,17 +114,17 @@ $nl
ARTICLE: "rc-files" "Running code on startup"
"Factor looks for three optional files in your home directory."
{ $subsections
"factor-boot-rc"
"factor-rc"
"factor-roots"
".factor-boot-rc"
".factor-rc"
".factor-roots"
}
"The " { $snippet "-no-user-init" } " command line switch will inhibit loading running of these files."
$nl
"If you are unsure where the files should be located, evaluate the following code:"
{ $code
"USE: command-line"
"\"factor-rc\" rc-path print"
"\"factor-boot-rc\" rc-path print"
"\".factor-rc\" rc-path print"
"\".factor-boot-rc\" rc-path print"
}
"Here is an example " { $snippet ".factor-boot-rc" } " which sets up GVIM editor integration:"
{ $code

7
basis/command-line/command-line.factor
View File

@ -12,22 +12,21 @@ SYMBOL: command-line
10 special-object sift [ alien>native-string ] map ;
: rc-path ( name -- path )
os windows? [ "." prepend ] unless
home prepend-path ;
: run-bootstrap-init ( -- )
"user-init" get [
"factor-boot-rc" rc-path ?run-file
".factor-boot-rc" rc-path ?run-file
] when ;
: run-user-init ( -- )
"user-init" get [
"factor-rc" rc-path ?run-file
".factor-rc" rc-path ?run-file
] when ;
: load-vocab-roots ( -- )
"user-init" get [
"factor-roots" rc-path dup exists? [
".factor-roots" rc-path dup exists? [
utf8 file-lines harvest [ add-vocab-root ] each
] [ drop ] if
] when ;

12
basis/compiler/cfg/builder/alien/alien.factor
View File

@ -39,12 +39,12 @@ IN: compiler.cfg.builder.alien
dup large-struct? [
heap-size cell f ^^local-allot [
'[ _ prefix ]
[ int-rep struct-return-on-stack? 2array prefix ] bi*
[ int-rep struct-return-on-stack? f 3array prefix ] bi*
] keep
] [ drop f ] if ;
: (caller-parameters) ( vregs reps -- )
[ first2 next-parameter ] 2each ;
[ first3 next-parameter ] 2each ;
: caller-parameters ( params -- reg-inputs stack-inputs )
[ abi>> ] [ parameters>> ] [ return>> ] tri
@ -136,16 +136,16 @@ M: #alien-assembly emit-node
[ caller-return ]
bi ;
: callee-parameter ( rep on-stack? -- dst )
[ next-vreg dup ] 2dip next-parameter ;
: callee-parameter ( rep on-stack? odd-register? -- dst )
[ next-vreg dup ] 3dip next-parameter ;
: prepare-struct-callee ( c-type -- vreg )
large-struct?
[ int-rep struct-return-on-stack? callee-parameter ] [ f ] if ;
[ int-rep struct-return-on-stack? f callee-parameter ] [ f ] if ;
: (callee-parameters) ( params -- vregs reps )
[ flatten-parameter-type ] map
[ [ [ first2 callee-parameter ] map ] map ]
[ [ [ first3 callee-parameter ] map ] map ]
[ [ keys ] map ]
bi ;

25
basis/compiler/cfg/builder/alien/boxing/boxing.factor
View File

@ -15,19 +15,23 @@ SYMBOL: struct-return-area
GENERIC: flatten-c-type ( c-type -- pairs )
M: c-type flatten-c-type
rep>> f 2array 1array ;
rep>> f f 3array 1array ;
M: long-long-type flatten-c-type
drop 2 [ int-rep long-long-on-stack? 2array ] replicate ;
drop 2 [ int-rep long-long-on-stack? f 3array ] replicate ;
HOOK: flatten-struct-type cpu ( type -- pairs )
HOOK: flatten-struct-type-return cpu ( type -- pairs )
M: object flatten-struct-type
heap-size cell align cell /i { int-rep f } <repetition> ;
heap-size cell align cell /i { int-rep f f } <repetition> ;
M: struct-c-type flatten-c-type
flatten-struct-type ;
M: object flatten-struct-type-return
flatten-struct-type ;
: stack-size ( c-type -- n )
base-type flatten-c-type keys 0 [ rep-size + ] reduce ;
@ -40,6 +44,12 @@ M: struct-c-type flatten-c-type
[| rep offset | src offset rep f ^^load-memory-imm ] 2map
reps ;
:: explode-struct-return ( src c-type -- vregs reps )
c-type flatten-struct-type-return :> reps
reps keys dup component-offsets
[| rep offset | src offset rep f ^^load-memory-imm ] 2map
reps ;
:: implode-struct ( src vregs reps -- )
vregs reps dup component-offsets
[| vreg rep offset | vreg src offset rep f ##store-memory-imm ] 3each ;
@ -62,11 +72,12 @@ M: c-type unbox
[ swap ^^unbox ]
} case 1array
]
[ drop f 2array 1array ] 2bi ;
[ drop f f 3array 1array ] 2bi ;
M: long-long-type unbox
[ next-vreg next-vreg 2dup ] 2dip unboxer>> ##unbox-long-long 2array
int-rep long-long-on-stack? 2array dup 2array ;
int-rep long-long-on-stack? long-long-odd-register? 3array
int-rep long-long-on-stack? f 3array 2array ;
M: struct-c-type unbox ( src c-type -- vregs reps )
[ ^^unbox-any-c-ptr ] dip explode-struct ;
@ -85,7 +96,7 @@ M: struct-c-type unbox-parameter
[ nip heap-size cell f ^^local-allot dup ]
[ [ ^^unbox-any-c-ptr ] dip explode-struct keys ] 2bi
implode-struct
1array { { int-rep f } }
1array { { int-rep f f } }
] if ;
: store-return ( vregs reps -- triples )
@ -165,6 +176,6 @@ M: struct-c-type box-return
[
[
[ [ { } assert-sequence= ] bi@ struct-return-area get ] dip
explode-struct keys
explode-struct-return keys
] keep box
] if ;

38
basis/compiler/cfg/builder/alien/params/params.factor
View File

@ -1,15 +1,22 @@
! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: cpu.architecture fry kernel layouts math math.order
namespaces sequences vectors assocs arrays ;
namespaces sequences vectors assocs arrays locals ;
IN: compiler.cfg.builder.alien.params
SYMBOL: stack-params
: alloc-stack-param ( rep -- n )
GENERIC: alloc-stack-param ( reg -- n )
M: object alloc-stack-param ( rep -- n )
stack-params get
[ rep-size cell align stack-params +@ ] dip ;
M: float-rep alloc-stack-param ( rep -- n )
stack-params get swap rep-size
[ cell align stack-params +@ ] keep
float-right-align-on-stack? [ + ] [ drop ] if ;
: ?dummy-stack-params ( rep -- )
dummy-stack-params? [ alloc-stack-param drop ] [ drop ] if ;
@ -22,21 +29,29 @@ SYMBOL: stack-params
: ?dummy-fp-params ( rep -- )
drop dummy-fp-params? [ float-regs get [ pop* ] unless-empty ] when ;
GENERIC: next-reg-param ( rep -- reg )
GENERIC: next-reg-param ( odd-register? rep -- reg )
M: int-rep next-reg-param
[ ?dummy-stack-params ] [ ?dummy-fp-params ] bi
int-regs get pop ;
[ nip ?dummy-stack-params ]
[ nip ?dummy-fp-params ]
[ drop [
int-regs get last even?
[ int-regs get pop* ] when
] when ]
2tri int-regs get pop ;
M: float-rep next-reg-param
[ ?dummy-stack-params ] [ ?dummy-int-params ] bi
nip [ ?dummy-stack-params ] [ ?dummy-int-params ] bi
float-regs get pop ;
M: double-rep next-reg-param
[ ?dummy-stack-params ] [ ?dummy-int-params ] bi
nip [ ?dummy-stack-params ] [ ?dummy-int-params ] bi
float-regs get pop ;
: reg-class-full? ( reg-class -- ? ) get empty? ;
:: reg-class-full? ( reg-class odd-register? -- ? )
reg-class get empty?
reg-class get length 1 = odd-register? and
dup [ reg-class get delete-all ] when or ;
: init-reg-class ( abi reg-class -- )
[ swap param-regs at <reversed> >vector ] keep set ;
@ -49,9 +64,10 @@ M: double-rep next-reg-param
SYMBOLS: stack-values reg-values ;
: next-parameter ( vreg rep on-stack? -- )
[ dup dup reg-class-of reg-class-full? ] dip or
[ alloc-stack-param stack-values ] [ next-reg-param reg-values ] if
:: next-parameter ( vreg rep on-stack? odd-register? -- )
vreg rep on-stack?
[ dup dup reg-class-of odd-register? reg-class-full? ] dip or
[ alloc-stack-param stack-values ] [ odd-register? swap next-reg-param reg-values ] if
[ 3array ] dip get push ;
: next-return-reg ( rep -- reg ) reg-class-of get pop ;

33
basis/compiler/cfg/value-numbering/value-numbering-tests.factor
View File

@ -2080,21 +2080,24 @@ cell 8 = [
} value-numbering-step
] unit-test
[
{
T{ ##peek f 0 D 0 }
T{ ##load-integer f 2 2147483647 }
T{ ##add-imm f 3 0 2147483647 }
T{ ##add-imm f 4 3 2147483647 }
}
] [
{
T{ ##peek f 0 D 0 }
T{ ##load-integer f 2 2147483647 }
T{ ##add f 3 0 2 }
T{ ##add f 4 3 2 }
} value-numbering-step
] unit-test
! PPC ADDI can't hold immediates this big.
cpu ppc? [
[
{
T{ ##peek f 0 D 0 }
T{ ##load-integer f 2 2147483647 }
T{ ##add-imm f 3 0 2147483647 }
T{ ##add-imm f 4 3 2147483647 }
}
] [
{
T{ ##peek f 0 D 0 }
T{ ##load-integer f 2 2147483647 }
T{ ##add f 3 0 2 }
T{ ##add f 4 3 2 }
} value-numbering-step
] unit-test
] unless
] when
[

3
basis/compiler/codegen/fixup/fixup.factor
View File

@ -67,6 +67,9 @@ MEMO: cached-string>symbol ( symbol -- obj ) string>symbol ;
: rel-dlsym ( name dll class -- )
[ add-dlsym-parameters ] dip rt-dlsym rel-fixup ;
: rel-dlsym-toc ( name dll class -- )
[ add-dlsym-parameters ] dip rt-dlsym-toc rel-fixup ;
: rel-word ( word class -- )
[ add-literal ] dip rt-entry-point rel-fixup ;

6
basis/compiler/constants/constants.factor
View File

@ -45,13 +45,14 @@ CONSTANT: rc-absolute 1
CONSTANT: rc-relative 2
CONSTANT: rc-absolute-ppc-2/2 3
CONSTANT: rc-absolute-ppc-2 4
CONSTANT: rc-relative-ppc-2 5
CONSTANT: rc-relative-ppc-3 6
CONSTANT: rc-relative-ppc-2-pc 5
CONSTANT: rc-relative-ppc-3-pc 6
CONSTANT: rc-relative-arm-3 7
CONSTANT: rc-indirect-arm 8
CONSTANT: rc-indirect-arm-pc 9
CONSTANT: rc-absolute-2 10
CONSTANT: rc-absolute-1 11
CONSTANT: rc-absolute-ppc-2/2/2/2 12
! Relocation types
CONSTANT: rt-dlsym 0
@ -67,6 +68,7 @@ CONSTANT: rt-vm 9
CONSTANT: rt-cards-offset 10
CONSTANT: rt-decks-offset 11
CONSTANT: rt-exception-handler 12
CONSTANT: rt-dlsym-toc 13
: rc-absolute? ( n -- ? )
${

9
basis/cpu/architecture/architecture.factor
View File

@ -575,9 +575,18 @@ HOOK: dummy-fp-params? cpu ( -- ? )
! If t, long longs are never passed in param regs
HOOK: long-long-on-stack? cpu ( -- ? )
! If t, long longs are aligned on an odd register. On Linux
! 32-bit PPC, long longs are 8-byte aligned but passed in
! registers so they need to be aligned on an odd numbered
! (r3, r5, etc) register.
HOOK: long-long-odd-register? cpu ( -- ? )
! If t, floats are never passed in param regs
HOOK: float-on-stack? cpu ( -- ? )
! If t, put floats in the second word of a double word on the stack
HOOK: float-right-align-on-stack? cpu ( -- ? )
! If t, the struct return pointer is never passed in a param reg
HOOK: struct-return-on-stack? cpu ( -- ? )

3
basis/cpu/ppc/32/32.factor Normal file
View File

@ -0,0 +1,3 @@
! Copyright (C) 2011 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
USING: cpu.ppc ;

73
basis/cpu/ppc/32/linux/bootstrap.factor Normal file
View File

@ -0,0 +1,73 @@
! Copyright (C) 2011 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
USING: parser system kernel sequences math math.ranges
cpu.ppc.assembler combinators compiler.constants
bootstrap.image.private layouts namespaces ;
IN: bootstrap.ppc
4 \ cell set
big-endian on
: reserved-size ( -- n ) 24 ;
: lr-save ( -- n ) 4 ;
CONSTANT: ds-reg 14
CONSTANT: rs-reg 15
CONSTANT: vm-reg 16
CONSTANT: ctx-reg 17
CONSTANT: frame-reg 31
: nv-int-regs ( -- seq ) 13 31 [a,b] ;
: LOAD32 ( r n -- )
[ -16 shift HEX: ffff bitand LIS ]
[ [ dup ] dip HEX: ffff bitand ORI ] 2bi ;
: jit-trap-null ( src -- ) drop ;
: jit-load-vm ( dst -- )
0 LOAD32 0 rc-absolute-ppc-2/2 jit-vm ;
: jit-load-dlsym ( dst string -- )
[ 0 LOAD32 ] dip rc-absolute-ppc-2/2 jit-dlsym ;
: jit-load-dlsym-toc ( string -- ) drop ;
: jit-load-vm-arg ( dst -- )
0 LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel ;
: jit-load-entry-point-arg ( dst -- )
0 LOAD32 rc-absolute-ppc-2/2 rt-entry-point jit-rel ;
: jit-load-this-arg ( dst -- )
0 LOAD32 rc-absolute-ppc-2/2 rt-this jit-rel ;
: jit-load-literal-arg ( dst -- )
0 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel ;
: jit-load-dlsym-arg ( dst -- )
0 LOAD32 rc-absolute-ppc-2/2 rt-dlsym jit-rel ;
: jit-load-dlsym-toc-arg ( -- ) ;
: jit-load-here-arg ( dst -- )
0 LOAD32 rc-absolute-ppc-2/2 rt-here jit-rel ;
: jit-load-megamorphic-cache-arg ( dst -- )
0 LOAD32 rc-absolute-ppc-2/2 rt-megamorphic-cache-hits jit-rel ;
: jit-load-cell ( dst src offset -- ) LWZ ;
: jit-load-cell-x ( dst src offset -- ) LWZX ;
: jit-load-cell-update ( dst src offset -- ) LWZU ;
: jit-save-cell ( dst src offset -- ) STW ;
: jit-save-cell-x ( dst src offset -- ) STWX ;
: jit-save-cell-update ( dst src offset -- ) STWU ;
: jit-load-int ( dst src offset -- ) LWZ ;
: jit-save-int ( dst src offset -- ) STW ;
: jit-shift-tag-bits ( dst src -- ) tag-bits get SRAWI ;
: jit-mask-tag-bits ( dst src -- ) tag-bits get CLRRWI ;
: jit-shift-fixnum-slot ( dst src -- ) 2 SRAWI ;
: jit-class-hashcode ( dst src -- ) 1 SRAWI ;
: jit-shift-left-logical ( dst src n -- ) SLW ;
: jit-shift-left-logical-imm ( dst src n -- ) SLWI ;
: jit-shift-right-algebraic ( dst src n -- ) SRAW ;
: jit-divide ( dst ra rb -- ) DIVW ;
: jit-multiply-low ( dst ra rb -- ) MULLW ;
: jit-multiply-low-ov-rc ( dst ra rb -- ) MULLWO. ;
: jit-compare-cell ( cr ra rb -- ) CMPW ;
: jit-compare-cell-imm ( cr ra imm -- ) CMPWI ;
: cell-size ( -- n ) 4 ;
: factor-area-size ( -- n ) 16 ;
: param-size ( -- n ) 32 ;
: saved-int-regs-size ( -- n ) 96 ;
<< "vocab:cpu/ppc/bootstrap.factor" parse-file suffix! >>
call

46
basis/cpu/ppc/32/linux/linux.factor Normal file
View File

@ -0,0 +1,46 @@
! Copyright (C) 2011 Erik Charlebois
! See http://factorcode.org/license.txt for BSD license.
USING: accessors system kernel layouts combinators
compiler.cfg.builder.alien.boxing sequences arrays
alien.c-types cpu.architecture cpu.ppc alien.complex ;
IN: cpu.ppc.32.linux
M: linux lr-save ( -- n ) 1 cells ;
M: linux has-toc ( -- ? ) f ;
M: linux reserved-area-size ( -- n ) 2 cells ;
M: linux allows-null-dereference ( -- ? ) f ;
M: ppc param-regs
drop {
{ int-regs { 3 4 5 6 7 8 9 10 } }
{ float-regs { 1 2 3 4 5 6 7 8 } }
} ;
M: ppc value-struct?
c-type [ complex-double c-type = ]
[ complex-float c-type = ] bi or ;
M: ppc dummy-stack-params? f ;
M: ppc dummy-int-params? f ;
M: ppc dummy-fp-params? f ;
M: ppc long-long-on-stack? f ;
M: ppc long-long-odd-register? t ;
M: ppc float-right-align-on-stack? f ;
M: ppc flatten-struct-type ( type -- seq )
{
{ [ dup c-type complex-double c-type = ]
[ drop { { int-rep f f } { int-rep f f }
{ int-rep f f } { int-rep f f } } ] }
{ [ dup c-type complex-float c-type = ]
[ drop { { int-rep f f } { int-rep f f } } ] }
[ call-next-method [ first t f 3array ] map ]
} cond ;

3
basis/cpu/ppc/64/64.factor Normal file
View File

@ -0,0 +1,3 @@
! Copyright (C) 2011 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
USING: cpu.ppc ;

80
basis/cpu/ppc/64/linux/bootstrap.factor Normal file
View File

@ -0,0 +1,80 @@
! Copyright (C) 2011 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
USING: parser system kernel sequences math math.ranges
cpu.ppc.assembler combinators compiler.constants
bootstrap.image.private layouts namespaces ;
IN: bootstrap.ppc
8 \ cell set
big-endian on
: reserved-size ( -- n ) 48 ;
: lr-save ( -- n ) 16 ;
CONSTANT: ds-reg 14
CONSTANT: rs-reg 15
CONSTANT: vm-reg 16
CONSTANT: ctx-reg 17
CONSTANT: frame-reg 31
: nv-int-regs ( -- seq ) 13 31 [a,b] ;
: LOAD64 ( r n -- )
[ dup ] dip {
[ nip -48 shift HEX: ffff bitand LIS ]
[ -32 shift HEX: ffff bitand ORI ]
[ drop 32 SLDI ]
[ -16 shift HEX: ffff bitand ORIS ]
[ HEX: ffff bitand ORI ]
} 3cleave ;
: jit-trap-null ( src -- ) drop ;
: jit-load-vm ( dst -- )
0 LOAD64 0 rc-absolute-ppc-2/2/2/2 jit-vm ;
: jit-load-dlsym ( dst string -- )
[ 0 LOAD64 ] dip rc-absolute-ppc-2/2/2/2 jit-dlsym ;
: jit-load-dlsym-toc ( string -- )
[ 2 0 LOAD64 ] dip rc-absolute-ppc-2/2/2/2 jit-dlsym-toc ;
: jit-load-vm-arg ( dst -- )
0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-vm jit-rel ;
: jit-load-entry-point-arg ( dst -- )
0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-entry-point jit-rel ;
: jit-load-this-arg ( dst -- )
0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-this jit-rel ;
: jit-load-literal-arg ( dst -- )
0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-literal jit-rel ;
: jit-load-dlsym-arg ( dst -- )
0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-dlsym jit-rel ;
: jit-load-dlsym-toc-arg ( -- )
2 0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-dlsym-toc jit-rel ;
: jit-load-here-arg ( dst -- )
0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-here jit-rel ;
: jit-load-megamorphic-cache-arg ( dst -- )
0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-megamorphic-cache-hits jit-rel ;
: jit-load-cell ( dst src offset -- ) LD ;
: jit-load-cell-x ( dst src offset -- ) LDX ;
: jit-load-cell-update ( dst src offset -- ) LDU ;
: jit-save-cell ( dst src offset -- ) STD ;
: jit-save-cell-x ( dst src offset -- ) STDX ;
: jit-save-cell-update ( dst src offset -- ) STDU ;
: jit-load-int ( dst src offset -- ) LD ;
: jit-save-int ( dst src offset -- ) STD ;
: jit-shift-tag-bits ( dst src -- ) tag-bits get SRADI ;
: jit-mask-tag-bits ( dst src -- ) tag-bits get CLRRDI ;
: jit-shift-fixnum-slot ( dst src -- ) 1 SRADI ;
: jit-class-hashcode ( dst src -- ) 1 SRADI ;
: jit-shift-left-logical ( dst src n -- ) SLD ;
: jit-shift-left-logical-imm ( dst src n -- ) SLDI ;
: jit-shift-right-algebraic ( dst src n -- ) SRAD ;
: jit-divide ( dst ra rb -- ) DIVD ;
: jit-multiply-low ( dst ra rb -- ) MULLD ;
: jit-multiply-low-ov-rc ( dst ra rb -- ) MULLDO. ;
: jit-compare-cell ( cr ra rb -- ) CMPD ;
: jit-compare-cell-imm ( cr ra imm -- ) CMPDI ;
: cell-size ( -- n ) 8 ;
: factor-area-size ( -- n ) 32 ;
: param-size ( -- n ) 64 ;
: saved-int-regs-size ( -- n ) 192 ;
<< "vocab:cpu/ppc/bootstrap.factor" parse-file suffix! >>
call

52
basis/cpu/ppc/64/linux/linux.factor Normal file
View File

@ -0,0 +1,52 @@
! Copyright (C) 2011 Erik Charlebois
! See http://factorcode.org/license.txt for BSD license.
USING: accessors system kernel layouts combinators
compiler.cfg.builder.alien.boxing sequences arrays math
alien.c-types cpu.architecture cpu.ppc alien.complex ;
IN: cpu.ppc.64.linux
M: linux lr-save 2 cells ;
M: linux has-toc ( -- ? ) t ;
M: linux reserved-area-size ( -- n ) 6 cells ;
M: linux allows-null-dereference ( -- ? ) f ;
M: ppc param-regs
drop {
{ int-regs { 3 4 5 6 7 8 9 10 } }
{ float-regs { 1 2 3 4 5 6 7 8 9 10 11 12 13 } }
} ;
M: ppc value-struct? drop t ;
M: ppc dummy-stack-params? t ;
M: ppc dummy-int-params? t ;
M: ppc dummy-fp-params? f ;
M: ppc long-long-on-stack? f ;
M: ppc long-long-odd-register? f ;
M: ppc float-right-align-on-stack? t ;
M: ppc flatten-struct-type ( type -- seq )
{
{ [ dup c-type complex-double c-type = ]
[ drop { { double-rep f f } { double-rep f f } } ] }
{ [ dup c-type complex-float c-type = ]
[ drop { { float-rep f f } { float-rep f f } } ] }
[ heap-size cell align cell /i { int-rep f f } <repetition> ]
} cond ;
M: ppc flatten-struct-type-return ( type -- seq )
{
{ [ dup c-type complex-double c-type = ]
[ drop { { double-rep f f } { double-rep f f } } ] }
{ [ dup c-type complex-float c-type = ]
[ drop { { float-rep f f } { float-rep f f } } ] }
[ heap-size cell align cell /i { int-rep t f } <repetition> ]
} cond ;

2005
basis/cpu/ppc/assembler/assembler.factor Normal file
View File

File diff suppressed because it is too large Load Diff

1
basis/cpu/ppc/authors.txt Normal file
View File

@ -0,0 +1 @@
Erik Charlebois

845
basis/cpu/ppc/bootstrap.factor Normal file
View File

@ -0,0 +1,845 @@
! Copyright (C) 2011 Erik Charlebois
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel kernel.private namespaces
system cpu.ppc.assembler compiler.units compiler.constants math
math.private math.ranges layouts words vocabs slots.private
locals locals.backend generic.single.private fry sequences
threads.private strings.private ;
FROM: cpu.ppc.assembler => B ;
IN: bootstrap.ppc
: jit-call ( string -- )
dup
0 swap jit-load-dlsym
0 MTLR
jit-load-dlsym-toc
BLRL ;
: jit-call-quot ( -- )
4 quot-entry-point-offset LI
4 3 4 jit-load-cell-x
4 MTLR
BLRL ;
: jit-jump-quot ( -- )
4 quot-entry-point-offset LI
4 3 4 jit-load-cell-x
4 MTCTR
BCTR ;
: stack-frame ( -- n )
reserved-size factor-area-size + 16 align ;
: save-at ( m -- n ) reserved-size + param-size + ;
: save-int ( reg off -- ) [ 1 ] dip save-at jit-save-int ;
: save-fp ( reg off -- ) [ 1 ] dip save-at STFD ;
: save-vec ( reg offt -- ) save-at 11 swap LI 11 1 STVXL ;
: restore-int ( reg off -- ) [ 1 ] dip save-at jit-load-int ;
: restore-fp ( reg off -- ) [ 1 ] dip save-at LFD ;
: restore-vec ( reg offt -- ) save-at 11 swap LI 11 1 LVXL ;
! Stop using intervals here.
: nv-fp-regs ( -- seq ) 14 31 [a,b] ;
: nv-vec-regs ( -- seq ) 20 31 [a,b] ;
: saved-fp-regs-size ( -- n ) 144 ;
: saved-vec-regs-size ( -- n ) 192 ;
: callback-frame-size ( -- n )
reserved-size
param-size +
saved-int-regs-size +
saved-fp-regs-size +
saved-vec-regs-size +
16 align ;
: old-context-save-offset ( -- n )
cell-size 20 * saved-fp-regs-size + saved-vec-regs-size + save-at ;
[
! Save old stack pointer
11 1 MR
0 MFLR ! Get return address
0 1 lr-save jit-save-cell ! Stash return address
1 1 callback-frame-size neg jit-save-cell-update ! Bump stack pointer and set back chain
! Save all non-volatile registers
nv-int-regs [ cell-size * save-int ] each-index
nv-fp-regs [ 8 * saved-int-regs-size + save-fp ] each-index
! nv-vec-regs [ 16 * saved-int-regs-size saved-fp-regs-size + + save-vec ] each-index
! Stick old stack pointer in the frame register so callbacks
! can access their arguments
frame-reg 11 MR
! Load VM into vm-reg
vm-reg jit-load-vm-arg
! Save old context
0 vm-reg vm-context-offset jit-load-cell
0 1 old-context-save-offset jit-save-cell
! Switch over to the spare context
11 vm-reg vm-spare-context-offset jit-load-cell
11 vm-reg vm-context-offset jit-save-cell
! Save C callstack pointer and load Factor callstack
1 11 context-callstack-save-offset jit-save-cell
1 11 context-callstack-bottom-offset jit-load-cell
! Load new data and retain stacks
rs-reg 11 context-retainstack-offset jit-load-cell
ds-reg 11 context-datastack-offset jit-load-cell
! Call into Factor code
0 jit-load-entry-point-arg
0 MTLR
BLRL
! Load VM again, pointlessly
vm-reg jit-load-vm-arg
! Load C callstack pointer
11 vm-reg vm-context-offset jit-load-cell
1 11 context-callstack-save-offset jit-load-cell
! Load old context
0 1 old-context-save-offset jit-load-cell
0 vm-reg vm-context-offset jit-save-cell
! Restore non-volatile registers
! nv-vec-regs [ 16 * saved-int-regs-size saved-float-regs-size + + restore-vec ] each-index
nv-fp-regs [ 8 * saved-int-regs-size + restore-fp ] each-index
nv-int-regs [ cell-size * restore-int ] each-index
1 1 callback-frame-size ADDI ! Bump stack back up
0 1 lr-save jit-load-cell ! Fetch return address
0 MTLR ! Set up return
BLR ! Branch back
] callback-stub jit-define
: jit-conditional* ( test-quot false-quot -- )
[ '[ 4 + @ ] ] dip jit-conditional ; inline
: jit-load-context ( -- )
ctx-reg vm-reg vm-context-offset jit-load-cell ;
: jit-save-context ( -- )
jit-load-context
1 ctx-reg context-callstack-top-offset jit-save-cell
ds-reg ctx-reg context-datastack-offset jit-save-cell
rs-reg ctx-reg context-retainstack-offset jit-save-cell ;
: jit-restore-context ( -- )
ds-reg ctx-reg context-datastack-offset jit-load-cell
rs-reg ctx-reg context-retainstack-offset jit-load-cell ;
[
12 jit-load-literal-arg
0 profile-count-offset LI
11 12 0 jit-load-cell-x
11 11 1 tag-fixnum ADDI
11 12 0 jit-save-cell-x
0 word-code-offset LI
11 12 0 jit-load-cell-x
11 11 compiled-header-size ADDI
11 MTCTR
BCTR
] jit-profiling jit-define
[
0 MFLR
0 1 lr-save jit-save-cell
0 jit-load-this-arg
0 1 cell-size 2 * neg jit-save-cell
0 stack-frame LI
0 1 cell-size 1 * neg jit-save-cell
1 1 stack-frame neg jit-save-cell-update
] jit-prolog jit-define
[
3 jit-load-literal-arg
3 ds-reg cell-size jit-save-cell-update
] jit-push jit-define
[
jit-save-context
3 vm-reg MR
4 jit-load-dlsym-arg
4 MTLR
jit-load-dlsym-toc-arg ! Restore the TOC/GOT
BLRL
jit-restore-context
] jit-primitive jit-define
[ 0 BL rc-relative-ppc-3-pc rt-entry-point-pic jit-rel ] jit-word-call jit-define
[
6 jit-load-here-arg
0 B rc-relative-ppc-3-pc rt-entry-point-pic-tail jit-rel
] jit-word-jump jit-define
[
3 ds-reg 0 jit-load-cell
ds-reg dup cell-size SUBI
0 3 \ f type-number jit-compare-cell-imm
[ 0 swap BEQ ] [ 0 B rc-relative-ppc-3-pc rt-entry-point jit-rel ] jit-conditional*
0 B rc-relative-ppc-3-pc rt-entry-point jit-rel
] jit-if jit-define
: jit->r ( -- )
4 ds-reg 0 jit-load-cell
ds-reg dup cell-size SUBI
4 rs-reg cell-size jit-save-cell-update ;
: jit-2>r ( -- )
4 ds-reg 0 jit-load-cell
5 ds-reg cell-size neg jit-load-cell
ds-reg dup 2 cell-size * SUBI
rs-reg dup 2 cell-size * ADDI
4 rs-reg 0 jit-save-cell
5 rs-reg cell-size neg jit-save-cell ;
: jit-3>r ( -- )
4 ds-reg 0 jit-load-cell
5 ds-reg cell-size neg jit-load-cell
6 ds-reg cell-size neg 2 * jit-load-cell
ds-reg dup 3 cell-size * SUBI
rs-reg dup 3 cell-size * ADDI
4 rs-reg 0 jit-save-cell
5 rs-reg cell-size neg jit-save-cell
6 rs-reg cell-size neg 2 * jit-save-cell ;
: jit-r> ( -- )
4 rs-reg 0 jit-load-cell
rs-reg dup cell-size SUBI
4 ds-reg cell-size jit-save-cell-update ;
: jit-2r> ( -- )
4 rs-reg 0 jit-load-cell
5 rs-reg cell-size neg jit-load-cell
rs-reg dup 2 cell-size * SUBI
ds-reg dup 2 cell-size * ADDI
4 ds-reg 0 jit-save-cell
5 ds-reg cell-size neg jit-save-cell ;
: jit-3r> ( -- )
4 rs-reg 0 jit-load-cell
5 rs-reg cell-size neg jit-load-cell
6 rs-reg cell-size neg 2 * jit-load-cell
rs-reg dup 3 cell-size * SUBI
ds-reg dup 3 cell-size * ADDI
4 ds-reg 0 jit-save-cell
5 ds-reg cell-size neg jit-save-cell
6 ds-reg cell-size neg 2 * jit-save-cell ;
[
jit->r
0 BL rc-relative-ppc-3-pc rt-entry-point jit-rel
jit-r>
] jit-dip jit-define
[
jit-2>r
0 BL rc-relative-ppc-3-pc rt-entry-point jit-rel
jit-2r>
] jit-2dip jit-define
[
jit-3>r
0 BL rc-relative-ppc-3-pc rt-entry-point jit-rel
jit-3r>
] jit-3dip jit-define
[
1 1 stack-frame ADDI
0 1 lr-save jit-load-cell
0 MTLR
] jit-epilog jit-define
[ BLR ] jit-return jit-define
! ! ! Polymorphic inline caches
! Don't touch r6 here; it's used to pass the tail call site
! address for tail PICs
! Load a value from a stack position
[
4 ds-reg 0 jit-load-cell rc-absolute-ppc-2 rt-untagged jit-rel
] pic-load jit-define
[ 4 4 tag-mask get ANDI. ] pic-tag jit-define
[
3 4 MR
4 4 tag-mask get ANDI.
0 4 tuple type-number jit-compare-cell-imm
[ 0 swap BNE ]
[ 4 tuple-class-offset LI 4 3 4 jit-load-cell-x ]
jit-conditional*
] pic-tuple jit-define
[
0 4 0 jit-compare-cell-imm rc-absolute-ppc-2 rt-untagged jit-rel
] pic-check-tag jit-define
[
5 jit-load-literal-arg
0 4 5 jit-compare-cell
] pic-check-tuple jit-define
[
[ 0 swap BNE ] [ 0 B rc-relative-ppc-3-pc rt-entry-point jit-rel ] jit-conditional*
] pic-hit jit-define
! Inline cache miss entry points
: jit-load-return-address ( -- ) 6 MFLR ;
! These are always in tail position with an existing stack
! frame, and the stack. The frame setup takes this into account.
: jit-inline-cache-miss ( -- )
jit-save-context
3 6 MR
4 vm-reg MR
ctx-reg 6 MR
"inline_cache_miss" jit-call
6 ctx-reg MR
jit-load-context
jit-restore-context ;
[ jit-load-return-address jit-inline-cache-miss ]
[ 3 MTLR BLRL ]
[ 3 MTCTR BCTR ]
\ inline-cache-miss define-combinator-primitive
[ jit-inline-cache-miss ]
[ 3 MTLR BLRL ]
[ 3 MTCTR BCTR ]
\ inline-cache-miss-tail define-combinator-primitive
! ! ! Megamorphic caches
[
! class = ...
3 4 MR
4 4 tag-mask get ANDI. ! Mask and...
4 4 tag-bits get jit-shift-left-logical-imm ! shift tag bits to fixnum
0 4 tuple type-number tag-fixnum jit-compare-cell-imm
[ 0 swap BNE ]
[ 4 tuple-class-offset LI 4 3 4 jit-load-cell-x ]
jit-conditional*
! cache = ...
3 jit-load-literal-arg
! key = hashcode(class)
5 4 jit-class-hashcode
! key &= cache.length - 1
5 5 mega-cache-size get 1 - 4 * ANDI.
! cache += array-start-offset
3 3 array-start-offset ADDI
! cache += key
3 3 5 ADD
! if(get(cache) == class)
6 3 0 jit-load-cell
0 6 4 jit-compare-cell
[ 0 swap BNE ]
[
! megamorphic_cache_hits++
4 jit-load-megamorphic-cache-arg
5 4 0 jit-load-cell
5 5 1 ADDI
5 4 0 jit-save-cell
! ... goto get(cache + cell-size)
5 word-entry-point-offset LI
3 3 cell-size jit-load-cell
3 3 5 jit-load-cell-x
3 MTCTR
BCTR
]
jit-conditional*
! fall-through on miss
] mega-lookup jit-define
! ! ! Sub-primitives
! Quotations and words
[
3 ds-reg 0 jit-load-cell
ds-reg dup cell-size SUBI
]
[ jit-call-quot ]
[ jit-jump-quot ] \ (call) define-combinator-primitive
[
3 ds-reg 0 jit-load-cell
ds-reg dup cell-size SUBI
4 word-entry-point-offset LI
4 3 4 jit-load-cell-x
]
[ 4 MTLR BLRL ]
[ 4 MTCTR BCTR ] \ (execute) define-combinator-primitive
[
3 ds-reg 0 jit-load-cell
ds-reg dup cell-size SUBI
4 word-entry-point-offset LI
4 3 4 jit-load-cell-x
4 MTCTR BCTR
] jit-execute jit-define
! Special primitives
[
frame-reg 3 MR
3 vm-reg MR
"begin_callback" jit-call
jit-load-context
jit-restore-context
! Call quotation
3 frame-reg MR
jit-call-quot
jit-save-context
3 vm-reg MR
"end_callback" jit-call
] \ c-to-factor define-sub-primitive
[
! Unwind stack frames
1 4 MR
! Load VM pointer into vm-reg, since we're entering from
! C code
vm-reg jit-load-vm
! Load ds and rs registers
jit-load-context
jit-restore-context
! We have changed the stack; load return address again
0 1 lr-save jit-load-cell
0 MTLR
! Call quotation
jit-jump-quot
] \ unwind-native-frames define-sub-primitive
[
7 0 LI
7 1 lr-save jit-save-cell
! Load callstack object
6 ds-reg 0 jit-load-cell
ds-reg ds-reg cell-size SUBI
! Get ctx->callstack_bottom
jit-load-context
3 ctx-reg context-callstack-bottom-offset jit-load-cell
! Get top of callstack object -- 'src' for memcpy
4 6 callstack-top-offset ADDI
! Get callstack length, in bytes --- 'len' for memcpy
7 callstack-length-offset LI
5 6 7 jit-load-cell-x
5 5 jit-shift-tag-bits
! Compute new stack pointer -- 'dst' for memcpy
3 3 5 SUB
! Install new stack pointer
1 3 MR
! Call memcpy; arguments are now in the correct registers
1 1 -16 cell-size * jit-save-cell-update
"factor_memcpy" jit-call
1 1 0 jit-load-cell
! Return with new callstack
0 1 lr-save jit-load-cell
0 MTLR
BLR
] \ set-callstack define-sub-primitive
[
jit-save-context
4 vm-reg MR
"lazy_jit_compile" jit-call
]
[ jit-call-quot ]
[ jit-jump-quot ]
\ lazy-jit-compile define-combinator-primitive
! Objects
[
3 ds-reg 0 jit-load-cell
3 3 tag-mask get ANDI.
3 3 tag-bits get jit-shift-left-logical-imm
3 ds-reg 0 jit-save-cell
] \ tag define-sub-primitive
[
3 ds-reg 0 jit-load-cell ! Load m
4 ds-reg cell-size neg jit-load-cell-update ! Load obj
3 3 jit-shift-fixnum-slot ! Shift to a cell-size multiple
4 4 jit-mask-tag-bits ! Clear tag bits on obj
3 4 3 jit-load-cell-x ! Load cell at &obj[m]
3 ds-reg 0 jit-save-cell ! Push the result to the stack
] \ slot define-sub-primitive
[
! load string index from stack
3 ds-reg cell-size neg jit-load-cell
3 3 jit-shift-tag-bits
! load string from stack
4 ds-reg 0 jit-load-cell
! load character
4 4 string-offset ADDI
3 3 4 LBZX
3 3 tag-bits get jit-shift-left-logical-imm
! store character to stack
ds-reg ds-reg cell-size SUBI
3 ds-reg 0 jit-save-cell
] \ string-nth-fast define-sub-primitive
! Shufflers
[
ds-reg dup cell-size SUBI
] \ drop define-sub-primitive
[
ds-reg dup 2 cell-size * SUBI
] \ 2drop define-sub-primitive
[
ds-reg dup 3 cell-size * SUBI
] \ 3drop define-sub-primitive
[
3 ds-reg 0 jit-load-cell
3 ds-reg cell-size jit-save-cell-update
] \ dup define-sub-primitive
[
3 ds-reg 0 jit-load-cell
4 ds-reg cell-size neg jit-load-cell
ds-reg dup 2 cell-size * ADDI
3 ds-reg 0 jit-save-cell
4 ds-reg cell-size neg jit-save-cell
] \ 2dup define-sub-primitive
[
3 ds-reg 0 jit-load-cell
4 ds-reg cell-size neg jit-load-cell
5 ds-reg cell-size neg 2 * jit-load-cell
ds-reg dup cell-size 3 * ADDI
3 ds-reg 0 jit-save-cell
4 ds-reg cell-size neg jit-save-cell
5 ds-reg cell-size neg 2 * jit-save-cell
] \ 3dup define-sub-primitive
[
3 ds-reg 0 jit-load-cell
ds-reg dup cell-size SUBI
3 ds-reg 0 jit-save-cell
] \ nip define-sub-primitive
[
3 ds-reg 0 jit-load-cell
ds-reg dup cell-size 2 * SUBI
3 ds-reg 0 jit-save-cell
] \ 2nip define-sub-primitive
[
3 ds-reg cell-size neg jit-load-cell
3 ds-reg cell-size jit-save-cell-update
] \ over define-sub-primitive
[
3 ds-reg cell-size neg 2 * jit-load-cell
3 ds-reg cell-size jit-save-cell-update
] \ pick define-sub-primitive
[
3 ds-reg 0 jit-load-cell
4 ds-reg cell-size neg jit-load-cell
4 ds-reg 0 jit-save-cell
3 ds-reg cell-size jit-save-cell-update
] \ dupd define-sub-primitive
[
3 ds-reg 0 jit-load-cell
4 ds-reg cell-size neg jit-load-cell
3 ds-reg cell-size neg jit-save-cell
4 ds-reg 0 jit-save-cell
] \ swap define-sub-primitive
[
3 ds-reg cell-size neg jit-load-cell
4 ds-reg cell-size neg 2 * jit-load-cell
3 ds-reg cell-size neg 2 * jit-save-cell
4 ds-reg cell-size neg jit-save-cell
] \ swapd define-sub-primitive
[
3 ds-reg 0 jit-load-cell
4 ds-reg cell-size neg jit-load-cell
5 ds-reg cell-size neg 2 * jit-load-cell
4 ds-reg cell-size neg 2 * jit-save-cell
3 ds-reg cell-size neg jit-save-cell
5 ds-reg 0 jit-save-cell
] \ rot define-sub-primitive
[
3 ds-reg 0 jit-load-cell
4 ds-reg cell-size neg jit-load-cell
5 ds-reg cell-size neg 2 * jit-load-cell
3 ds-reg cell-size neg 2 * jit-save-cell
5 ds-reg cell-size neg jit-save-cell
4 ds-reg 0 jit-save-cell
] \ -rot define-sub-primitive
[ jit->r ] \ load-local define-sub-primitive
! Comparisons
: jit-compare ( insn -- )
t jit-literal
3 jit-load-literal-arg
4 ds-reg 0 jit-load-cell
5 ds-reg cell-size neg jit-load-cell-update
0 5 4 jit-compare-cell
[ 0 8 ] dip execute( cr offset -- )
3 \ f type-number LI
3 ds-reg 0 jit-save-cell ;
: define-jit-compare ( insn word -- )
[ [ jit-compare ] curry ] dip define-sub-primitive ;
\ BEQ \ eq? define-jit-compare
\ BGE \ fixnum>= define-jit-compare
\ BLE \ fixnum<= define-jit-compare
\ BGT \ fixnum> define-jit-compare
\ BLT \ fixnum< define-jit-compare
! Math
[
3 ds-reg 0 jit-load-cell
ds-reg ds-reg cell-size SUBI
4 ds-reg 0 jit-load-cell
3 3 4 OR
3 3 tag-mask get ANDI.
4 \ f type-number LI
0 3 0 jit-compare-cell-imm
[ 0 swap BNE ] [ 4 1 tag-fixnum LI ] jit-conditional*
4 ds-reg 0 jit-save-cell
] \ both-fixnums? define-sub-primitive
: jit-math ( insn -- )
3 ds-reg 0 jit-load-cell
4 ds-reg cell-size neg jit-load-cell-update
[ 5 3 4 ] dip execute( dst src1 src2 -- )
5 ds-reg 0 jit-save-cell ;
[ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
[ \ SUBF jit-math ] \ fixnum-fast define-sub-primitive
[
3 ds-reg 0 jit-load-cell
4 ds-reg cell-size neg jit-load-cell-update
4 4 jit-shift-tag-bits
5 3 4 jit-multiply-low
5 ds-reg 0 jit-save-cell
] \ fixnum*fast define-sub-primitive
[ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
[ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
[ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
[
3 ds-reg 0 jit-load-cell
3 3 NOT
3 3 tag-mask get XORI
3 ds-reg 0 jit-save-cell
] \ fixnum-bitnot define-sub-primitive
[
3 ds-reg 0 jit-load-cell ! Load amount to shift
3 3 jit-shift-tag-bits ! Shift out tag bits
ds-reg ds-reg cell-size SUBI
4 ds-reg 0 jit-load-cell ! Load value to shift
5 4 3 jit-shift-left-logical ! Shift left
6 3 NEG ! Negate shift amount
7 4 6 jit-shift-right-algebraic ! Shift right
7 7 jit-mask-tag-bits ! Mask out tag bits
0 3 0 jit-compare-cell-imm
[ 0 swap BGT ] [ 5 7 MR ] jit-conditional*
5 ds-reg 0 jit-save-cell
] \ fixnum-shift-fast define-sub-primitive
[
3 ds-reg 0 jit-load-cell
ds-reg ds-reg cell-size SUBI
4 ds-reg 0 jit-load-cell
5 4 3 jit-divide
6 5 3 jit-multiply-low
7 4 6 SUB
7 ds-reg 0 jit-save-cell
] \ fixnum-mod define-sub-primitive
[
3 ds-reg 0 jit-load-cell
ds-reg ds-reg cell-size SUBI
4 ds-reg 0 jit-load-cell
5 4 3 jit-divide
5 5 tag-bits get jit-shift-left-logical-imm
5 ds-reg 0 jit-save-cell
] \ fixnum/i-fast define-sub-primitive
[
3 ds-reg 0 jit-load-cell
4 ds-reg cell-size neg jit-load-cell
5 4 3 jit-divide
6 5 3 jit-multiply-low
7 4 6 SUB
5 5 tag-bits get jit-shift-left-logical-imm
5 ds-reg cell-size neg jit-save-cell
7 ds-reg 0 jit-save-cell
] \ fixnum/mod-fast define-sub-primitive
[
3 ds-reg 0 jit-load-cell
3 3 jit-shift-fixnum-slot
3 rs-reg 3 jit-load-cell-x
3 ds-reg 0 jit-save-cell
] \ get-local define-sub-primitive
[
3 ds-reg 0 jit-load-cell
ds-reg ds-reg cell-size SUBI
3 3 jit-shift-fixnum-slot
rs-reg rs-reg 3 SUB
] \ drop-locals define-sub-primitive
! Overflowing fixnum arithmetic
:: jit-overflow ( insn func -- )
ds-reg ds-reg cell-size SUBI
jit-save-context
3 ds-reg 0 jit-load-cell
4 ds-reg cell-size jit-load-cell
0 0 LI
0 MTXER
6 4 3 insn call( d a s -- )
6 ds-reg 0 jit-save-cell
[ 0 swap BNS ]
[
5 vm-reg MR
func jit-call
]
jit-conditional* ;
[ [ ADDO. ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
[ [ SUBFO. ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
[
ds-reg ds-reg cell-size SUBI
jit-save-context
3 ds-reg 0 jit-load-cell
3 3 jit-shift-tag-bits
4 ds-reg cell-size jit-load-cell
0 0 LI
0 MTXER
6 3 4 jit-multiply-low-ov-rc
6 ds-reg 0 jit-save-cell
[ 0 swap BNS ]
[
4 4 jit-shift-tag-bits
5 vm-reg MR
"overflow_fixnum_multiply" jit-call
]
jit-conditional*
] \ fixnum* define-sub-primitive
! Contexts
:: jit-switch-context ( reg -- )
7 0 LI
7 1 lr-save jit-save-cell
! Make the new context the current one
ctx-reg reg MR
ctx-reg vm-reg vm-context-offset jit-save-cell
! Load new stack pointer
1 ctx-reg context-callstack-top-offset jit-load-cell
! Load new ds, rs registers
jit-restore-context ;
: jit-pop-context-and-param ( -- )
3 ds-reg 0 jit-load-cell
4 alien-offset LI
3 3 4 jit-load-cell-x
4 ds-reg cell-size neg jit-load-cell
ds-reg ds-reg cell-size 2 * SUBI ;
: jit-push-param ( -- )
ds-reg ds-reg cell-size ADDI
4 ds-reg 0 jit-save-cell ;
: jit-set-context ( -- )
jit-pop-context-and-param
jit-save-context
3 jit-switch-context
jit-push-param ;
[ jit-set-context ] \ (set-context) define-sub-primitive
: jit-pop-quot-and-param ( -- )
3 ds-reg 0 jit-load-cell
4 ds-reg cell-size neg jit-load-cell
ds-reg ds-reg cell-size 2 * SUBI ;
: jit-start-context ( -- )
! Create the new context in return-reg. Have to save context
! twice, first before calling new_context() which may GC,
! and again after popping the two parameters from the stack.
jit-save-context
3 vm-reg MR
"new_context" jit-call
6 3 MR
jit-pop-quot-and-param
jit-save-context
6 jit-switch-context
jit-push-param
jit-jump-quot ;
[ jit-start-context ] \ (start-context) define-sub-primitive
: jit-delete-current-context ( -- )
jit-load-context
3 vm-reg MR
4 ctx-reg MR
"delete_context" jit-call ;
[
jit-delete-current-context
jit-set-context
] \ (set-context-and-delete) define-sub-primitive
: jit-start-context-and-delete ( -- )
jit-load-context
3 vm-reg MR
4 ctx-reg MR
"reset_context" jit-call
jit-pop-quot-and-param
ctx-reg jit-switch-context
jit-push-param
jit-jump-quot ;
[
jit-start-context-and-delete
] \ (start-context-and-delete) define-sub-primitive
[ "bootstrap.ppc" forget-vocab ] with-compilation-unit

1084
basis/cpu/ppc/ppc.factor Normal file
View File

File diff suppressed because it is too large Load Diff

1
basis/cpu/ppc/summary.txt Normal file
View File

@ -0,0 +1 @@
32-bit and 64-bit PowerPC compiler backends

2
basis/cpu/x86/32/32.factor
View File

@ -228,7 +228,7 @@ M: x86.32 long-long-on-stack? t ;
M: x86.32 float-on-stack? t ;
M: x86.32 flatten-struct-type
call-next-method [ first t 2array ] map ;
call-next-method [ first t f 3array ] map ;
M: x86.32 struct-return-on-stack? os linux? not ;

4
basis/cpu/x86/64/unix/unix.factor
View File

@ -29,12 +29,12 @@ M: x86.64 reserved-stack-space 0 ;
struct-types&offset split-struct [
[ c-type c-type-rep reg-class-of ] map
int-regs swap member? int-rep double-rep ?
f 2array
f f 3array
] map ;
M: x86.64 flatten-struct-type ( c-type -- seq )
dup heap-size 16 <=
[ flatten-small-struct ] [ call-next-method [ first t 2array ] map ] if ;
[ flatten-small-struct ] [ call-next-method [ first t f 3array ] map ] if ;
M: x86.64 return-struct-in-registers? ( c-type -- ? )
heap-size 2 cells <= ;

4
basis/cpu/x86/x86.factor
View File

@ -691,6 +691,10 @@ M:: x86 %save-context ( temp1 temp2 -- )
M: x86 value-struct? drop t ;
M: x86 long-long-odd-register? f ;
M: x86 float-right-align-on-stack? f ;
M: x86 immediate-arithmetic? ( n -- ? )
HEX: -80000000 HEX: 7fffffff between? ;

2
basis/editors/editors-docs.factor
View File

@ -7,7 +7,7 @@ ARTICLE: "editor" "Editor integration"
{ $subsections edit }
"Depending on the editor you are using, you must load one of the child vocabularies of the " { $vocab-link "editors" } " vocabulary, for example " { $vocab-link "editors.emacs" } ":"
{ $code "USE: editors.emacs" }
"If you intend to always use the same editor, it helps to have it load during stage 2 bootstrap. Place the code to load and possibly configure it in the " { $link "factor-boot-rc" } "."
"If you intend to always use the same editor, it helps to have it load during stage 2 bootstrap. Place the code to load and possibly configure it in the " { $link ".factor-boot-rc" } "."
$nl
"Editor integration vocabularies store a quotation in a global variable when loaded:"
{ $subsections edit-hook }

4
basis/io/backend/unix/multiplexers/epoll/epoll.factor
View File

@ -23,7 +23,7 @@ M: epoll-mx dispose* fd>> close-file ;
: make-event ( fd events -- event )
epoll-event <struct>
swap >>events
swap >>fd ;
swap over data>> fd<< ;
:: do-epoll-ctl ( fd mx what events -- )
mx fd>> what fd fd events make-event epoll_ctl io-error ;
@ -55,7 +55,7 @@ M: epoll-mx remove-output-callbacks ( fd mx -- seq )
epoll_wait multiplexer-error ;
: handle-event ( event mx -- )
[ fd>> ] dip
[ data>> fd>> ] dip
[ EPOLLIN EPOLLOUT bitor do-epoll-del ]
[ input-available ] [ output-available ] 2tri ;

6
basis/io/backend/unix/multiplexers/select/select.factor
View File

@ -3,7 +3,7 @@
USING: alien.data kernel bit-arrays sequences assocs math
namespaces accessors math.order locals fry io.ports
io.backend.unix io.backend.unix.multiplexers unix unix.ffi
unix.time ;
unix.time layouts ;
IN: io.backend.unix.multiplexers.select
TUPLE: select-mx < mx read-fdset write-fdset ;
@ -12,7 +12,9 @@ TUPLE: select-mx < mx read-fdset write-fdset ;
! FD_SET to be an array of cells, so we have to account for
! byte order differences on big endian platforms
: munge ( i -- i' )
little-endian? [ BIN: 11000 bitxor ] unless ; inline
little-endian? [
cell 4 = [ BIN: 11000 ] [ BIN: 111000 ] if
bitxor ] unless ; inline
: <select-mx> ( -- mx )
select-mx new-mx

2
basis/io/backend/unix/unix.factor
View File

@ -146,7 +146,7 @@ M: stdin dispose*
: wait-for-stdin ( stdin -- size )
[ control>> CHAR: X over io:stream-write1 io:stream-flush ]
[ size>> ssize_t heap-size swap io:stream-read int deref ]
[ size>> ssize_t heap-size swap io:stream-read ssize_t deref ]
bi ;
:: refill-stdin ( buffer stdin size -- )

5
basis/io/directories/unix/unix.factor
View File

@ -5,7 +5,7 @@ combinators continuations destructors fry io io.backend
io.backend.unix io.directories io.encodings.binary
io.encodings.utf8 io.files io.pathnames io.files.types kernel
math.bitwise sequences system unix unix.stat vocabs.loader
classes.struct unix.ffi literals ;
classes.struct unix.ffi literals libc ;
IN: io.directories.unix
CONSTANT: touch-mode flags{ O_WRONLY O_APPEND O_CREAT O_EXCL }
@ -39,7 +39,8 @@ HOOK: find-next-file os ( DIR* -- byte-array )
M: unix find-next-file ( DIR* -- byte-array )
dirent <struct>
f void* <ref>
[ readdir_r 0 = [ (io-error) ] unless ] 2keep
0 set-errno
[ readdir_r 0 = [ errno 0 = [ (io-error) ] unless ] unless ] 2keep
void* deref [ drop f ] unless ;
: dirent-type>file-type ( ch -- type )

17
basis/listener/listener.factor
View File

@ -8,6 +8,15 @@ sets vocabs.parser source-files.errors locals vocabs vocabs.loader ;
IN: listener
GENERIC: stream-read-quot ( stream -- quot/f )
GENERIC# prompt. 1 ( stream prompt -- )
: prompt ( -- str )
current-vocab name>> auto-use? get [ " - auto" append ] when
"( " " )" surround ;
M: object prompt.
nip H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl
flush ;
: parse-lines-interactive ( lines -- quot/f )
[ parse-lines ] with-compilation-unit ;
@ -82,7 +91,7 @@ t error-summary? set-global
] each
] tabular-output nl
] unless-empty ;
: trimmed-stack. ( seq -- )
dup length max-stack-items get > [
max-stack-items get cut*
@ -97,15 +106,11 @@ t error-summary? set-global
[ nl "--- Data stack:" title. trimmed-stack. ] unless-empty
] [ drop ] if ;
: prompt. ( -- )
current-vocab name>> auto-use? get [ " - auto" append ] when "( " " )" surround
H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl flush ;
:: (listener) ( datastack -- )
error-summary? get [ error-summary ] when
visible-vars.
datastack datastack.
prompt.
input-stream get prompt prompt.
[
read-quot [

2
basis/math/blas/config/config-docs.factor
View File

@ -8,7 +8,7 @@ ARTICLE: "math.blas.config" "Configuring the BLAS interface"
blas-fortran-abi
deploy-blas?
}
"The interface attempts to set default values based on the ones encountered on the Factor project's build machines. If these settings don't work with your system's BLAS, or you wish to use a commercial BLAS, you may change the global values of those variables in your " { $link "factor-rc" } ". For example, to use AMD's ACML library on Windows with " { $snippet "math.blas" } ", your " { $snippet "factor-rc" } " would look like this:"
"The interface attempts to set default values based on the ones encountered on the Factor project's build machines. If these settings don't work with your system's BLAS, or you wish to use a commercial BLAS, you may change the global values of those variables in your " { $link ".factor-rc" } ". For example, to use AMD's ACML library on Windows with " { $snippet "math.blas" } ", your " { $snippet ".factor-rc" } " would look like this:"
{ $code """
USING: math.blas.config namespaces ;
"X:\\path\\to\\acml.dll" blas-library set-global

46
basis/math/floats/env/ppc/ppc.factor vendored
View File

@ -1,6 +1,7 @@
USING: accessors alien.c-types alien.syntax arrays assocs
USING: accessors alien alien.c-types alien.syntax arrays assocs
biassocs classes.struct combinators kernel literals math
math.bitwise math.floats.env math.floats.env.private system ;
math.bitwise math.floats.env math.floats.env.private system
cpu.ppc.assembler ;
IN: math.floats.env.ppc
STRUCT: ppc-fpu-env
@ -10,12 +11,41 @@ STRUCT: ppc-fpu-env
STRUCT: ppc-vmx-env
{ vscr uint } ;
! defined in the vm, cpu-ppc*.S
FUNCTION: void get_ppc_fpu_env ( ppc-fpu-env* env ) ;
FUNCTION: void set_ppc_fpu_env ( ppc-fpu-env* env ) ;
: get_ppc_fpu_env ( env -- )
void { void* } cdecl [
0 MFFS
0 3 0 STFD
] alien-assembly ;
FUNCTION: void get_ppc_vmx_env ( ppc-vmx-env* env ) ;
FUNCTION: void set_ppc_vmx_env ( ppc-vmx-env* env ) ;
: set_ppc_fpu_env ( env -- )
void { void* } cdecl [
0 3 0 LFD
HEX: ff 0 0 0 MTFSF
] alien-assembly ;
: get_ppc_vmx_env ( env -- )
void { void* } cdecl [
0 MFVSCR
4 1 16 SUBI
5 HEX: f LI
4 4 5 ANDC
0 0 4 STVXL
5 HEX: c LI
6 5 4 LWZX
6 3 0 STW
] alien-assembly ;
: set_ppc_vmx_env ( env -- )
void { void* } cdecl [
3 1 16 SUBI
5 HEX: f LI
4 4 5 ANDC
5 HEX: c LI
6 3 0 LWZ
6 5 4 STWX
0 0 4 LVXL
0 MTVSCR
] alien-assembly ;
: <ppc-fpu-env> ( -- ppc-fpu-env )
ppc-fpu-env (struct)
@ -32,7 +62,7 @@ M: ppc-vmx-env (set-fp-env-register)
set_ppc_vmx_env ;
M: ppc (fp-env-registers)
<ppc-fpu-env> <ppc-vmx-env> 2array ;
<ppc-fpu-env> 1array ;
CONSTANT: ppc-exception-flag-bits HEX: fff8,0700
CONSTANT: ppc-exception-flag>bit

2
basis/smtp/smtp-docs.factor
View File

@ -76,7 +76,7 @@ HELP: send-email
} ;
ARTICLE: "smtp-gmail" "Setting up SMTP with gmail"
"If you plan to send all email from the same address, then setting variables in the global namespace is the best option. The code example below does this approach and is meant to go in your " { $link "factor-boot-rc" } "." $nl
"If you plan to send all email from the same address, then setting variables in the global namespace is the best option. The code example below does this approach and is meant to go in your " { $link ".factor-boot-rc" } "." $nl
"Several variables need to be set for sending outgoing mail through gmail. First, we set the login and password to a " { $link <plain-auth> } " tuple with our login. Next, we set the gmail server address with an " { $link <inet> } " object. Finally, we tell the SMTP library to use a secure connection."
{ $code
"USING: smtp namespaces io.sockets ;"

1
basis/stack-checker/known-words/known-words.factor
View File

@ -282,6 +282,7 @@ M: object infer-call* \ call bad-macro-input ;
\ (code-blocks) { } { array } define-primitive \ (code-blocks) make-flushable
\ (dlopen) { byte-array } { dll } define-primitive
\ (dlsym) { byte-array object } { c-ptr } define-primitive
\ (dlsym-raw) { byte-array object } { c-ptr } define-primitive
\ (exists?) { string } { object } define-primitive
\ (exit) { integer } { } define-primitive
\ (format-float) { float byte-array } { byte-array } define-primitive \ (format-float) make-foldable

8
basis/tools/disassembler/gdb/gdb.factor
View File

@ -3,7 +3,7 @@
USING: io.files io.files.temp io words alien kernel math.parser
alien.syntax io.launcher assocs arrays sequences namespaces make
system math io.encodings.ascii accessors tools.disassembler
tools.disassembler.private ;
tools.disassembler.private locals ;
IN: tools.disassembler.gdb
SINGLETON: gdb-disassembler
@ -12,12 +12,12 @@ SINGLETON: gdb-disassembler
: out-file ( -- path ) "gdb-out.txt" temp-file ;
: make-disassemble-cmd ( from to -- )
:: make-disassemble-cmd ( from to -- )
in-file ascii [
"attach " write
current-process-handle number>string print
"disassemble " write
[ number>string write bl ] bi@
"x/" write to from - 4 / number>string write
"i" write bl from number>string write
] with-file-writer ;
: gdb-binary ( -- string ) "gdb" ;

4
basis/tools/scaffold/scaffold.factor
View File

@ -342,10 +342,10 @@ SYMBOL: examples-flag
[ home ] dip append-path touch. ;
: scaffold-factor-boot-rc ( -- )
os windows? "factor-boot-rc" ".factor-boot-rc" ? scaffold-rc ;
".factor-boot-rc" scaffold-rc ;
: scaffold-factor-rc ( -- )
os windows? "factor-rc" ".factor-rc" ? scaffold-rc ;
".factor-rc" scaffold-rc ;
HOOK: scaffold-emacs os ( -- )

28
basis/ui/backend/gtk/gtk.factor
View File

@ -10,7 +10,7 @@ strings system threads ui ui.backend ui.backend.gtk.input-methods
ui.backend.gtk.io ui.clipboards ui.event-loop ui.gadgets
ui.gadgets.private ui.gadgets.worlds ui.gestures
ui.pixel-formats ui.pixel-formats.private ui.private
vocabs.loader ;
vocabs.loader combinators prettyprint io ;
IN: ui.backend.gtk
SINGLETON: gtk-ui-backend
@ -167,15 +167,25 @@ CONSTANT: action-key-codes
: on-leave ( win event user-data -- ? )
3drop forget-rollover t ;
: on-button-press ( win event user-data -- ? )
drop swap [
mouse-event>gesture [ <button-down> ] dip
] dip window send-button-down t ;
:: on-button-press ( win event user-data -- ? )
win window :> world
event mouse-event>gesture :> ( modifiers button loc )
button {
{ 8 [ ] }
{ 9 [ ] }
[ modifiers swap <button-down> loc world
send-button-down ]
} case t ;
: on-button-release ( win event user-data -- ? )
drop swap [
mouse-event>gesture [ <button-up> ] dip
] dip window send-button-up t ;
:: on-button-release ( win event user-data -- ? )
win window :> world
event mouse-event>gesture :> ( modifiers button loc )
button {
{ 8 [ world left-action send-action ] }
{ 9 [ world right-action send-action ] }
[ modifiers swap <button-up> loc world
send-button-up ]
} case t ;
: on-scroll ( win event user-data -- ? )
drop swap [

2
basis/ui/gadgets/editors/editors.factor
View File

@ -466,7 +466,7 @@ editor "caret-motion" f {
editor "selection" f {
{ T{ button-down f { S+ } 1 } extend-selection }
{ T{ button-up f { S+ } 1 } com-copy-selection }
{ T{ drag } drag-selection }
{ T{ drag { # 1 } } drag-selection }
{ gain-focus focus-editor }
{ lose-focus unfocus-editor }
{ delete-action remove-selection }

2
basis/ui/gadgets/panes/panes.factor
View File

@ -420,7 +420,7 @@ pane H{
{ T{ button-down f { S+ } 1 } [ select-to-caret ] }
{ T{ button-up f { S+ } 1 } [ end-selection ] }
{ T{ button-up } [ end-selection ] }
{ T{ drag } [ extend-selection ] }
{ T{ drag { # 1 } } [ extend-selection ] }
{ copy-action [ com-copy ] }
{ T{ button-down f f 3 } [ pane-menu ] }
} set-gestures

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

@ -1,14 +1,19 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: unix.linux.epoll
USING: alien.c-types alien.syntax classes.struct math ;
USING: alien.c-types alien.syntax classes.struct math unix.types ;
FUNCTION: int epoll_create ( int size ) ;
UNION-STRUCT: epoll-data
{ ptr void* }
{ fd int }
{ u32 uint32_t }
{ u64 uint64_t } ;
STRUCT: epoll-event
{ events uint }
{ fd uint }
{ padding uint } ;
{ events uint32_t }
{ data epoll-data } ;
FUNCTION: int epoll_ctl ( int epfd, int op, int fd, epoll-event* event ) ;
@ -28,5 +33,6 @@ CONSTANT: EPOLLWRBAND HEX: 200
CONSTANT: EPOLLMSG HEX: 400
CONSTANT: EPOLLERR HEX: 008
CONSTANT: EPOLLHUP HEX: 010
CONSTANT: EPOLLRDHUP HEX: 2000
: EPOLLONESHOT ( -- n ) 30 2^ ; inline
: EPOLLET ( -- n ) 31 2^ ; inline

4
build-support/factor.sh
View File

@ -306,8 +306,8 @@ set_build_info() {
MAKE_IMAGE_TARGET=macosx-ppc
MAKE_TARGET=macosx-ppc
elif [[ $OS == linux && $ARCH == ppc ]] ; then
MAKE_IMAGE_TARGET=linux-ppc
MAKE_TARGET=linux-ppc
MAKE_IMAGE_TARGET=linux-ppc.32
MAKE_TARGET=linux-ppc-32
elif [[ $OS == winnt && $ARCH == x86 && $WORD == 64 ]] ; then
MAKE_IMAGE_TARGET=winnt-x86.64
MAKE_TARGET=winnt-x86-64

7
core/bootstrap/primitives.factor
View File

@ -19,9 +19,11 @@ H{ } clone sub-primitives set
architecture get {
{ "winnt-x86.32" "x86/32/winnt" }
{ "unix-x86.32" "x86/32/unix" }
{ "unix-x86.32" "x86/32/unix" }
{ "winnt-x86.64" "x86/64/winnt" }
{ "unix-x86.64" "x86/64/unix" }
{ "unix-x86.64" "x86/64/unix" }
{ "linux-ppc.32" "ppc/32/linux" }
{ "linux-ppc.64" "ppc/64/linux" }
} ?at [ "Bad architecture: " prepend throw ] unless
"vocab:cpu/" "/bootstrap.factor" surround parse-file
@ -419,6 +421,7 @@ tuple
{ "set-alien-unsigned-cell" "alien.accessors" "primitive_set_alien_unsigned_cell" (( value c-ptr n -- )) }
{ "(dlopen)" "alien.libraries" "primitive_dlopen" (( path -- dll )) }
{ "(dlsym)" "alien.libraries" "primitive_dlsym" (( name dll -- alien )) }
{ "(dlsym-raw)" "alien.libraries" "primitive_dlsym_raw" (( name dll -- alien )) }
{ "dlclose" "alien.libraries" "primitive_dlclose" (( dll -- )) }
{ "dll-valid?" "alien.libraries" "primitive_dll_validp" (( dll -- ? )) }
{ "current-callback" "alien.private" "primitive_current_callback" (( -- n )) }

6
core/system/system.factor
View File

@ -4,9 +4,10 @@ USING: kernel kernel.private sequences math namespaces
init splitting assocs system.private layouts words ;
IN: system
SINGLETONS: x86.32 x86.64 arm ppc ;
SINGLETONS: x86.32 x86.64 arm ppc.32 ppc.64 ;
UNION: x86 x86.32 x86.64 ;
UNION: ppc ppc.32 ppc.64 ;
: cpu ( -- class ) \ cpu get-global ; foldable
@ -33,7 +34,8 @@ UNION: unix bsd solaris linux haiku ;
{ "x86.32" x86.32 }
{ "x86.64" x86.64 }
{ "arm" arm }
{ "ppc" ppc }
{ "ppc.32" ppc.32 }
{ "ppc.64" ppc.64 }
} at ;
: string>os ( str -- class )

6
core/vocabs/loader/loader-docs.factor
View File

@ -10,8 +10,8 @@ $nl
"The first way is to use an environment variable. Factor looks at the " { $snippet "FACTOR_ROOTS" } " environment variable for a list of " { $snippet ":" } "-separated paths (on Unix) or a list of " { $snippet ";" } "-separated paths (on Windows)."
$nl
"The second way is to create a configuration file. You can list additional vocabulary roots in a file that Factor reads at startup:"
{ $subsections "factor-roots" }
"Finally, you can add vocabulary roots by calling a word from your " { $snippet "factor-rc" } " file (see " { $link "factor-rc" } "):"
{ $subsections ".factor-roots" }
"Finally, you can add vocabulary roots by calling a word from your " { $snippet ".factor-rc" } " file (see " { $link ".factor-rc" } "):"
{ $subsections add-vocab-root } ;
ARTICLE: "vocabs.roots" "Vocabulary roots"
@ -81,7 +81,7 @@ HELP: vocab-roots
HELP: add-vocab-root
{ $values { "root" "a pathname string" } }
{ $description "Adds a directory pathname to the list of vocabulary roots." }
{ $see-also "factor-roots" } ;
{ $see-also ".factor-roots" } ;
HELP: find-vocab-root
{ $values { "vocab" "a vocabulary specifier" } { "path/f" "a pathname string" } }

128
extra/cpu/ppc/assembler/assembler-tests.factor
View File

@ -1,128 +0,0 @@
USING: cpu.ppc.assembler tools.test arrays kernel namespaces
make vocabs sequences byte-arrays.hex ;
FROM: cpu.ppc.assembler => B ;
IN: cpu.ppc.assembler.tests
: test-assembler ( expected quot -- )
[ 1array ] [ [ B{ } make ] curry ] bi* unit-test ;
HEX{ 38 22 00 03 } [ 1 2 3 ADDI ] test-assembler
HEX{ 3c 22 00 03 } [ 1 2 3 ADDIS ] test-assembler
HEX{ 30 22 00 03 } [ 1 2 3 ADDIC ] test-assembler
HEX{ 34 22 00 03 } [ 1 2 3 ADDIC. ] test-assembler
HEX{ 38 40 00 01 } [ 1 2 LI ] test-assembler
HEX{ 3c 40 00 01 } [ 1 2 LIS ] test-assembler
HEX{ 38 22 ff fd } [ 1 2 3 SUBI ] test-assembler
HEX{ 1c 22 00 03 } [ 1 2 3 MULI ] test-assembler
HEX{ 7c 22 1a 14 } [ 1 2 3 ADD ] test-assembler
HEX{ 7c 22 1a 15 } [ 1 2 3 ADD. ] test-assembler
HEX{ 7c 22 1e 14 } [ 1 2 3 ADDO ] test-assembler
HEX{ 7c 22 1e 15 } [ 1 2 3 ADDO. ] test-assembler
HEX{ 7c 22 18 14 } [ 1 2 3 ADDC ] test-assembler
HEX{ 7c 22 18 15 } [ 1 2 3 ADDC. ] test-assembler
HEX{ 7c 22 1e 14 } [ 1 2 3 ADDO ] test-assembler
HEX{ 7c 22 1c 15 } [ 1 2 3 ADDCO. ] test-assembler
HEX{ 7c 22 19 14 } [ 1 2 3 ADDE ] test-assembler
HEX{ 7c 41 18 38 } [ 1 2 3 AND ] test-assembler
HEX{ 7c 41 18 39 } [ 1 2 3 AND. ] test-assembler
HEX{ 7c 22 1b d6 } [ 1 2 3 DIVW ] test-assembler
HEX{ 7c 22 1b 96 } [ 1 2 3 DIVWU ] test-assembler
HEX{ 7c 41 1a 38 } [ 1 2 3 EQV ] test-assembler
HEX{ 7c 41 1b b8 } [ 1 2 3 NAND ] test-assembler
HEX{ 7c 41 18 f8 } [ 1 2 3 NOR ] test-assembler
HEX{ 7c 41 10 f8 } [ 1 2 NOT ] test-assembler
HEX{ 60 41 00 03 } [ 1 2 3 ORI ] test-assembler
HEX{ 64 41 00 03 } [ 1 2 3 ORIS ] test-assembler
HEX{ 7c 41 1b 78 } [ 1 2 3 OR ] test-assembler
HEX{ 7c 41 13 78 } [ 1 2 MR ] test-assembler
HEX{ 7c 22 18 96 } [ 1 2 3 MULHW ] test-assembler
HEX{ 1c 22 00 03 } [ 1 2 3 MULLI ] test-assembler
HEX{ 7c 22 18 16 } [ 1 2 3 MULHWU ] test-assembler
HEX{ 7c 22 19 d6 } [ 1 2 3 MULLW ] test-assembler
HEX{ 7c 41 18 30 } [ 1 2 3 SLW ] test-assembler
HEX{ 7c 41 1e 30 } [ 1 2 3 SRAW ] test-assembler
HEX{ 7c 41 1c 30 } [ 1 2 3 SRW ] test-assembler
HEX{ 7c 41 1e 70 } [ 1 2 3 SRAWI ] test-assembler
HEX{ 7c 22 18 50 } [ 1 2 3 SUBF ] test-assembler
HEX{ 7c 22 18 10 } [ 1 2 3 SUBFC ] test-assembler
HEX{ 7c 22 19 10 } [ 1 2 3 SUBFE ] test-assembler
HEX{ 7c 41 07 74 } [ 1 2 EXTSB ] test-assembler
HEX{ 68 41 00 03 } [ 1 2 3 XORI ] test-assembler
HEX{ 7c 41 1a 78 } [ 1 2 3 XOR ] test-assembler
HEX{ 7c 22 00 d0 } [ 1 2 NEG ] test-assembler
HEX{ 2c 22 00 03 } [ 1 2 3 CMPI ] test-assembler
HEX{ 28 22 00 03 } [ 1 2 3 CMPLI ] test-assembler
HEX{ 7c 41 18 00 } [ 1 2 3 CMP ] test-assembler
HEX{ 54 22 19 0a } [ 1 2 3 4 5 RLWINM ] test-assembler
HEX{ 54 22 18 38 } [ 1 2 3 SLWI ] test-assembler
HEX{ 54 22 e8 fe } [ 1 2 3 SRWI ] test-assembler
HEX{ 88 22 00 03 } [ 1 2 3 LBZ ] test-assembler
HEX{ 8c 22 00 03 } [ 1 2 3 LBZU ] test-assembler
HEX{ a8 22 00 03 } [ 1 2 3 LHA ] test-assembler
HEX{ ac 22 00 03 } [ 1 2 3 LHAU ] test-assembler
HEX{ a0 22 00 03 } [ 1 2 3 LHZ ] test-assembler
HEX{ a4 22 00 03 } [ 1 2 3 LHZU ] test-assembler
HEX{ 80 22 00 03 } [ 1 2 3 LWZ ] test-assembler
HEX{ 84 22 00 03 } [ 1 2 3 LWZU ] test-assembler
HEX{ 7c 41 18 ae } [ 1 2 3 LBZX ] test-assembler
HEX{ 7c 41 18 ee } [ 1 2 3 LBZUX ] test-assembler
HEX{ 7c 41 1a ae } [ 1 2 3 LHAX ] test-assembler
HEX{ 7c 41 1a ee } [ 1 2 3 LHAUX ] test-assembler
HEX{ 7c 41 1a 2e } [ 1 2 3 LHZX ] test-assembler
HEX{ 7c 41 1a 6e } [ 1 2 3 LHZUX ] test-assembler
HEX{ 7c 41 18 2e } [ 1 2 3 LWZX ] test-assembler
HEX{ 7c 41 18 6e } [ 1 2 3 LWZUX ] test-assembler
HEX{ 7c 41 1c 2e } [ 1 2 3 LFSX ] test-assembler
HEX{ 7c 41 1c 6e } [ 1 2 3 LFSUX ] test-assembler
HEX{ 7c 41 1c ae } [ 1 2 3 LFDX ] test-assembler
HEX{ 7c 41 1c ee } [ 1 2 3 LFDUX ] test-assembler
HEX{ 7c 41 1d 2e } [ 1 2 3 STFSX ] test-assembler
HEX{ 7c 41 1d 6e } [ 1 2 3 STFSUX ] test-assembler
HEX{ 7c 41 1d ae } [ 1 2 3 STFDX ] test-assembler
HEX{ 7c 41 1d ee } [ 1 2 3 STFDUX ] test-assembler
HEX{ 48 00 00 01 } [ 1 B ] test-assembler
HEX{ 48 00 00 01 } [ 1 BL ] test-assembler
HEX{ 41 80 00 04 } [ 1 BLT ] test-assembler
HEX{ 41 81 00 04 } [ 1 BGT ] test-assembler
HEX{ 40 81 00 04 } [ 1 BLE ] test-assembler
HEX{ 40 80 00 04 } [ 1 BGE ] test-assembler
HEX{ 41 80 00 04 } [ 1 BLT ] test-assembler
HEX{ 40 82 00 04 } [ 1 BNE ] test-assembler
HEX{ 41 82 00 04 } [ 1 BEQ ] test-assembler
HEX{ 41 83 00 04 } [ 1 BO ] test-assembler
HEX{ 40 83 00 04 } [ 1 BNO ] test-assembler
HEX{ 4c 20 00 20 } [ 1 BCLR ] test-assembler
HEX{ 4e 80 00 20 } [ BLR ] test-assembler
HEX{ 4e 80 00 21 } [ BLRL ] test-assembler
HEX{ 4c 20 04 20 } [ 1 BCCTR ] test-assembler
HEX{ 4e 80 04 20 } [ BCTR ] test-assembler
HEX{ 7c 61 02 a6 } [ 3 MFXER ] test-assembler
HEX{ 7c 68 02 a6 } [ 3 MFLR ] test-assembler
HEX{ 7c 69 02 a6 } [ 3 MFCTR ] test-assembler
HEX{ 7c 61 03 a6 } [ 3 MTXER ] test-assembler
HEX{ 7c 68 03 a6 } [ 3 MTLR ] test-assembler
HEX{ 7c 69 03 a6 } [ 3 MTCTR ] test-assembler
HEX{ 7c 61 02 a6 } [ 3 MFXER ] test-assembler
HEX{ 7c 68 02 a6 } [ 3 MFLR ] test-assembler
HEX{ c0 22 00 03 } [ 1 2 3 LFS ] test-assembler
HEX{ c4 22 00 03 } [ 1 2 3 LFSU ] test-assembler
HEX{ c8 22 00 03 } [ 1 2 3 LFD ] test-assembler
HEX{ cc 22 00 03 } [ 1 2 3 LFDU ] test-assembler
HEX{ d0 22 00 03 } [ 1 2 3 STFS ] test-assembler
HEX{ d4 22 00 03 } [ 1 2 3 STFSU ] test-assembler
HEX{ d8 22 00 03 } [ 1 2 3 STFD ] test-assembler
HEX{ dc 22 00 03 } [ 1 2 3 STFDU ] test-assembler
HEX{ fc 20 10 90 } [ 1 2 FMR ] test-assembler
HEX{ fc 40 08 90 } [ 2 1 FMR ] test-assembler
HEX{ fc 20 10 91 } [ 1 2 FMR. ] test-assembler
HEX{ fc 40 08 91 } [ 2 1 FMR. ] test-assembler
HEX{ fc 20 10 1e } [ 1 2 FCTIWZ ] test-assembler
HEX{ fc 22 18 2a } [ 1 2 3 FADD ] test-assembler
HEX{ fc 22 18 2b } [ 1 2 3 FADD. ] test-assembler
HEX{ fc 22 18 28 } [ 1 2 3 FSUB ] test-assembler
HEX{ fc 22 00 f2 } [ 1 2 3 FMUL ] test-assembler
HEX{ fc 22 18 24 } [ 1 2 3 FDIV ] test-assembler
HEX{ fc 20 10 2c } [ 1 2 FSQRT ] test-assembler
HEX{ fc 41 18 00 } [ 1 2 3 FCMPU ] test-assembler
HEX{ fc 41 18 40 } [ 1 2 3 FCMPO ] test-assembler
HEX{ 3c 60 12 34 60 63 56 78 } [ HEX: 12345678 3 LOAD ] test-assembler

428
extra/cpu/ppc/assembler/assembler.factor
View File

@ -1,428 +0,0 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces words math math.order locals
cpu.ppc.assembler.backend ;
IN: cpu.ppc.assembler
! See the Motorola or IBM documentation for details. The opcode
! names are standard, and the operand order is the same as in
! the docs, except a few differences, namely, in IBM/Motorola
! assembler syntax, loads and stores are written like:
!
! stw r14,10(r15)
!
! In Factor, we write:
!
! 14 15 10 STW
! D-form
D: ADDI 14
D: ADDIC 12
D: ADDIC. 13
D: ADDIS 15
D: CMPI 11
D: CMPLI 10
D: LBZ 34
D: LBZU 35
D: LFD 50
D: LFDU 51
D: LFS 48
D: LFSU 49
D: LHA 42
D: LHAU 43
D: LHZ 40
D: LHZU 41
D: LWZ 32
D: LWZU 33
D: MULI 7
D: MULLI 7
D: STB 38
D: STBU 39
D: STFD 54
D: STFDU 55
D: STFS 52
D: STFSU 53
D: STH 44
D: STHU 45
D: STW 36
D: STWU 37
! SD-form
SD: ANDI 28
SD: ANDIS 29
SD: ORI 24
SD: ORIS 25
SD: XORI 26
SD: XORIS 27
! X-form
X: AND 0 28 31
X: AND. 1 28 31
X: CMP 0 0 31
X: CMPL 0 32 31
X: EQV 0 284 31
X: EQV. 1 284 31
X: FCMPO 0 32 63
X: FCMPU 0 0 63
X: LBZUX 0 119 31
X: LBZX 0 87 31
X: LFDUX 0 631 31
X: LFDX 0 599 31
X: LFSUX 0 567 31
X: LFSX 0 535 31
X: LHAUX 0 375 31
X: LHAX 0 343 31
X: LHZUX 0 311 31
X: LHZX 0 279 31
X: LWZUX 0 55 31
X: LWZX 0 23 31
X: NAND 0 476 31
X: NAND. 1 476 31
X: NOR 0 124 31
X: NOR. 1 124 31
X: OR 0 444 31
X: OR. 1 444 31
X: ORC 0 412 31
X: ORC. 1 412 31
X: SLW 0 24 31
X: SLW. 1 24 31
X: SRAW 0 792 31
X: SRAW. 1 792 31
X: SRAWI 0 824 31
X: SRW 0 536 31
X: SRW. 1 536 31
X: STBUX 0 247 31
X: STBX 0 215 31
X: STFDUX 0 759 31
X: STFDX 0 727 31
X: STFSUX 0 695 31
X: STFSX 0 663 31
X: STHUX 0 439 31
X: STHX 0 407 31
X: STWUX 0 183 31
X: STWX 0 151 31
X: XOR 0 316 31
X: XOR. 1 316 31
X1: EXTSB 0 954 31
X1: EXTSB. 1 954 31
: FRSP ( a s -- ) [ 0 ] 2dip 0 12 63 x-insn ;
: FRSP. ( a s -- ) [ 0 ] 2dip 1 12 63 x-insn ;
: FMR ( a s -- ) [ 0 ] 2dip 0 72 63 x-insn ;
: FMR. ( a s -- ) [ 0 ] 2dip 1 72 63 x-insn ;
: FCTIWZ ( a s -- ) [ 0 ] 2dip 0 15 63 x-insn ;
: FCTIWZ. ( a s -- ) [ 0 ] 2dip 1 15 63 x-insn ;
! XO-form
XO: ADD 0 0 266 31
XO: ADD. 0 1 266 31
XO: ADDC 0 0 10 31
XO: ADDC. 0 1 10 31
XO: ADDCO 1 0 10 31
XO: ADDCO. 1 1 10 31
XO: ADDE 0 0 138 31
XO: ADDE. 0 1 138 31
XO: ADDEO 1 0 138 31
XO: ADDEO. 1 1 138 31
XO: ADDO 1 0 266 31
XO: ADDO. 1 1 266 31
XO: DIVW 0 0 491 31
XO: DIVW. 0 1 491 31
XO: DIVWO 1 0 491 31
XO: DIVWO. 1 1 491 31
XO: DIVWU 0 0 459 31
XO: DIVWU. 0 1 459 31
XO: DIVWUO 1 0 459 31
XO: DIVWUO. 1 1 459 31
XO: MULHW 0 0 75 31
XO: MULHW. 0 1 75 31
XO: MULHWU 0 0 11 31
XO: MULHWU. 0 1 11 31
XO: MULLW 0 0 235 31
XO: MULLW. 0 1 235 31
XO: MULLWO 1 0 235 31
XO: MULLWO. 1 1 235 31
XO: SUBF 0 0 40 31
XO: SUBF. 0 1 40 31
XO: SUBFC 0 0 8 31
XO: SUBFC. 0 1 8 31
XO: SUBFCO 1 0 8 31
XO: SUBFCO. 1 1 8 31
XO: SUBFE 0 0 136 31
XO: SUBFE. 0 1 136 31
XO: SUBFEO 1 0 136 31
XO: SUBFEO. 1 1 136 31
XO: SUBFO 1 0 40 31
XO: SUBFO. 1 1 40 31
XO1: NEG 0 0 104 31
XO1: NEG. 0 1 104 31
XO1: NEGO 1 0 104 31
XO1: NEGO. 1 1 104 31
! A-form
: RLWINM ( d a b c xo -- ) 0 21 a-insn ;
: RLWINM. ( d a b c xo -- ) 1 21 a-insn ;
: FADD ( d a b -- ) 0 21 0 63 a-insn ;
: FADD. ( d a b -- ) 0 21 1 63 a-insn ;
: FSUB ( d a b -- ) 0 20 0 63 a-insn ;
: FSUB. ( d a b -- ) 0 20 1 63 a-insn ;
: FMUL ( d a c -- ) 0 swap 25 0 63 a-insn ;
: FMUL. ( d a c -- ) 0 swap 25 1 63 a-insn ;
: FDIV ( d a b -- ) 0 18 0 63 a-insn ;
: FDIV. ( d a b -- ) 0 18 1 63 a-insn ;
: FSQRT ( d b -- ) 0 swap 0 22 0 63 a-insn ;
: FSQRT. ( d b -- ) 0 swap 0 22 1 63 a-insn ;
! Branches
: B ( dest -- ) 0 0 (B) ;
: BL ( dest -- ) 0 1 (B) ;
BC: LT 12 0
BC: GE 4 0
BC: GT 12 1
BC: LE 4 1
BC: EQ 12 2
BC: NE 4 2
BC: O 12 3
BC: NO 4 3
B: CLR 0 8 0 0 19
B: CLRL 0 8 0 1 19
B: CCTR 0 264 0 0 19
: BLR ( -- ) 20 BCLR ;
: BLRL ( -- ) 20 BCLRL ;
: BCTR ( -- ) 20 BCCTR ;
! Special registers
MFSPR: XER 1
MFSPR: LR 8
MFSPR: CTR 9
MTSPR: XER 1
MTSPR: LR 8
MTSPR: CTR 9
! Pseudo-instructions
: LI ( value dst -- ) swap [ 0 ] dip ADDI ; inline
: SUBI ( dst src1 src2 -- ) neg ADDI ; inline
: LIS ( value dst -- ) swap [ 0 ] dip ADDIS ; inline
: SUBIC ( dst src1 src2 -- ) neg ADDIC ; inline
: SUBIC. ( dst src1 src2 -- ) neg ADDIC. ; inline
: NOT ( dst src -- ) dup NOR ; inline
: NOT. ( dst src -- ) dup NOR. ; inline
: MR ( dst src -- ) dup OR ; inline
: MR. ( dst src -- ) dup OR. ; inline
: (SLWI) ( d a b -- d a b x y ) 0 31 pick - ; inline
: SLWI ( d a b -- ) (SLWI) RLWINM ;
: SLWI. ( d a b -- ) (SLWI) RLWINM. ;
: (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 -- )
n -16 shift HEX: ffff bitand r LIS
r r n HEX: ffff bitand ORI ;
: immediate? ( n -- ? ) HEX: -8000 HEX: 7fff between? ;
: LOAD ( n r -- ) over immediate? [ LI ] [ LOAD32 ] if ;
! Altivec/VMX instructions
VA: VMHADDSHS 32 4
VA: VMHRADDSHS 33 4
VA: VMLADDUHM 34 4
VA: VMSUMUBM 36 4
VA: VMSUMMBM 37 4
VA: VMSUMUHM 38 4
VA: VMSUMUHS 39 4
VA: VMSUMSHM 40 4
VA: VMSUMSHS 41 4
VA: VSEL 42 4
VA: VPERM 43 4
VA: VSLDOI 44 4
VA: VMADDFP 46 4
VA: VNMSUBFP 47 4
VX: VADDUBM 0 4
VX: VADDUHM 64 4
VX: VADDUWM 128 4
VX: VADDCUW 384 4
VX: VADDUBS 512 4
VX: VADDUHS 576 4
VX: VADDUWS 640 4
VX: VADDSBS 768 4
VX: VADDSHS 832 4
VX: VADDSWS 896 4
VX: VSUBUBM 1024 4
VX: VSUBUHM 1088 4
VX: VSUBUWM 1152 4
VX: VSUBCUW 1408 4
VX: VSUBUBS 1536 4
VX: VSUBUHS 1600 4
VX: VSUBUWS 1664 4
VX: VSUBSBS 1792 4
VX: VSUBSHS 1856 4
VX: VSUBSWS 1920 4
VX: VMAXUB 2 4
VX: VMAXUH 66 4
VX: VMAXUW 130 4
VX: VMAXSB 258 4
VX: VMAXSH 322 4
VX: VMAXSW 386 4
VX: VMINUB 514 4
VX: VMINUH 578 4
VX: VMINUW 642 4
VX: VMINSB 770 4
VX: VMINSH 834 4
VX: VMINSW 898 4
VX: VAVGUB 1026 4
VX: VAVGUH 1090 4
VX: VAVGUW 1154 4
VX: VAVGSB 1282 4
VX: VAVGSH 1346 4
VX: VAVGSW 1410 4
VX: VRLB 4 4
VX: VRLH 68 4
VX: VRLW 132 4
VX: VSLB 260 4
VX: VSLH 324 4
VX: VSLW 388 4
VX: VSL 452 4
VX: VSRB 516 4
VX: VSRH 580 4
VX: VSRW 644 4
VX: VSR 708 4
VX: VSRAB 772 4
VX: VSRAH 836 4
VX: VSRAW 900 4
VX: VAND 1028 4
VX: VANDC 1092 4
VX: VOR 1156 4
VX: VNOR 1284 4
VX: VXOR 1220 4
VXD: MFVSCR 1540 4
VXB: MTVSCR 1604 4
VX: VMULOUB 8 4
VX: VMULOUH 72 4
VX: VMULOSB 264 4
VX: VMULOSH 328 4
VX: VMULEUB 520 4
VX: VMULEUH 584 4
VX: VMULESB 776 4
VX: VMULESH 840 4
VX: VSUM4UBS 1544 4
VX: VSUM4SBS 1800 4
VX: VSUM4SHS 1608 4
VX: VSUM2SWS 1672 4
VX: VSUMSWS 1928 4
VX: VADDFP 10 4
VX: VSUBFP 74 4
VXDB: VREFP 266 4
VXDB: VRSQRTEFP 330 4
VXDB: VEXPTEFP 394 4
VXDB: VLOGEFP 458 4
VXDB: VRFIN 522 4
VXDB: VRFIZ 586 4
VXDB: VRFIP 650 4
VXDB: VRFIM 714 4
VX: VCFUX 778 4
VX: VCFSX 842 4
VX: VCTUXS 906 4
VX: VCTSXS 970 4
VX: VMAXFP 1034 4
VX: VMINFP 1098 4
VX: VMRGHB 12 4
VX: VMRGHH 76 4
VX: VMRGHW 140 4
VX: VMRGLB 268 4
VX: VMRGLH 332 4
VX: VMRGLW 396 4
VX: VSPLTB 524 4
VX: VSPLTH 588 4
VX: VSPLTW 652 4
VXA: VSPLTISB 780 4
VXA: VSPLTISH 844 4
VXA: VSPLTISW 908 4
VX: VSLO 1036 4
VX: VSRO 1100 4
VX: VPKUHUM 14 4
VX: VPKUWUM 78 4
VX: VPKUHUS 142 4
VX: VPKUWUS 206 4
VX: VPKSHUS 270 4
VX: VPKSWUS 334 4
VX: VPKSHSS 398 4
VX: VPKSWSS 462 4
VX: VPKPX 782 4
VXDB: VUPKHSB 526 4
VXDB: VUPKHSH 590 4
VXDB: VUPKLSB 654 4
VXDB: VUPKLSH 718 4
VXDB: VUPKHPX 846 4
VXDB: VUPKLPX 974 4
: -T ( strm a b -- strm-t a b ) [ 16 bitor ] 2dip ;
XD: DST 0 342 31
: DSTT ( strm a b -- ) -T DST ;
XD: DSTST 0 374 31
: DSTSTT ( strm a b -- ) -T DSTST ;
XD: (DSS) 0 822 31
: DSS ( strm -- ) 0 0 (DSS) ;
: DSSALL ( -- ) 16 0 0 (DSS) ;
XD: LVEBX 0 7 31
XD: LVEHX 0 39 31
XD: LVEWX 0 71 31
XD: LVSL 0 6 31
XD: LVSR 0 38 31
XD: LVX 0 103 31
XD: LVXL 0 359 31
XD: STVEBX 0 135 31
XD: STVEHX 0 167 31
XD: STVEWX 0 199 31
XD: STVX 0 231 31
XD: STVXL 0 487 31
VXR: VCMPBFP 0 966 4
VXR: VCMPEQFP 0 198 4
VXR: VCMPEQUB 0 6 4
VXR: VCMPEQUH 0 70 4
VXR: VCMPEQUW 0 134 4
VXR: VCMPGEFP 0 454 4
VXR: VCMPGTFP 0 710 4
VXR: VCMPGTSB 0 774 4
VXR: VCMPGTSH 0 838 4
VXR: VCMPGTSW 0 902 4
VXR: VCMPGTUB 0 518 4
VXR: VCMPGTUH 0 582 4
VXR: VCMPGTUW 0 646 4
VXR: VCMPBFP. 1 966 4
VXR: VCMPEQFP. 1 198 4
VXR: VCMPEQUB. 1 6 4
VXR: VCMPEQUH. 1 70 4
VXR: VCMPEQUW. 1 134 4
VXR: VCMPGEFP. 1 454 4
VXR: VCMPGTFP. 1 710 4
VXR: VCMPGTSB. 1 774 4
VXR: VCMPGTSH. 1 838 4
VXR: VCMPGTSW. 1 902 4
VXR: VCMPGTUB. 1 518 4
VXR: VCMPGTUH. 1 582 4
VXR: VCMPGTUW. 1 646 4

1
extra/cpu/ppc/assembler/authors.txt
View File

@ -1 +0,0 @@
Slava Pestov

132
extra/cpu/ppc/assembler/backend/backend.factor
View File

@ -1,132 +0,0 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces make sequences words math
math.bitwise io.binary parser lexer fry ;
IN: cpu.ppc.assembler.backend
: insn ( operand opcode -- ) { 26 0 } bitfield 4 >be % ;
: a-insn ( d a b c xo rc opcode -- )
[ { 0 1 6 11 16 21 } bitfield ] dip insn ;
: b-insn ( bo bi bd aa lk opcode -- )
[ { 0 1 2 16 21 } bitfield ] dip insn ;
: s>u16 ( s -- u ) HEX: ffff bitand ;
: d-insn ( d a simm opcode -- )
[ s>u16 { 0 16 21 } bitfield ] dip insn ;
: define-d-insn ( word opcode -- )
[ d-insn ] curry (( d a simm -- )) define-declared ;
SYNTAX: D: CREATE scan-word define-d-insn ;
: sd-insn ( d a simm opcode -- )
[ s>u16 { 0 21 16 } bitfield ] dip insn ;
: define-sd-insn ( word opcode -- )
[ sd-insn ] curry (( d a simm -- )) define-declared ;
SYNTAX: SD: CREATE scan-word define-sd-insn ;
: i-insn ( li aa lk opcode -- )
[ { 0 1 0 } bitfield ] dip insn ;
: x-insn ( a s b rc xo opcode -- )
[ { 1 0 11 21 16 } bitfield ] dip insn ;
: xd-insn ( d a b rc xo opcode -- )
[ { 1 0 11 16 21 } bitfield ] dip insn ;
: (X) ( -- word quot )
CREATE scan-word scan-word scan-word [ x-insn ] 3curry ;
: (XD) ( -- word quot )
CREATE scan-word scan-word scan-word [ xd-insn ] 3curry ;
SYNTAX: X: (X) (( a s b -- )) define-declared ;
SYNTAX: XD: (XD) (( d a b -- )) define-declared ;
: (1) ( quot -- quot' ) [ 0 ] prepose ;
SYNTAX: X1: (X) (1) (( a s -- )) define-declared ;
: xfx-insn ( d spr xo opcode -- )
[ { 1 11 21 } bitfield ] dip insn ;
: CREATE-MF ( -- word ) scan "MF" prepend create-in ;
SYNTAX: MFSPR:
CREATE-MF scan-word 5 shift [ 339 31 xfx-insn ] curry
(( d -- )) define-declared ;
: CREATE-MT ( -- word ) scan "MT" prepend create-in ;
SYNTAX: MTSPR:
CREATE-MT scan-word 5 shift [ 467 31 xfx-insn ] curry
(( d -- )) define-declared ;
: xo-insn ( d a b oe rc xo opcode -- )
[ { 1 0 10 11 16 21 } bitfield ] dip insn ;
: (XO) ( -- word quot )
CREATE scan-word scan-word scan-word scan-word
[ xo-insn ] 2curry 2curry ;
SYNTAX: XO: (XO) (( d a b -- )) define-declared ;
SYNTAX: XO1: (XO) (1) (( d a -- )) define-declared ;
GENERIC# (B) 2 ( dest aa lk -- )
M: integer (B) 18 i-insn ;
GENERIC: BC ( a b c -- )
M: integer BC 0 0 16 b-insn ;
: CREATE-B ( -- word ) scan "B" prepend create-in ;
SYNTAX: BC:
CREATE-B scan-word scan-word
'[ [ _ _ ] dip BC ] (( c -- )) define-declared ;
SYNTAX: B:
CREATE-B scan-word scan-word scan-word scan-word scan-word
'[ _ _ _ _ _ b-insn ] (( bo -- )) define-declared ;
: va-insn ( d a b c xo opcode -- )
[ { 0 6 11 16 21 } bitfield ] dip insn ;
: (VA) ( -- word quot )
CREATE scan-word scan-word [ va-insn ] 2curry ;
SYNTAX: VA: (VA) (( d a b c -- )) define-declared ;
: vx-insn ( d a b xo opcode -- )
[ { 0 11 16 21 } bitfield ] dip insn ;
: (VX) ( -- word quot )
CREATE scan-word scan-word [ vx-insn ] 2curry ;
: (VXD) ( -- word quot )
CREATE scan-word scan-word '[ 0 0 _ _ vx-insn ] ;
: (VXA) ( -- word quot )
CREATE scan-word scan-word '[ [ 0 ] dip 0 _ _ vx-insn ] ;
: (VXB) ( -- word quot )
CREATE scan-word scan-word '[ [ 0 0 ] dip _ _ vx-insn ] ;
: (VXDB) ( -- word quot )
CREATE scan-word scan-word '[ [ 0 ] dip _ _ vx-insn ] ;
SYNTAX: VX: (VX) (( d a b -- )) define-declared ;
SYNTAX: VXD: (VXD) (( d -- )) define-declared ;
SYNTAX: VXA: (VXA) (( a -- )) define-declared ;
SYNTAX: VXB: (VXB) (( b -- )) define-declared ;
SYNTAX: VXDB: (VXDB) (( d b -- )) define-declared ;
: vxr-insn ( d a b rc xo opcode -- )
[ { 0 10 11 16 21 } bitfield ] dip insn ;
: (VXR) ( -- word quot )
CREATE scan-word scan-word scan-word [ vxr-insn ] 3curry ;
SYNTAX: VXR: (VXR) (( d a b -- )) define-declared ;

1
extra/cpu/ppc/assembler/summary.txt
View File

@ -1 +0,0 @@
PowerPC assembler

564
extra/llvm/clang/ffi/ffi.factor Normal file
View File

@ -0,0 +1,564 @@
USING: alien alien.c-types alien.libraries alien.syntax
classes.struct combinators system unix.types ;
IN: llvm.clang.ffi
<<
"libclang" {
{ [ os macosx? ] [ "libclang.dylib" ] }
{ [ os windows? ] [ "clang.dll" ] }
{ [ os unix? ] [ "/usrlibclang.so" ] }
} cond cdecl add-library
>>
LIBRARY: libclang
C-TYPE: CXTranslationUnitImpl
TYPEDEF: void* CXIndex
TYPEDEF: CXTranslationUnitImpl* CXTranslationUnit
TYPEDEF: void* CXClientData
STRUCT: CXUnsavedFile
{ Filename c-string }
{ Contents c-string }
{ Length ulong } ;
ENUM: CXAvailabilityKind
CXAvailability_Available
CXAvailability_Deprecated
CXAvailability_NotAvailable ;
STRUCT: CXString
{ data void* }
{ private_flags uint } ;
FUNCTION: c-string clang_getCString ( CXString string ) ;
FUNCTION: void clang_disposeString ( CXString string ) ;
FUNCTION: CXIndex clang_createIndex ( int excludeDeclarationsFromPCH,
int displayDiagnostics ) ;
FUNCTION: void clang_disposeIndex ( CXIndex index ) ;
TYPEDEF: void* CXFile
FUNCTION: CXString clang_getFileName ( CXFile SFile ) ;
FUNCTION: time_t clang_getFileTime ( CXFile SFile ) ;
FUNCTION: uint clang_isFileMultipleIncludeGuarded ( CXTranslationUnit tu, CXFile file ) ;
FUNCTION: CXFile clang_getFile ( CXTranslationUnit tu, c-string file_name ) ;
STRUCT: CXSourceLocation
{ ptr_data void*[2] }
{ int_data uint } ;
STRUCT: CXSourceRange
{ ptr_data void*[2] }
{ begin_int_data uint }
{ end_int_data uint } ;
FUNCTION: CXSourceLocation clang_getNullLocation ( ) ;
FUNCTION: uint clang_equalLocations ( CXSourceLocation loc1, CXSourceLocation loc2 ) ;
FUNCTION: CXSourceLocation clang_getLocation ( CXTranslationUnit tu, CXFile file, uint line, uint column ) ;
FUNCTION: CXSourceLocation clang_getLocationForOffset ( CXTranslationUnit tu,
CXFile file,
uint offset ) ;
FUNCTION: CXSourceRange clang_getNullRange ( ) ;
FUNCTION: CXSourceRange clang_getRange ( CXSourceLocation begin,
CXSourceLocation end ) ;
FUNCTION: void clang_getInstantiationLocation ( CXSourceLocation location,
CXFile* file,
uint* line,
uint* column,
uint* offset ) ;
FUNCTION: void clang_getSpellingLocation ( CXSourceLocation location,
CXFile* file,
uint* line,
uint* column,
uint* offset ) ;
FUNCTION: CXSourceLocation clang_getRangeStart ( CXSourceRange range ) ;
FUNCTION: CXSourceLocation clang_getRangeEnd ( CXSourceRange range ) ;
ENUM: CXDiagnosticSeverity
CXDiagnostic_Ignored
CXDiagnostic_Note
CXDiagnostic_Warning
CXDiagnostic_Error
CXDiagnostic_Fatal ;
TYPEDEF: void* CXDiagnostic
FUNCTION: uint clang_getNumDiagnostics ( CXTranslationUnit Unit ) ;
FUNCTION: CXDiagnostic clang_getDiagnostic ( CXTranslationUnit Unit,
uint Index ) ;
FUNCTION: void clang_disposeDiagnostic ( CXDiagnostic Diagnostic ) ;
ENUM: CXDiagnosticDisplayOptions
{ CXDiagnostic_DisplaySourceLocation HEX: 01 }
{ CXDiagnostic_DisplayColumn HEX: 02 }
{ CXDiagnostic_DisplaySourceRanges HEX: 04 }
{ CXDiagnostic_DisplayOption HEX: 08 }
{ CXDiagnostic_DisplayCategoryId HEX: 10 }
{ CXDiagnostic_DisplayCategoryName HEX: 20 } ;
FUNCTION: CXString clang_formatDiagnostic ( CXDiagnostic Diagnostic,
uint Options ) ;
FUNCTION: uint clang_defaultDiagnosticDisplayOptions ( ) ;
FUNCTION: CXDiagnosticSeverity clang_getDiagnosticSeverity ( CXDiagnostic ) ;
FUNCTION: CXSourceLocation clang_getDiagnosticLocation ( CXDiagnostic ) ;
FUNCTION: CXString clang_getDiagnosticSpelling ( CXDiagnostic ) ;
FUNCTION: CXString clang_getDiagnosticOption ( CXDiagnostic Diag, CXString* Disable ) ;
FUNCTION: uint clang_getDiagnosticCategory ( CXDiagnostic ) ;
FUNCTION: CXString clang_getDiagnosticCategoryName ( uint Category ) ;
FUNCTION: uint clang_getDiagnosticNumRanges ( CXDiagnostic ) ;
FUNCTION: CXSourceRange clang_getDiagnosticRange ( CXDiagnostic Diagnostic, uint Range ) ;
FUNCTION: uint clang_getDiagnosticNumFixIts ( CXDiagnostic Diagnostic ) ;
FUNCTION: CXString clang_getDiagnosticFixIt ( CXDiagnostic Diagnostic,
uint FixIt,
CXSourceRange* ReplacementRange ) ;
FUNCTION: CXString clang_getTranslationUnitSpelling ( CXTranslationUnit CTUnit ) ;
FUNCTION: CXTranslationUnit clang_createTranslationUnitFromSourceFile ( CXIndex CIdx,
c-string source_filename,
int num_clang_command_line_args,
char** clang_command_line_args,
uint num_unsaved_files,
CXUnsavedFile* unsaved_files ) ;
FUNCTION: CXTranslationUnit clang_createTranslationUnit ( CXIndex CIdx, c-string ast_filename ) ;
ENUM: CXTranslationUnit_Flags
{ CXTranslationUnit_None HEX: 00 }
{ CXTranslationUnit_DetailedPreprocessingRecord HEX: 01 }
{ CXTranslationUnit_Incomplete HEX: 02 }
{ CXTranslationUnit_PrecompiledPreamble HEX: 04 }
{ CXTranslationUnit_CacheCompletionResults HEX: 08 }
{ CXTranslationUnit_CXXPrecompiledPreamble HEX: 10 }
{ CXTranslationUnit_CXXChainedPCH HEX: 20 }
{ CXTranslationUnit_NestedMacroInstantiations HEX: 40 } ;
FUNCTION: uint clang_defaultEditingTranslationUnitOptions ( ) ;
FUNCTION: CXTranslationUnit clang_parseTranslationUnit ( CXIndex CIdx,
c-string source_filename,
char** command_line_args,
int num_command_line_args,
CXUnsavedFile* unsaved_files,
uint num_unsaved_files,
uint options ) ;
ENUM: CXSaveTranslationUnit_Flags CXSaveTranslationUnit_None ;
FUNCTION: uint clang_defaultSaveOptions ( CXTranslationUnit TU ) ;
FUNCTION: int clang_saveTranslationUnit ( CXTranslationUnit TU,
c-string FileName,
uint options ) ;
FUNCTION: void clang_disposeTranslationUnit ( CXTranslationUnit ) ;
ENUM: CXReparse_Flags CXReparse_None ;
FUNCTION: uint clang_defaultReparseOptions ( CXTranslationUnit TU ) ;
FUNCTION: int clang_reparseTranslationUnit ( CXTranslationUnit TU,
uint num_unsaved_files,
CXUnsavedFile* unsaved_files,
uint options ) ;
ENUM: CXTUResourceUsageKind
{ CXTUResourceUsage_AST 1 }
{ CXTUResourceUsage_Identifiers 2 }
{ CXTUResourceUsage_Selectors 3 }
{ CXTUResourceUsage_GlobalCompletionResults 4 }
{ CXTUResourceUsage_SourceManagerContentCache 5 }
{ CXTUResourceUsage_AST_SideTables 6 }
{ CXTUResourceUsage_SourceManager_Membuffer_Malloc 7 }
{ CXTUResourceUsage_SourceManager_Membuffer_MMap 8 }
{ CXTUResourceUsage_ExternalASTSource_Membuffer_Malloc 9 }
{ CXTUResourceUsage_ExternalASTSource_Membuffer_MMap 10 }
{ CXTUResourceUsage_Preprocessor 11 }
{ CXTUResourceUsage_PreprocessingRecord 12 }
{ CXTUResourceUsage_MEMORY_IN_BYTES_BEGIN 1 }
{ CXTUResourceUsage_MEMORY_IN_BYTES_END 12 }
{ CXTUResourceUsage_First 1 }
{ CXTUResourceUsage_Last 12 } ;
FUNCTION: c-string clang_getTUResourceUsageName ( CXTUResourceUsageKind kind ) ;
STRUCT: CXTUResourceUsageEntry
{ kind CXTUResourceUsageKind }
{ amount ulong } ;
STRUCT: CXTUResourceUsage
{ data void* }
{ numEntries uint }
{ entries CXTUResourceUsageEntry* } ;
FUNCTION: CXTUResourceUsage clang_getCXTUResourceUsage ( CXTranslationUnit TU ) ;
FUNCTION: void clang_disposeCXTUResourceUsage ( CXTUResourceUsage usage ) ;
ENUM: CXCursorKind
{ CXCursor_UnexposedDecl 1 }
{ CXCursor_StructDecl 2 }
{ CXCursor_UnionDecl 3 }
{ CXCursor_ClassDecl 4 }
{ CXCursor_EnumDecl 5 }
{ CXCursor_FieldDecl 6 }
{ CXCursor_EnumConstantDecl 7 }
{ CXCursor_FunctionDecl 8 }
{ CXCursor_VarDecl 9 }
{ CXCursor_ParmDecl 10 }
{ CXCursor_ObjCInterfaceDecl 11 }
{ CXCursor_ObjCCategoryDecl 12 }
{ CXCursor_ObjCProtocolDecl 13 }
{ CXCursor_ObjCPropertyDecl 14 }
{ CXCursor_ObjCIvarDecl 15 }
{ CXCursor_ObjCInstanceMethodDecl 16 }
{ CXCursor_ObjCClassMethodDecl 17 }
{ CXCursor_ObjCImplementationDecl 18 }
{ CXCursor_ObjCCategoryImplDecl 19 }
{ CXCursor_TypedefDecl 20 }
{ CXCursor_CXXMethod 21 }
{ CXCursor_Namespace 22 }
{ CXCursor_LinkageSpec 23 }
{ CXCursor_Constructor 24 }
{ CXCursor_Destructor 25 }
{ CXCursor_ConversionFunction 26 }
{ CXCursor_TemplateTypeParameter 27 }
{ CXCursor_NonTypeTemplateParameter 28 }
{ CXCursor_TemplateTemplateParameter 29 }
{ CXCursor_FunctionTemplate 30 }
{ CXCursor_ClassTemplate 31 }
{ CXCursor_ClassTemplatePartialSpecialization 32 }
{ CXCursor_NamespaceAlias 33 }
{ CXCursor_UsingDirective 34 }
{ CXCursor_UsingDeclaration 35 }
{ CXCursor_TypeAliasDecl 36 }
{ CXCursor_FirstDecl 1 }
{ CXCursor_LastDecl 36 }
{ CXCursor_FirstRef 40 }
{ CXCursor_ObjCSuperClassRef 40 }
{ CXCursor_ObjCProtocolRef 41 }
{ CXCursor_ObjCClassRef 42 }
{ CXCursor_TypeRef 43 }
{ CXCursor_CXXBaseSpecifier 44 }
{ CXCursor_TemplateRef 45 }
{ CXCursor_NamespaceRef 46 }
{ CXCursor_MemberRef 47 }
{ CXCursor_LabelRef 48 }
{ CXCursor_OverloadedDeclRef 49 }
{ CXCursor_LastRef 49 }
{ CXCursor_FirstInvalid 70 }
{ CXCursor_InvalidFile 70 }
{ CXCursor_NoDeclFound 71 }
{ CXCursor_NotImplemented 72 }
{ CXCursor_InvalidCode 73 }
{ CXCursor_LastInvalid 73 }
{ CXCursor_FirstExpr 100 }
{ CXCursor_UnexposedExpr 100 }
{ CXCursor_DeclRefExpr 101 }
{ CXCursor_MemberRefExpr 102 }
{ CXCursor_CallExpr 103 }
{ CXCursor_ObjCMessageExpr 104 }
{ CXCursor_BlockExpr 105 }
{ CXCursor_LastExpr 105 }
{ CXCursor_FirstStmt 200 }
{ CXCursor_UnexposedStmt 200 }
{ CXCursor_LabelStmt 201 }
{ CXCursor_LastStmt 201 }
{ CXCursor_TranslationUnit 300 }
{ CXCursor_FirstAttr 400 }
{ CXCursor_UnexposedAttr 400 }
{ CXCursor_IBActionAttr 401 }
{ CXCursor_IBOutletAttr 402 }
{ CXCursor_IBOutletCollectionAttr 403 }
{ CXCursor_LastAttr 403 }
{ CXCursor_PreprocessingDirective 500 }
{ CXCursor_MacroDefinition 501 }
{ CXCursor_MacroInstantiation 502 }
{ CXCursor_InclusionDirective 503 }
{ CXCursor_FirstPreprocessing 500 }
{ CXCursor_LastPreprocessing 503 } ;
STRUCT: CXCursor
{ kind CXCursorKind }
{ data void*[3] } ;
FUNCTION: CXCursor clang_getNullCursor ( ) ;
FUNCTION: CXCursor clang_getTranslationUnitCursor ( CXTranslationUnit ) ;
FUNCTION: uint clang_equalCursors ( CXCursor c1, CXCursor c2 ) ;
FUNCTION: uint clang_hashCursor ( CXCursor ) ;
FUNCTION: CXCursorKind clang_getCursorKind ( CXCursor ) ;
FUNCTION: uint clang_isDeclaration ( CXCursorKind ) ;
FUNCTION: uint clang_isReference ( CXCursorKind ) ;
FUNCTION: uint clang_isExpression ( CXCursorKind ) ;
FUNCTION: uint clang_isStatement ( CXCursorKind ) ;
FUNCTION: uint clang_isInvalid ( CXCursorKind ) ;
FUNCTION: uint clang_isTranslationUnit ( CXCursorKind ) ;
FUNCTION: uint clang_isPreprocessing ( CXCursorKind ) ;
FUNCTION: uint clang_isUnexposed ( CXCursorKind ) ;
ENUM: CXLinkageKind
CXLinkage_Invalid
CXLinkage_NoLinkage
CXLinkage_Internal
CXLinkage_UniqueExternal
CXLinkage_External ;
ENUM: CXLanguageKind
CXLanguage_Invalid
CXLanguage_C
CXLanguage_ObjC
CXLanguage_CPlusPlus ;
FUNCTION: CXLinkageKind clang_getCursorLinkage ( CXCursor cursor ) ;
FUNCTION: CXAvailabilityKind clang_getCursorAvailability ( CXCursor cursor ) ;
FUNCTION: CXLanguageKind clang_getCursorLanguage ( CXCursor cursor ) ;
C-TYPE: CXCursorSetImpl
TYPEDEF: CXCursorSetImpl* CXCursorSet
FUNCTION: CXCursorSet clang_createCXCursorSet ( ) ;
FUNCTION: void clang_disposeCXCursorSet ( CXCursorSet cset ) ;
FUNCTION: uint clang_CXCursorSet_contains ( CXCursorSet cset, CXCursor cursor ) ;
FUNCTION: uint clang_CXCursorSet_insert ( CXCursorSet cset, CXCursor cursor ) ;
FUNCTION: CXCursor clang_getCursorSemanticParent ( CXCursor cursor ) ;
FUNCTION: CXCursor clang_getCursorLexicalParent ( CXCursor cursor ) ;
FUNCTION: void clang_getOverriddenCursors ( CXCursor cursor, CXCursor** overridden, uint* num_overridden ) ;
FUNCTION: void clang_disposeOverriddenCursors ( CXCursor* overridden ) ;
FUNCTION: CXFile clang_getIncludedFile ( CXCursor cursor ) ;
FUNCTION: CXCursor clang_getCursor ( CXTranslationUnit TU,
CXSourceLocation location ) ;
FUNCTION: CXSourceLocation clang_getCursorLocation ( CXCursor ) ;
FUNCTION: CXSourceRange clang_getCursorExtent ( CXCursor ) ;
ENUM: CXTypeKind
{ CXType_Invalid 0 }
{ CXType_Unexposed 1 }
{ CXType_Void 2 }
{ CXType_Bool 3 }
{ CXType_Char_U 4 }
{ CXType_UChar 5 }
{ CXType_Char16 6 }
{ CXType_Char32 7 }
{ CXType_UShort 8 }
{ CXType_UInt 9 }
{ CXType_ULong 10 }
{ CXType_ULongLong 11 }
{ CXType_UInt128 12 }
{ CXType_Char_S 13 }
{ CXType_SChar 14 }
{ CXType_WChar 15 }
{ CXType_Short 16 }
{ CXType_Int 17 }
{ CXType_Long 18 }
{ CXType_LongLong 19 }
{ CXType_Int128 20 }
{ CXType_Float 21 }
{ CXType_Double 22 }
{ CXType_LongDouble 23 }
{ CXType_NullPtr 24 }
{ CXType_Overload 25 }
{ CXType_Dependent 26 }
{ CXType_ObjCId 27 }
{ CXType_ObjCClass 28 }
{ CXType_ObjCSel 29 }
{ CXType_FirstBuiltin 2 }
{ CXType_LastBuiltin 29 }
{ CXType_Complex 100 }
{ CXType_Pointer 101 }
{ CXType_BlockPointer 102 }
{ CXType_LValueReference 103 }
{ CXType_RValueReference 104 }
{ CXType_Record 105 }
{ CXType_Enum 106 }
{ CXType_Typedef 107 }
{ CXType_ObjCInterface 108 }
{ CXType_ObjCObjectPointer 109 }
{ CXType_FunctionNoProto 110 }
{ CXType_FunctionProto 111 } ;
STRUCT: CXType
{ kind CXTypeKind }
{ data void*[2] } ;
FUNCTION: CXType clang_getCursorType ( CXCursor C ) ;
FUNCTION: uint clang_equalTypes ( CXType A, CXType B ) ;
FUNCTION: CXType clang_getCanonicalType ( CXType T ) ;
FUNCTION: uint clang_isConstQualifiedType ( CXType T ) ;
FUNCTION: uint clang_isVolatileQualifiedType ( CXType T ) ;
FUNCTION: uint clang_isRestrictQualifiedType ( CXType T ) ;
FUNCTION: CXType clang_getPointeeType ( CXType T ) ;
FUNCTION: CXCursor clang_getTypeDeclaration ( CXType T ) ;
FUNCTION: CXString clang_getDeclObjCTypeEncoding ( CXCursor C ) ;
FUNCTION: CXString clang_getTypeKindSpelling ( CXTypeKind K ) ;
FUNCTION: CXType clang_getResultType ( CXType T ) ;
FUNCTION: CXType clang_getCursorResultType ( CXCursor C ) ;
FUNCTION: uint clang_isPODType ( CXType T ) ;
FUNCTION: uint clang_isVirtualBase ( CXCursor ) ;
ENUM: CX_CXXAccessSpecifier
CX_CXXInvalidAccessSpecifier
CX_CXXPublic
CX_CXXProtected
CX_CXXPrivate ;
FUNCTION: CX_CXXAccessSpecifier clang_getCXXAccessSpecifier ( CXCursor ) ;
FUNCTION: uint clang_getNumOverloadedDecls ( CXCursor cursor ) ;
FUNCTION: CXCursor clang_getOverloadedDecl ( CXCursor cursor, uint index ) ;
FUNCTION: CXType clang_getIBOutletCollectionType ( CXCursor ) ;
ENUM: CXChildVisitResult
CXChildVisit_Break
CXChildVisit_Continue
CXChildVisit_Recurse ;
CALLBACK: CXChildVisitResult CXCursorVisitor ( CXCursor cursor,
CXCursor parent,
CXClientData client_data ) ;
FUNCTION: uint clang_visitChildren ( CXCursor parent,
CXCursorVisitor visitor,
CXClientData client_data ) ;
FUNCTION: CXString clang_getCursorUSR ( CXCursor ) ;
FUNCTION: CXString clang_constructUSR_ObjCClass ( c-string class_name ) ;
FUNCTION: CXString clang_constructUSR_ObjCCategory ( c-string class_name,
c-string category_name ) ;
FUNCTION: CXString clang_constructUSR_ObjCProtocol ( c-string protocol_name ) ;
FUNCTION: CXString clang_constructUSR_ObjCIvar ( c-string name,
CXString classUSR ) ;
FUNCTION: CXString clang_constructUSR_ObjCMethod ( c-string name,
uint isInstanceMethod,
CXString classUSR ) ;
FUNCTION: CXString clang_constructUSR_ObjCProperty ( c-string property,
CXString classUSR ) ;
FUNCTION: CXString clang_getCursorSpelling ( CXCursor ) ;
FUNCTION: CXString clang_getCursorDisplayName ( CXCursor ) ;
FUNCTION: CXCursor clang_getCursorReferenced ( CXCursor ) ;
FUNCTION: CXCursor clang_getCursorDefinition ( CXCursor ) ;
FUNCTION: uint clang_isCursorDefinition ( CXCursor ) ;
FUNCTION: CXCursor clang_getCanonicalCursor ( CXCursor ) ;
FUNCTION: uint clang_CXXMethod_isStatic ( CXCursor C ) ;
FUNCTION: uint clang_CXXMethod_isVirtual ( CXCursor C ) ;
FUNCTION: CXCursorKind clang_getTemplateCursorKind ( CXCursor C ) ;
FUNCTION: CXCursor clang_getSpecializedCursorTemplate ( CXCursor C ) ;
ENUM: CXTokenKind
CXToken_Punctuation
CXToken_Keyword
CXToken_Identifier
CXToken_Literal
CXToken_Comment ;
STRUCT: CXToken
{ int_data uint[4] }
{ ptr_data void* } ;
FUNCTION: CXTokenKind clang_getTokenKind ( CXToken ) ;
FUNCTION: CXString clang_getTokenSpelling ( CXTranslationUnit TU,
CXToken Token ) ;
FUNCTION: CXSourceLocation clang_getTokenLocation ( CXTranslationUnit TU,
CXToken Token ) ;
FUNCTION: CXSourceRange clang_getTokenExtent ( CXTranslationUnit TU,
CXToken Token ) ;
FUNCTION: void clang_tokenize ( CXTranslationUnit TU,
CXSourceRange Range,
CXToken** Tokens,
uint* NumTokens ) ;
FUNCTION: void clang_annotateTokens ( CXTranslationUnit TU,
CXToken* Tokens,
uint NumTokens,
CXCursor* Cursors ) ;
FUNCTION: void clang_disposeTokens ( CXTranslationUnit TU,
CXToken* Tokens,
uint NumTokens ) ;
FUNCTION: CXString clang_getCursorKindSpelling ( CXCursorKind Kind ) ;
FUNCTION: void clang_getDefinitionSpellingAndExtent ( CXCursor cursor,
char** startBuf,
char** endBuf,
uint* startLine,
uint* startColumn,
uint* endLine,
uint* endColumn ) ;
FUNCTION: void clang_enableStackTraces ( ) ;
CALLBACK: void executeOnThreadCallback ( void* ) ;
FUNCTION: void clang_executeOnThread ( executeOnThreadCallback* callback,
void* user_data,
uint stack_size ) ;
TYPEDEF: void* CXCompletionString
STRUCT: CXCompletionResult
{ CursorKind CXCursorKind }
{ CompletionString CXCompletionString } ;
ENUM: CXCompletionChunkKind
CXCompletionChunk_Optional
CXCompletionChunk_TypedText
CXCompletionChunk_Text
CXCompletionChunk_Placeholder
CXCompletionChunk_Informative
CXCompletionChunk_CurrentParameter
CXCompletionChunk_LeftParen
CXCompletionChunk_RightParen
CXCompletionChunk_LeftBracket
CXCompletionChunk_RightBracket
CXCompletionChunk_LeftBrace
CXCompletionChunk_RightBrace
CXCompletionChunk_LeftAngle
CXCompletionChunk_RightAngle
CXCompletionChunk_Comma
CXCompletionChunk_ResultType
CXCompletionChunk_Colon
CXCompletionChunk_SemiColon
CXCompletionChunk_Equal
CXCompletionChunk_HorizontalSpace
CXCompletionChunk_VerticalSpace ;
FUNCTION: CXCompletionChunkKind clang_getCompletionChunkKind ( CXCompletionString completion_string,
uint chunk_number ) ;
FUNCTION: CXString clang_getCompletionChunkText ( CXCompletionString completion_string,
uint chunk_number ) ;
FUNCTION: CXCompletionString clang_getCompletionChunkCompletionString ( CXCompletionString completion_string,
uint chunk_number ) ;
FUNCTION: uint clang_getNumCompletionChunks ( CXCompletionString completion_string ) ;
FUNCTION: uint clang_getCompletionPriority ( CXCompletionString completion_string ) ;
FUNCTION: CXAvailabilityKind clang_getCompletionAvailability ( CXCompletionString completion_string ) ;
STRUCT: CXCodeCompleteResults
{ Results CXCompletionResult* }
{ NumResults uint } ;
ENUM: CXCodeComplete_Flags
{ CXCodeComplete_IncludeMacros 1 }
{ CXCodeComplete_IncludeCodePatterns 2 } ;
FUNCTION: uint clang_defaultCodeCompleteOptions ( ) ;
FUNCTION: CXCodeCompleteResults* clang_codeCompleteAt ( CXTranslationUnit TU,
c-string complete_filename,
uint complete_line,
uint complete_column,
CXUnsavedFile* unsaved_files,
uint num_unsaved_files,
uint options ) ;
FUNCTION: void clang_sortCodeCompletionResults ( CXCompletionResult* Results, uint NumResults ) ;
FUNCTION: void clang_disposeCodeCompleteResults ( CXCodeCompleteResults* Results ) ;
FUNCTION: uint clang_codeCompleteGetNumDiagnostics ( CXCodeCompleteResults* Results ) ;
FUNCTION: CXDiagnostic clang_codeCompleteGetDiagnostic ( CXCodeCompleteResults* Results,
uint Index ) ;
FUNCTION: CXString clang_getClangVersion ( ) ;
FUNCTION: void clang_toggleCrashRecovery ( uint isEnabled ) ;
CALLBACK: void CXInclusionVisitor ( CXFile included_file,
CXSourceLocation* inclusion_stack,
uint include_len,
CXClientData client_data ) ;
FUNCTION: void clang_getInclusions ( CXTranslationUnit tu,
CXInclusionVisitor visitor,
CXClientData client_data ) ;

1
extra/readline-listener/authors.txt Normal file
View File

@ -0,0 +1 @@
Erik Charlebois

17
extra/readline-listener/readline-listener-docs.factor Normal file
View File

@ -0,0 +1,17 @@
! Copyright (C) 2011 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax vocabs.loader ;
IN: readline-listener
HELP: readline-listener
{ $description "Invokes a listener that uses libreadline for editing, history and word completion." } ;
ARTICLE: "readline-listener" "Readline listener"
{ $vocab-link "readline-listener" }
$nl
"By default, the terminal listener does not provide any command history or completion. This vocabulary uses libreadline to provide a listener with history, word completion and more convenient editing facilities."
$nl
{ $code "\"readline-listener\" run" }
;
ABOUT: "readline-listener"

54
extra/readline-listener/readline-listener.factor Normal file
View File

@ -0,0 +1,54 @@
! Copyright (C) 2011 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.data fry io io.encodings.utf8 kernel
listener namespaces readline sequences threads vocabs
command-line vocabs.hierarchy sequences.deep locals
splitting math ;
QUALIFIED: readline.ffi
IN: readline-listener
<PRIVATE
SYMBOL: completions
TUPLE: readline-reader { prompt initial: f } ;
M: readline-reader stream-readln
flush [ prompt>> dup [ " " append ] [ ] if readline ]
keep f >>prompt drop ;
M: readline-reader prompt.
>>prompt drop ;
: word-names ( -- strs )
all-words [ name>> ] map ;
: vocab-names ( -- strs )
all-vocabs-recursive no-roots no-prefixes [ name>> ] map ;
: prefixed-words ( prefix -- words )
'[ _ head? ] word-names swap filter ;
: prefixed-vocabs ( prefix -- words )
'[ _ head? ] vocab-names swap filter ;
: clear-completions ( -- )
f completions tset ;
: get-completions ( prefix -- completions )
completions tget dup [ nip ] [
drop current-line " " split first
"USING:" = [
prefixed-vocabs
] [
prefixed-words
] if dup completions tset
] if ;
PRIVATE>
: readline-listener ( -- )
[
swap get-completions ?nth
[ clear-completions f ] unless*
] set-completion
readline-reader new [ listener ] with-input-stream* ;
MAIN: readline-listener

1
extra/readline-listener/summary.txt Normal file
View File

@ -0,0 +1 @@
A listener that uses libreadline.

0
extra/readline-listener/tags.txt Normal file
View File

1
extra/readline/authors.txt Normal file
View File

@ -0,0 +1 @@
Erik Charlebois

651
extra/readline/ffi/ffi.factor Normal file
View File

@ -0,0 +1,651 @@
! Copyright (C) 2010 Erik Charlebois
! See http:// factorcode.org/license.txt for BSD license.
USING: alien alien.c-types kernel alien.syntax classes.struct
accessors libc math make unix.types namespaces system
combinators alien.libraries ;
IN: readline.ffi
<<
"readline" {
{ [ os windows? ] [ "readline.dll" ] }
{ [ os macosx? ] [ "libreadline.dylib" ] }
{ [ os unix? ] [ "libreadline.so" ] }
} cond cdecl add-library
>>
LIBRARY: readline
TYPEDEF: void* histdata_t
STRUCT: HIST_ENTRY
{ line c-string }
{ timestamp c-string }
{ data histdata_t } ;
: HISTENT_BYTES ( hs -- n ) [ line>> strlen ] [ timestamp>> strlen ] bi + ; inline
STRUCT: HISTORY_STATE
{ entries HIST_ENTRY** }
{ offset int }
{ length int }
{ size int }
{ flags int } ;
CONSTANT: HS_STIFLED 1
FUNCTION: void using_history ( ) ;
FUNCTION: HISTORY_STATE* history_get_history_state ( ) ;
FUNCTION: void history_set_history_state ( HISTORY_STATE* arg1 ) ;
FUNCTION: void add_history ( c-string arg1 ) ;
FUNCTION: void add_history_time ( c-string arg1 ) ;
FUNCTION: HIST_ENTRY* remove_history ( int arg1 ) ;
FUNCTION: histdata_t free_history_entry ( HIST_ENTRY* arg1 ) ;
FUNCTION: HIST_ENTRY* replace_history_entry ( int arg1, c-string
arg2, histdata_t
arg3 ) ;
FUNCTION: void clear_history ( ) ;
FUNCTION: void stifle_history ( int arg1 ) ;
FUNCTION: int unstifle_history ( ) ;
FUNCTION: int history_is_stifled ( ) ;
FUNCTION: HIST_ENTRY** history_list ( ) ;
FUNCTION: int where_history ( ) ;
FUNCTION: HIST_ENTRY* current_history ( ) ;
FUNCTION: HIST_ENTRY* history_get ( int arg1 ) ;
FUNCTION: time_t history_get_time ( HIST_ENTRY* arg1 ) ;
FUNCTION: int history_total_bytes ( ) ;
FUNCTION: int history_set_pos ( int arg1 ) ;
FUNCTION: HIST_ENTRY* previous_history ( ) ;
FUNCTION: HIST_ENTRY* next_history ( ) ;
FUNCTION: int history_search ( c-string arg1, int arg2 ) ;
FUNCTION: int history_search_prefix ( c-string arg1, int arg2 ) ;
FUNCTION: int history_search_pos ( c-string arg1, int arg2, int
arg3 ) ;
FUNCTION: int read_history ( c-string arg1 ) ;
FUNCTION: int read_history_range ( c-string arg1, int arg2, int
arg3 ) ;
FUNCTION: int write_history ( c-string arg1 ) ;
FUNCTION: int append_history ( int arg1, c-string arg2 ) ;
FUNCTION: int history_expand ( c-string arg1, char** arg2 ) ;
FUNCTION: c-string history_arg_extract ( int arg1, int arg2,
c-string arg3 ) ;
FUNCTION: c-string get_history_event ( c-string arg1, int* arg2,
int arg3 ) ;
FUNCTION: char** history_tokenize ( c-string arg1 ) ;
CALLBACK: int rl_command_func_t ( int arg1, int arg2 ) ;
CALLBACK: char* rl_compentry_func_t ( c-string arg1, int arg2 ) ;
CALLBACK: char** rl_completion_func_t ( c-string arg1, int arg2,
int arg3 ) ;
CALLBACK: c-string rl_quote_func_t ( c-string arg1, int arg2,
c-string arg3 ) ;
CALLBACK: c-string rl_dequote_func_t ( c-string arg1, int arg2 ) ;
CALLBACK: int rl_compignore_func_t ( char** arg1 ) ;
CALLBACK: void rl_compdisp_func_t ( char** arg1, int arg2, int
arg3 ) ;
CALLBACK: int rl_hook_func_t ( ) ;
CALLBACK: int rl_getc_func_t ( FILE* arg1 ) ;
CALLBACK: int rl_linebuf_func_t ( c-string arg1, int arg2 ) ;
STRUCT: KEYMAP_ENTRY
{ type char }
{ function rl_command_func_t* } ;
CONSTANT: KEYMAP_SIZE 257
CONSTANT: ANYOTHERKEY 256
TYPEDEF: KEYMAP_ENTRY[257] KEYMAP_ENTRY_ARRAY
TYPEDEF: KEYMAP_ENTRY* Keymap
CONSTANT: ISFUNC 0
CONSTANT: ISKMAP 1
CONSTANT: ISMACR 2
C-GLOBAL: KEYMAP_ENTRY_ARRAY emacs_standard_keymap
C-GLOBAL: KEYMAP_ENTRY_ARRAY emacs_meta_keymap
C-GLOBAL: KEYMAP_ENTRY_ARRAY emacs_ctlx_keymap
C-GLOBAL: KEYMAP_ENTRY_ARRAY vi_insertion_keymap
C-GLOBAL: KEYMAP_ENTRY_ARRAY vi_movement_keymap
FUNCTION: Keymap rl_copy_keymap ( Keymap ) ;
FUNCTION: Keymap rl_make_keymap ( ) ;
FUNCTION: void rl_discard_keymap ( Keymap ) ;
CALLBACK: c-string tilde_hook_func_t ( c-string ) ;
C-GLOBAL: tilde_hook_func_t* tilde_expansion_preexpansion_hook
C-GLOBAL: tilde_hook_func_t* tilde_expansion_failure_hook
C-GLOBAL: char** tilde_additional_prefixes
C-GLOBAL: char** tilde_additional_suffixes
FUNCTION: c-string tilde_expand ( c-string ) ;
FUNCTION: c-string tilde_expand_word ( c-string ) ;
FUNCTION: c-string tilde_find_word ( c-string arg1, int arg2,
int* arg3 ) ;
C-GLOBAL: int history_base
C-GLOBAL: int history_length
C-GLOBAL: int history_max_entries
C-GLOBAL: char history_expansion_char
C-GLOBAL: char history_subst_char
C-GLOBAL: c-string history_word_delimiters
C-GLOBAL: char history_comment_char
C-GLOBAL: c-string history_no_expand_chars
C-GLOBAL: c-string history_search_delimiter_chars
C-GLOBAL: int history_quotes_inhibit_expansion
C-GLOBAL: int history_write_timestamps
C-GLOBAL: int max_input_history
C-GLOBAL: rl_linebuf_func_t* history_inhibit_expansion_function
CALLBACK: int rl_intfunc_t ( int ) ;
CALLBACK: int rl_icpfunc_t ( c-string ) ;
CALLBACK: int rl_icppfunc_t ( char** ) ;
CALLBACK: void rl_voidfunc_t ( ) ;
CALLBACK: void rl_vintfunc_t ( int ) ;
CALLBACK: void rl_vcpfunc_t ( c-string ) ;
CALLBACK: void rl_vcppfunc_t ( char** ) ;
CALLBACK: c-string rl_cpvfunc_t ( ) ;
CALLBACK: c-string rl_cpifunc_t ( int ) ;
CALLBACK: c-string rl_cpcpfunc_t ( c-string ) ;
CALLBACK: c-string rl_cpcppfunc_t ( char** ) ;
ENUM: undo_code UNDO_DELETE UNDO_INSERT UNDO_BEGIN UNDO_END ;
STRUCT: UNDO_LIST
{ next UNDO_LIST* }
{ start int }
{ end int }
{ text char* }
{ what undo_code } ;
C-GLOBAL: UNDO_LIST* rl_undo_list
STRUCT: FUNMAP
{ name c-string }
{ function rl_command_func_t* } ;
C-GLOBAL: FUNMAP** funmap
FUNCTION: int rl_digit_argument ( int arg1, int arg2 ) ;
FUNCTION: int rl_universal_argument ( int arg, int arg ) ;
FUNCTION: int rl_forward_byte ( int arg1, int arg2 ) ;
FUNCTION: int rl_forward_char ( int arg1, int arg2 ) ;
FUNCTION: int rl_forward ( int arg1, int arg2 ) ;
FUNCTION: int rl_backward_byte ( int arg1, int arg2 ) ;
FUNCTION: int rl_backward_char ( int arg1, int arg2 ) ;
FUNCTION: int rl_backward ( int arg1, int arg2 ) ;
FUNCTION: int rl_beg_of_line ( int arg1, int arg2 ) ;
FUNCTION: int rl_end_of_line ( int arg1, int arg2 ) ;
FUNCTION: int rl_forward_word ( int arg1, int arg2 ) ;
FUNCTION: int rl_backward_word ( int arg1, int arg2 ) ;
FUNCTION: int rl_refresh_line ( int arg1, int arg2 ) ;
FUNCTION: int rl_clear_screen ( int arg1, int arg2 ) ;
FUNCTION: int rl_skip_csi_sequence ( int arg1, int arg2 ) ;
FUNCTION: int rl_arrow_keys ( int arg1, int arg2 ) ;
FUNCTION: int rl_insert ( int arg1, int arg2 ) ;
FUNCTION: int rl_quoted_insert ( int arg1, int arg2 ) ;
FUNCTION: int rl_tab_insert ( int arg1, int arg2 ) ;
FUNCTION: int rl_newline ( int arg1, int arg2 ) ;
FUNCTION: int rl_do_lowercase_version ( int arg1, int arg2 ) ;
FUNCTION: int rl_rubout ( int arg1, int arg2 ) ;
FUNCTION: int rl_delete ( int arg1, int arg2 ) ;
FUNCTION: int rl_rubout_or_delete ( int arg1, int arg2 ) ;
FUNCTION: int rl_delete_horizontal_space ( int arg1, int arg2 ) ;
FUNCTION: int rl_delete_or_show_completions ( int arg1, int arg2 ) ;
FUNCTION: int rl_insert_comment ( int arg1, int arg2 ) ;
FUNCTION: int rl_upcase_word ( int arg1, int arg2 ) ;
FUNCTION: int rl_downcase_word ( int arg1, int arg2 ) ;
FUNCTION: int rl_capitalize_word ( int arg1, int arg2 ) ;
FUNCTION: int rl_transpose_words ( int arg1, int arg2 ) ;
FUNCTION: int rl_transpose_chars ( int arg1, int arg2 ) ;
FUNCTION: int rl_char_search ( int arg1, int arg2 ) ;
FUNCTION: int rl_backward_char_search ( int arg1, int arg2 ) ;
FUNCTION: int rl_beginning_of_history ( int arg1, int arg2 ) ;
FUNCTION: int rl_end_of_history ( int arg1, int arg2 ) ;
FUNCTION: int rl_get_next_history ( int arg1, int arg2 ) ;
FUNCTION: int rl_get_previous_history ( int arg1, int arg2 ) ;
FUNCTION: int rl_set_mark ( int arg1, int arg2 ) ;
FUNCTION: int rl_exchange_point_and_mark ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_editing_mode ( int arg1, int arg2 ) ;
FUNCTION: int rl_emacs_editing_mode ( int arg1, int arg2 ) ;
FUNCTION: int rl_overwrite_mode ( int arg1, int arg2 ) ;
FUNCTION: int rl_re_read_init_file ( int arg1, int arg2 ) ;
FUNCTION: int rl_dump_functions ( int arg1, int arg2 ) ;
FUNCTION: int rl_dump_macros ( int arg1, int arg2 ) ;
FUNCTION: int rl_dump_variables ( int arg1, int arg2 ) ;
FUNCTION: int rl_complete ( int arg1, int arg2 ) ;
FUNCTION: int rl_possible_completions ( int arg1, int arg2 ) ;
FUNCTION: int rl_insert_completions ( int arg1, int arg2 ) ;
FUNCTION: int rl_old_menu_complete ( int arg1, int arg2 ) ;
FUNCTION: int rl_menu_complete ( int arg1, int arg2 ) ;
FUNCTION: int rl_backward_menu_complete ( int arg1, int arg2 ) ;
FUNCTION: int rl_kill_word ( int arg1, int arg2 ) ;
FUNCTION: int rl_backward_kill_word ( int arg1, int arg2 ) ;
FUNCTION: int rl_kill_line ( int arg1, int arg2 ) ;
FUNCTION: int rl_backward_kill_line ( int arg1, int arg2 ) ;
FUNCTION: int rl_kill_full_line ( int arg1, int arg2 ) ;
FUNCTION: int rl_unix_word_rubout ( int arg1, int arg2 ) ;
FUNCTION: int rl_unix_filename_rubout ( int arg1, int arg2 ) ;
FUNCTION: int rl_unix_line_discard ( int arg1, int arg2 ) ;
FUNCTION: int rl_copy_region_to_kill ( int arg1, int arg2 ) ;
FUNCTION: int rl_kill_region ( int arg1, int arg2 ) ;
FUNCTION: int rl_copy_forward_word ( int arg1, int arg2 ) ;
FUNCTION: int rl_copy_backward_word ( int arg1, int arg2 ) ;
FUNCTION: int rl_yank ( int arg1, int arg2 ) ;
FUNCTION: int rl_yank_pop ( int arg1, int arg2 ) ;
FUNCTION: int rl_yank_nth_arg ( int arg1, int arg2 ) ;
FUNCTION: int rl_yank_last_arg ( int arg1, int arg2 ) ;
FUNCTION: int rl_reverse_search_history ( int arg1, int arg2 ) ;
FUNCTION: int rl_forward_search_history ( int arg1, int arg2 ) ;
FUNCTION: int rl_start_kbd_macro ( int arg1, int arg2 ) ;
FUNCTION: int rl_end_kbd_macro ( int arg1, int arg2 ) ;
FUNCTION: int rl_call_last_kbd_macro ( int arg1, int arg2 ) ;
FUNCTION: int rl_revert_line ( int arg1, int arg2 ) ;
FUNCTION: int rl_undo_command ( int arg1, int arg2 ) ;
FUNCTION: int rl_tilde_expand ( int arg1, int arg2 ) ;
FUNCTION: int rl_restart_output ( int arg1, int arg2 ) ;
FUNCTION: int rl_stop_output ( int arg1, int arg2 ) ;
FUNCTION: int rl_abort ( int arg1, int arg2 ) ;
FUNCTION: int rl_tty_status ( int arg1, int arg2 ) ;
FUNCTION: int rl_history_search_forward ( int arg1, int arg2 ) ;
FUNCTION: int rl_history_search_backward ( int arg1, int arg2 ) ;
FUNCTION: int rl_noninc_forward_search ( int arg1, int arg2 ) ;
FUNCTION: int rl_noninc_reverse_search ( int arg1, int arg2 ) ;
FUNCTION: int rl_noninc_forward_search_again ( int arg1, int arg2 ) ;
FUNCTION: int rl_noninc_reverse_search_again ( int arg1, int arg2 ) ;
FUNCTION: int rl_insert_close ( int arg1, int arg2 ) ;
FUNCTION: void rl_callback_handler_install ( c-string arg1,
rl_vcpfunc_t* arg2 ) ;
FUNCTION: void rl_callback_read_char ( ) ;
FUNCTION: void rl_callback_handler_remove ( ) ;
FUNCTION: int rl_vi_redo ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_undo ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_yank_arg ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_fetch_history ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_search_again ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_search ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_complete ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_tilde_expand ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_prev_word ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_next_word ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_end_word ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_insert_beg ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_append_mode ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_append_eol ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_eof_maybe ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_insertion_mode ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_insert_mode ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_movement_mode ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_arg_digit ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_change_case ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_put ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_column ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_delete_to ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_change_to ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_yank_to ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_rubout ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_delete ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_back_to_indent ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_first_print ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_char_search ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_match ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_change_char ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_subst ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_overstrike ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_overstrike_delete ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_replace ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_set_mark ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_goto_mark ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_check ( ) ;
FUNCTION: int rl_vi_domove ( int arg1, int* arg2 ) ;
FUNCTION: int rl_vi_bracktype ( int ) ;
FUNCTION: void rl_vi_start_inserting ( int arg1, int arg2, int
arg3 ) ;
FUNCTION: int rl_vi_fWord ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_bWord ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_eWord ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_fword ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_bword ( int arg1, int arg2 ) ;
FUNCTION: int rl_vi_eword ( int arg1, int arg2 ) ;
FUNCTION: char* readline ( c-string ) ;
FUNCTION: int rl_set_prompt ( c-string ) ;
FUNCTION: int rl_expand_prompt ( c-string ) ;
FUNCTION: int rl_initialize ( ) ;
FUNCTION: int rl_discard_argument ( ) ;
FUNCTION: int rl_add_defun ( c-string arg1, rl_command_func_t*
arg2, int arg3 ) ;
FUNCTION: int rl_bind_key ( int arg1, rl_command_func_t* arg2 ) ;
FUNCTION: int rl_bind_key_in_map ( int arg1, rl_command_func_t*
arg2, Keymap arg3 ) ;
FUNCTION: int rl_unbind_key ( int ) ;
FUNCTION: int rl_unbind_key_in_map ( int arg1, Keymap arg2 ) ;
FUNCTION: int rl_bind_key_if_unbound ( int arg1,
rl_command_func_t* arg2 ) ;
FUNCTION: int rl_bind_key_if_unbound_in_map ( int arg1,
rl_command_func_t*
arg2, Keymap arg3 ) ;
FUNCTION: int rl_unbind_function_in_map ( rl_command_func_t*
arg1, Keymap arg2 ) ;
FUNCTION: int rl_unbind_command_in_map ( c-string arg1, Keymap
arg2 ) ;
FUNCTION: int rl_bind_keyseq ( c-string arg1, rl_command_func_t*
arg2 ) ;
FUNCTION: int rl_bind_keyseq_in_map ( c-string arg1,
rl_command_func_t* arg2, Keymap
arg3 ) ;
FUNCTION: int rl_bind_keyseq_if_unbound ( c-string arg1,
rl_command_func_t* arg2 ) ;
FUNCTION: int rl_bind_keyseq_if_unbound_in_map ( c-string arg1,
rl_command_func_t*
arg2, Keymap
arg3 ) ;
FUNCTION: int rl_generic_bind ( int arg1, c-string arg2,
c-string arg3, Keymap arg4 ) ;
FUNCTION: c-string rl_variable_value ( c-string ) ;
FUNCTION: int rl_variable_bind ( c-string arg1, c-string arg2 ) ;
FUNCTION: int rl_set_key ( c-string arg1, rl_command_func_t*
arg2, Keymap arg3 ) ;
FUNCTION: int rl_macro_bind ( c-string arg1, c-string arg2,
Keymap arg3 ) ;
FUNCTION: int rl_translate_keyseq ( c-string arg1, c-string
arg2, int* arg3 ) ;
FUNCTION: c-string rl_untranslate_keyseq ( int ) ;
FUNCTION: rl_command_func_t* rl_named_function ( c-string ) ;
FUNCTION: rl_command_func_t* rl_function_of_keyseq ( c-string
arg1, Keymap
arg2, int*
arg3 ) ;
FUNCTION: void rl_list_funmap_names ( ) ;
FUNCTION: char** rl_invoking_keyseqs_in_map ( rl_command_func_t*
arg1, Keymap arg2 ) ;
FUNCTION: char** rl_invoking_keyseqs ( rl_command_func_t* ) ;
FUNCTION: void rl_function_dumper ( int ) ;
FUNCTION: void rl_macro_dumper ( int ) ;
FUNCTION: void rl_variable_dumper ( int ) ;
FUNCTION: int rl_read_init_file ( c-string ) ;
FUNCTION: int rl_parse_and_bind ( c-string ) ;
FUNCTION: Keymap rl_make_bare_keymap ( ) ;
FUNCTION: Keymap rl_get_keymap_by_name ( c-string ) ;
FUNCTION: c-string rl_get_keymap_name ( Keymap ) ;
FUNCTION: void rl_set_keymap ( Keymap ) ;
FUNCTION: Keymap rl_get_keymap ( ) ;
FUNCTION: void rl_set_keymap_from_edit_mode ( ) ;
FUNCTION: c-string rl_get_keymap_name_from_edit_mode ( ) ;
FUNCTION: int rl_add_funmap_entry ( c-string arg1,
rl_command_func_t* arg2 ) ;
FUNCTION: char** rl_funmap_names ( ) ;
FUNCTION: void rl_initialize_funmap ( ) ;
FUNCTION: void rl_push_macro_input ( c-string ) ;
FUNCTION: void rl_add_undo ( undo_code arg1, int arg2, int
arga3, c-string arg4 ) ;
FUNCTION: void rl_free_undo_list ( ) ;
FUNCTION: int rl_do_undo ( ) ;
FUNCTION: int rl_begin_undo_group ( ) ;
FUNCTION: int rl_end_undo_group ( ) ;
FUNCTION: int rl_modifying ( int arg1, int arg2 ) ;
FUNCTION: void rl_redisplay ( ) ;
FUNCTION: int rl_on_new_line ( ) ;
FUNCTION: int rl_on_new_line_with_prompt ( ) ;
FUNCTION: int rl_forced_update_display ( ) ;
FUNCTION: int rl_clear_message ( ) ;
FUNCTION: int rl_reset_line_state ( ) ;
FUNCTION: int rl_crlf ( ) ;
! FUNCTION: int rl_message ( c-string arg1, ... ) ;
FUNCTION: int rl_show_char ( int ) ;
FUNCTION: int rl_character_len ( int arg1, int arg2 ) ;
FUNCTION: void rl_save_prompt ( ) ;
FUNCTION: void rl_restore_prompt ( ) ;
FUNCTION: void rl_replace_line ( c-string arg1, int arg2 ) ;
FUNCTION: int rl_insert_text ( c-string arg1 ) ;
FUNCTION: int rl_delete_text ( int arg1, int arg2 ) ;
FUNCTION: int rl_kill_text ( int arg1, int arg2 ) ;
FUNCTION: c-string rl_copy_text ( int arg1, int arg2 ) ;
FUNCTION: void rl_prep_terminal ( int ) ;
FUNCTION: void rl_deprep_terminal ( ) ;
FUNCTION: void rl_tty_set_default_bindings ( Keymap ) ;
FUNCTION: void rl_tty_unset_default_bindings ( Keymap ) ;
FUNCTION: int rl_reset_terminal ( c-string ) ;
FUNCTION: void rl_resize_terminal ( ) ;
FUNCTION: void rl_set_screen_size ( int arg1, int arg2 ) ;
FUNCTION: void rl_get_screen_size ( int* arg1, int* arg2 ) ;
FUNCTION: void rl_reset_screen_size ( ) ;
FUNCTION: c-string rl_get_termcap ( c-string ) ;
FUNCTION: int rl_stuff_char ( int ) ;
FUNCTION: int rl_execute_next ( int ) ;
FUNCTION: int rl_clear_pending_input ( ) ;
FUNCTION: int rl_read_key ( ) ;
FUNCTION: int rl_getc ( FILE* ) ;
FUNCTION: int rl_set_keyboard_input_timeout ( int ) ;
FUNCTION: void rl_extend_line_buffer ( int ) ;
FUNCTION: int rl_ding ( ) ;
FUNCTION: int rl_alphabetic ( int ) ;
FUNCTION: void rl_free ( void* ) ;
FUNCTION: int rl_set_signals ( ) ;
FUNCTION: int rl_clear_signals ( ) ;
FUNCTION: void rl_cleanup_after_signal ( ) ;
FUNCTION: void rl_reset_after_signal ( ) ;
FUNCTION: void rl_free_line_state ( ) ;
FUNCTION: void rl_echo_signal_char ( int ) ;
FUNCTION: int rl_set_paren_blink_timeout ( int ) ;
FUNCTION: int rl_maybe_save_line ( ) ;
FUNCTION: int rl_maybe_unsave_line ( ) ;
FUNCTION: int rl_maybe_replace_line ( ) ;
FUNCTION: int rl_complete_internal ( int ) ;
FUNCTION: void rl_display_match_list ( char** arg1, int arg2,
int arg3 ) ;
FUNCTION: char** rl_completion_matches ( c-string arg1,
rl_compentry_func_t*
arg2 ) ;
FUNCTION: c-string rl_username_completion_function ( c-string
arg1, int
arg2 ) ;
FUNCTION: c-string rl_filename_completion_function ( c-string
arg1, int
arg2 ) ;
FUNCTION: int rl_completion_mode ( rl_command_func_t* ) ;
C-GLOBAL: c-string rl_library_version
C-GLOBAL: int rl_readline_version
C-GLOBAL: int rl_gnu_readline_p
C-GLOBAL: int rl_readline_state
C-GLOBAL: int rl_editing_mode
C-GLOBAL: int rl_insert_mode
C-GLOBAL: c-string rl_readline_name
C-GLOBAL: c-string rl_prompt
C-GLOBAL: c-string rl_display_prompt
C-GLOBAL: c-string rl_line_buffer
C-GLOBAL: int rl_point
C-GLOBAL: int rl_end
C-GLOBAL: int rl_mark
C-GLOBAL: int rl_done
C-GLOBAL: int rl_pending_input
C-GLOBAL: int rl_dispatching
C-GLOBAL: int rl_explicit_arg
C-GLOBAL: int rl_numeric_arg
C-GLOBAL: rl_command_func_t* rl_last_func
C-GLOBAL: c-string rl_terminal_name
C-GLOBAL: FILE* rl_instream
C-GLOBAL: FILE* rl_outstream
C-GLOBAL: int rl_prefer_env_winsize
C-GLOBAL: rl_hook_func_t* rl_startup_hook
C-GLOBAL: rl_hook_func_t* rl_pre_input_hook
C-GLOBAL: rl_hook_func_t* rl_event_hook
C-GLOBAL: rl_getc_func_t* rl_getc_function
C-GLOBAL: rl_voidfunc_t* rl_redisplay_function
C-GLOBAL: rl_vintfunc_t* rl_prep_term_function
C-GLOBAL: rl_voidfunc_t* rl_deprep_term_function
C-GLOBAL: Keymap rl_executing_keymap
C-GLOBAL: Keymap rl_binding_keymap
C-GLOBAL: int rl_erase_empty_line
C-GLOBAL: int rl_already_prompted
C-GLOBAL: int rl_num_chars_to_read
C-GLOBAL: c-string rl_executing_macro
C-GLOBAL: int rl_catch_signals
C-GLOBAL: int rl_catch_sigwinch
C-GLOBAL: rl_compentry_func_t* rl_completion_entry_function
C-GLOBAL: rl_compentry_func_t* rl_menu_completion_entry_function
C-GLOBAL: rl_compignore_func_t* rl_ignore_some_completions_function
C-GLOBAL: rl_completion_func_t* rl_attempted_completion_function
C-GLOBAL: c-string rl_basic_word_break_characters
C-GLOBAL: c-string rl_completer_word_break_characters
C-GLOBAL: rl_cpvfunc_t* rl_completion_word_break_hook
C-GLOBAL: c-string rl_completer_quote_characters
C-GLOBAL: c-string rl_basic_quote_characters
C-GLOBAL: c-string rl_filename_quote_characters
C-GLOBAL: c-string rl_special_prefixes
C-GLOBAL: rl_icppfunc_t* rl_directory_completion_hook
C-GLOBAL: rl_icppfunc_t* rl_directory_rewrite_hook
C-GLOBAL: rl_dequote_func_t* rl_filename_rewrite_hook
C-GLOBAL: rl_compdisp_func_t* rl_completion_display_matches_hook
C-GLOBAL: int rl_filename_completion_desired
C-GLOBAL: int rl_filename_quoting_desired
C-GLOBAL: rl_quote_func_t* rl_filename_quoting_function
C-GLOBAL: rl_dequote_func_t* rl_filename_dequoting_function
C-GLOBAL: rl_linebuf_func_t* rl_char_is_quoted_p
C-GLOBAL: int rl_attempted_completion_over
C-GLOBAL: int rl_completion_type
C-GLOBAL: int rl_completion_invoking_key
C-GLOBAL: int rl_completion_query_items
C-GLOBAL: int rl_completion_append_character
C-GLOBAL: int rl_completion_suppress_append
C-GLOBAL: int rl_completion_quote_character
C-GLOBAL: int rl_completion_found_quote
C-GLOBAL: int rl_completion_suppress_quote
C-GLOBAL: int rl_sort_completion_matches
C-GLOBAL: int rl_completion_mark_symlink_dirs
C-GLOBAL: int rl_ignore_completion_duplicates
C-GLOBAL: int rl_inhibit_completion
CONSTANT: READERR -2
CONSTANT: RL_PROMPT_START_IGNORE 1
CONSTANT: RL_PROMPT_END_IGNORE 2
CONSTANT: NO_MATCH 0
CONSTANT: SINGLE_MATCH 1
CONSTANT: MULT_MATCH 2
CONSTANT: RL_STATE_NONE HEX: 0000000
CONSTANT: RL_STATE_INITIALIZING HEX: 0000001
CONSTANT: RL_STATE_INITIALIZED HEX: 0000002
CONSTANT: RL_STATE_TERMPREPPED HEX: 0000004
CONSTANT: RL_STATE_READCMD HEX: 0000008
CONSTANT: RL_STATE_METANEXT HEX: 0000010
CONSTANT: RL_STATE_DISPATCHING HEX: 0000020
CONSTANT: RL_STATE_MOREINPUT HEX: 0000040
CONSTANT: RL_STATE_ISEARCH HEX: 0000080
CONSTANT: RL_STATE_NSEARCH HEX: 0000100
CONSTANT: RL_STATE_SEARCH HEX: 0000200
CONSTANT: RL_STATE_NUMERICARG HEX: 0000400
CONSTANT: RL_STATE_MACROINPUT HEX: 0000800
CONSTANT: RL_STATE_MACRODEF HEX: 0001000
CONSTANT: RL_STATE_OVERWRITE HEX: 0002000
CONSTANT: RL_STATE_COMPLETING HEX: 0004000
CONSTANT: RL_STATE_SIGHANDLER HEX: 0008000
CONSTANT: RL_STATE_UNDOING HEX: 0010000
CONSTANT: RL_STATE_INPUTPENDING HEX: 0020000
CONSTANT: RL_STATE_TTYCSAVED HEX: 0040000
CONSTANT: RL_STATE_CALLBACK HEX: 0080000
CONSTANT: RL_STATE_VIMOTION HEX: 0100000
CONSTANT: RL_STATE_MULTIKEY HEX: 0200000
CONSTANT: RL_STATE_VICMDONCE HEX: 0400000
CONSTANT: RL_STATE_REDISPLAYING HEX: 0800000
CONSTANT: RL_STATE_DONE HEX: 1000000
: RL_SETSTATE ( x -- ) rl_readline_state get bitor rl_readline_state set ; inline
: RL_UNSETSTATE ( x -- ) not rl_readline_state get bitand rl_readline_state set ; inline
: RL_ISSTATE ( x -- ? ) rl_readline_state get bitand 0 = not ; inline
STRUCT: readline_state
{ point int }
{ end int }
{ mark int }
{ buffer char* }
{ buflen int }
{ ul UNDO_LIST* }
{ prompt char* }
{ rlstate int }
{ done int }
{ kmap Keymap }
{ lastfunc rl_command_func_t* }
{ insmode int }
{ edmode int }
{ kseqlen int }
{ inf FILE* }
{ outf FILE* }
{ pendingin int }
{ macro char* }
{ catchsigs int }
{ catchsigwinch int }
{ reserved char[64] } ;
FUNCTION: int rl_save_state ( readline_state* ) ;
FUNCTION: int rl_restore_state ( readline_state* ) ;

32
extra/readline/readline-docs.factor Normal file
View File

@ -0,0 +1,32 @@
! Copyright (C) 2011 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays help.markup help.syntax math
sequences.private vectors strings kernel math.order layouts
quotations generic.single ;
IN: readline
HELP: readline
{ $values
{ "prompt" string }
{ "str" string }
}
{ $description "Read a line from using readline." } ;
HELP: set-completion
{ $values
{ "quot" "a quotation with stack effect ( str n -- str )"}
}
{ $description "Set the given quotation as the completion hook for readline. The quotation is called with the string to complete and the index in the completion list to return. When all completions have been returned, returning " { $snippet "f" } " terminates the loop." }
{ $examples
{ $example "USING: readline sequences combinators kernel ;"
"[ nip [ \"keep\" \"dip\" ] ?nth ] set-completion"
""
}
} ;
ARTICLE: "readline" "Readline"
{ $vocab-link "readline" }
;
ABOUT: "readline"

30
extra/readline/readline.factor Normal file
View File

@ -0,0 +1,30 @@
! Copyright (C) 2011 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.strings destructors io.encodings.utf8 kernel libc
sequences macros quotations words compiler.units fry
alien.data alien.libraries ;
QUALIFIED: readline.ffi
IN: readline
: readline ( prompt -- str )
[
readline.ffi:readline [
|free utf8 alien>string [
[ ] [ readline.ffi:add_history ] if-empty
] keep
] [ f ] if*
] with-destructors ;
: current-line ( -- str )
readline.ffi:rl_line_buffer ;
: has-readline ( -- ? )
"readline" dup load-library dlsym-raw >boolean ;
MACRO: set-completion ( quot -- )
[
'[ @ [ utf8 malloc-string ] [ f ] if* ]
'[ _ readline.ffi:rl_compentry_func_t ]
(( -- alien )) define-temp
] with-compilation-unit execute
'[ _ readline.ffi:set-rl_completion_entry_function ] ;

1
extra/readline/summary.txt Normal file
View File

@ -0,0 +1 @@
libreadline bindings

1
extra/readline/tags.txt Normal file
View File

@ -0,0 +1 @@
bindings

1
unmaintained/ppc/authors.txt
View File

@ -1 +0,0 @@
Slava Pestov

839
unmaintained/ppc/bootstrap.factor
View File

@ -1,839 +0,0 @@
! Copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel kernel.private namespaces
system cpu.ppc.assembler compiler.units compiler.constants math
math.private math.ranges layouts words vocabs slots.private
locals locals.backend generic.single.private fry sequences
threads.private strings.private ;
FROM: cpu.ppc.assembler => B ;
IN: bootstrap.ppc
4 \ cell set
big-endian on
CONSTANT: ds-reg 13
CONSTANT: rs-reg 14
CONSTANT: vm-reg 15
CONSTANT: ctx-reg 16
CONSTANT: nv-reg 17
: jit-call ( string -- )
0 2 LOAD32 rc-absolute-ppc-2/2 jit-dlsym
2 MTLR
BLRL ;
: jit-call-quot ( -- )
4 3 quot-entry-point-offset LWZ
4 MTLR
BLRL ;
: jit-jump-quot ( -- )
4 3 quot-entry-point-offset LWZ
4 MTCTR
BCTR ;
: factor-area-size ( -- n ) 16 ;
: stack-frame ( -- n )
reserved-size
factor-area-size +
16 align ;
: next-save ( -- n ) stack-frame 4 - ;
: xt-save ( -- n ) stack-frame 8 - ;
: param-size ( -- n ) 32 ;
: save-at ( m -- n ) reserved-size + param-size + ;
: save-int ( register offset -- ) [ 1 ] dip save-at STW ;
: restore-int ( register offset -- ) [ 1 ] dip save-at LWZ ;
: save-fp ( register offset -- ) [ 1 ] dip save-at STFD ;
: restore-fp ( register offset -- ) [ 1 ] dip save-at LFD ;
: save-vec ( register offset -- ) save-at 2 LI 2 1 STVXL ;
: restore-vec ( register offset -- ) save-at 2 LI 2 1 LVXL ;
: nv-int-regs ( -- seq ) 13 31 [a,b] ;
: nv-fp-regs ( -- seq ) 14 31 [a,b] ;
: nv-vec-regs ( -- seq ) 20 31 [a,b] ;
: saved-int-regs-size ( -- n ) 96 ;
: saved-fp-regs-size ( -- n ) 144 ;
: saved-vec-regs-size ( -- n ) 208 ;
: callback-frame-size ( -- n )
reserved-size
param-size +
saved-int-regs-size +
saved-fp-regs-size +
saved-vec-regs-size +
4 +
16 align ;
: old-context-save-offset ( -- n )
432 save-at ;
[
! Save old stack pointer
11 1 MR
! Create stack frame
0 MFLR
1 1 callback-frame-size SUBI
0 1 callback-frame-size lr-save + STW
! Save all non-volatile registers
nv-int-regs [ 4 * save-int ] each-index
nv-fp-regs [ 8 * 80 + save-fp ] each-index
nv-vec-regs [ 16 * 224 + save-vec ] each-index
! Stick old stack pointer in a non-volatile register so that
! callbacks can access their arguments
nv-reg 11 MR
! Load VM into vm-reg
0 vm-reg LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel
! Save old context
2 vm-reg vm-context-offset LWZ
2 1 old-context-save-offset STW
! Switch over to the spare context
2 vm-reg vm-spare-context-offset LWZ
2 vm-reg vm-context-offset STW
! Save C callstack pointer
1 2 context-callstack-save-offset STW
! Load Factor callstack pointer
1 2 context-callstack-bottom-offset LWZ
! Call into Factor code
0 2 LOAD32 rc-absolute-ppc-2/2 rt-entry-point jit-rel
2 MTLR
BLRL
! Load VM again, pointlessly
0 vm-reg LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel
! Load C callstack pointer
2 vm-reg vm-context-offset LWZ
1 2 context-callstack-save-offset LWZ
! Load old context
2 1 old-context-save-offset LWZ
2 vm-reg vm-context-offset STW
! Restore non-volatile registers
nv-vec-regs [ 16 * 224 + restore-vec ] each-index
nv-fp-regs [ 8 * 80 + restore-fp ] each-index
nv-int-regs [ 4 * restore-int ] each-index
! Tear down stack frame and return
0 1 callback-frame-size lr-save + LWZ
1 1 callback-frame-size ADDI
0 MTLR
BLR
] callback-stub jit-define
: jit-conditional* ( test-quot false-quot -- )
[ '[ 4 /i 1 + @ ] ] dip jit-conditional ; inline
: jit-load-context ( -- )
ctx-reg vm-reg vm-context-offset LWZ ;
: jit-save-context ( -- )
jit-load-context
1 ctx-reg context-callstack-top-offset STW
ds-reg ctx-reg context-datastack-offset STW
rs-reg ctx-reg context-retainstack-offset STW ;
: jit-restore-context ( -- )
ds-reg ctx-reg context-datastack-offset LWZ
rs-reg ctx-reg context-retainstack-offset LWZ ;
[
0 12 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
11 12 profile-count-offset LWZ
11 11 1 tag-fixnum ADDI
11 12 profile-count-offset STW
11 12 word-code-offset LWZ
11 11 compiled-header-size ADDI
11 MTCTR
BCTR
] jit-profiling jit-define
[
0 2 LOAD32 rc-absolute-ppc-2/2 rt-this jit-rel
0 MFLR
1 1 stack-frame SUBI
2 1 xt-save STW
stack-frame 2 LI
2 1 next-save STW
0 1 lr-save stack-frame + STW
] jit-prolog jit-define
[
0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
3 ds-reg 4 STWU
] jit-push jit-define
[
jit-save-context
3 vm-reg MR
0 4 LOAD32 rc-absolute-ppc-2/2 rt-dlsym jit-rel
4 MTLR
BLRL
jit-restore-context
] jit-primitive jit-define
[ 0 BL rc-relative-ppc-3 rt-entry-point-pic jit-rel ] jit-word-call jit-define
[
0 6 LOAD32 rc-absolute-ppc-2/2 rt-here jit-rel
0 B rc-relative-ppc-3 rt-entry-point-pic-tail jit-rel
] jit-word-jump jit-define
[
3 ds-reg 0 LWZ
ds-reg dup 4 SUBI
0 3 \ f type-number CMPI
[ BEQ ] [ 0 B rc-relative-ppc-3 rt-entry-point jit-rel ] jit-conditional*
0 B rc-relative-ppc-3 rt-entry-point jit-rel
] jit-if jit-define
: jit->r ( -- )
4 ds-reg 0 LWZ
ds-reg dup 4 SUBI
4 rs-reg 4 STWU ;
: jit-2>r ( -- )
4 ds-reg 0 LWZ
5 ds-reg -4 LWZ
ds-reg dup 8 SUBI
rs-reg dup 8 ADDI
4 rs-reg 0 STW
5 rs-reg -4 STW ;
: jit-3>r ( -- )
4 ds-reg 0 LWZ
5 ds-reg -4 LWZ
6 ds-reg -8 LWZ
ds-reg dup 12 SUBI
rs-reg dup 12 ADDI
4 rs-reg 0 STW
5 rs-reg -4 STW
6 rs-reg -8 STW ;
: jit-r> ( -- )
4 rs-reg 0 LWZ
rs-reg dup 4 SUBI
4 ds-reg 4 STWU ;
: jit-2r> ( -- )
4 rs-reg 0 LWZ
5 rs-reg -4 LWZ
rs-reg dup 8 SUBI
ds-reg dup 8 ADDI
4 ds-reg 0 STW
5 ds-reg -4 STW ;
: jit-3r> ( -- )
4 rs-reg 0 LWZ
5 rs-reg -4 LWZ
6 rs-reg -8 LWZ
rs-reg dup 12 SUBI
ds-reg dup 12 ADDI
4 ds-reg 0 STW
5 ds-reg -4 STW
6 ds-reg -8 STW ;
[
jit->r
0 BL rc-relative-ppc-3 rt-entry-point jit-rel
jit-r>
] jit-dip jit-define
[
jit-2>r
0 BL rc-relative-ppc-3 rt-entry-point jit-rel
jit-2r>
] jit-2dip jit-define
[
jit-3>r
0 BL rc-relative-ppc-3 rt-entry-point jit-rel
jit-3r>
] jit-3dip jit-define
[
0 1 lr-save stack-frame + LWZ
1 1 stack-frame ADDI
0 MTLR
] jit-epilog jit-define
[ BLR ] jit-return jit-define
! ! ! Polymorphic inline caches
! Don't touch r6 here; it's used to pass the tail call site
! address for tail PICs
! Load a value from a stack position
[
4 ds-reg 0 LWZ rc-absolute-ppc-2 rt-untagged jit-rel
] pic-load jit-define
[ 4 4 tag-mask get ANDI ] pic-tag jit-define
[
3 4 MR
4 4 tag-mask get ANDI
0 4 tuple type-number CMPI
[ BNE ]
[ 4 3 tuple-class-offset LWZ ]
jit-conditional*
] pic-tuple jit-define
[
0 4 0 CMPI rc-absolute-ppc-2 rt-untagged jit-rel
] pic-check-tag jit-define
[
0 5 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
4 0 5 CMP
] pic-check-tuple jit-define
[
[ BNE ] [ 0 B rc-relative-ppc-3 rt-entry-point jit-rel ] jit-conditional*
] pic-hit jit-define
! Inline cache miss entry points
: jit-load-return-address ( -- ) 6 MFLR ;
! These are always in tail position with an existing stack
! frame, and the stack. The frame setup takes this into account.
: jit-inline-cache-miss ( -- )
jit-save-context
3 6 MR
4 vm-reg MR
"inline_cache_miss" jit-call
jit-load-context
jit-restore-context ;
[ jit-load-return-address jit-inline-cache-miss ]
[ 3 MTLR BLRL ]
[ 3 MTCTR BCTR ]
\ inline-cache-miss define-combinator-primitive
[ jit-inline-cache-miss ]
[ 3 MTLR BLRL ]
[ 3 MTCTR BCTR ]
\ inline-cache-miss-tail define-combinator-primitive
! ! ! Megamorphic caches
[
! class = ...
3 4 MR
4 4 tag-mask get ANDI
4 4 tag-bits get SLWI
0 4 tuple type-number tag-fixnum CMPI
[ BNE ]
[ 4 3 tuple-class-offset LWZ ]
jit-conditional*
! cache = ...
0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
! key = hashcode(class)
5 4 1 SRAWI
! key &= cache.length - 1
5 5 mega-cache-size get 1 - 4 * ANDI
! cache += array-start-offset
3 3 array-start-offset ADDI
! cache += key
3 3 5 ADD
! if(get(cache) == class)
6 3 0 LWZ
6 0 4 CMP
[ BNE ]
[
! megamorphic_cache_hits++
0 4 LOAD32 rc-absolute-ppc-2/2 rt-megamorphic-cache-hits jit-rel
5 4 0 LWZ
5 5 1 ADDI
5 4 0 STW
! ... goto get(cache + 4)
3 3 4 LWZ
3 3 word-entry-point-offset LWZ
3 MTCTR
BCTR
]
jit-conditional*
! fall-through on miss
] mega-lookup jit-define
! ! ! Sub-primitives
! Quotations and words
[
3 ds-reg 0 LWZ
ds-reg dup 4 SUBI
]
[ jit-call-quot ]
[ jit-jump-quot ] \ (call) define-combinator-primitive
[
3 ds-reg 0 LWZ
ds-reg dup 4 SUBI
4 3 word-entry-point-offset LWZ
]
[ 4 MTLR BLRL ]
[ 4 MTCTR BCTR ] \ (execute) define-combinator-primitive
[
3 ds-reg 0 LWZ
ds-reg dup 4 SUBI
4 3 word-entry-point-offset LWZ
4 MTCTR BCTR
] jit-execute jit-define
! Special primitives
[
nv-reg 3 MR
3 vm-reg MR
"begin_callback" jit-call
jit-load-context
jit-restore-context
! Call quotation
3 nv-reg MR
jit-call-quot
jit-save-context
3 vm-reg MR
"end_callback" jit-call
] \ c-to-factor define-sub-primitive
[
! Unwind stack frames
1 4 MR
! Load VM pointer into vm-reg, since we're entering from
! C code
0 vm-reg LOAD32 0 rc-absolute-ppc-2/2 jit-vm
! Load ds and rs registers
jit-load-context
jit-restore-context
! We have changed the stack; load return address again
0 1 lr-save LWZ
0 MTLR
! Call quotation
jit-call-quot
] \ unwind-native-frames define-sub-primitive
[
! Load callstack object
6 ds-reg 0 LWZ
ds-reg ds-reg 4 SUBI
! Get ctx->callstack_bottom
jit-load-context
3 ctx-reg context-callstack-bottom-offset LWZ
! Get top of callstack object -- 'src' for memcpy
4 6 callstack-top-offset ADDI
! Get callstack length, in bytes --- 'len' for memcpy
5 6 callstack-length-offset LWZ
5 5 tag-bits get SRAWI
! Compute new stack pointer -- 'dst' for memcpy
3 5 3 SUBF
! Install new stack pointer
1 3 MR
! Call memcpy; arguments are now in the correct registers
1 1 -64 STWU
"factor_memcpy" jit-call
1 1 0 LWZ
! Return with new callstack
0 1 lr-save LWZ
0 MTLR
BLR
] \ set-callstack define-sub-primitive
[
jit-save-context
4 vm-reg MR
"lazy_jit_compile" jit-call
]
[ jit-call-quot ]
[ jit-jump-quot ]
\ lazy-jit-compile define-combinator-primitive
! Objects
[
3 ds-reg 0 LWZ
3 3 tag-mask get ANDI
3 3 tag-bits get SLWI
3 ds-reg 0 STW
] \ tag define-sub-primitive
[
3 ds-reg 0 LWZ
4 ds-reg -4 LWZU
3 3 2 SRAWI
4 4 0 0 31 tag-bits get - RLWINM
4 3 3 LWZX
3 ds-reg 0 STW
] \ slot define-sub-primitive
[
! load string index from stack
3 ds-reg -4 LWZ
3 3 tag-bits get SRAWI
! load string from stack
4 ds-reg 0 LWZ
! load character
4 4 string-offset ADDI
3 3 4 LBZX
3 3 tag-bits get SLWI
! store character to stack
ds-reg ds-reg 4 SUBI
3 ds-reg 0 STW
] \ string-nth-fast define-sub-primitive
! Shufflers
[
ds-reg dup 4 SUBI
] \ drop define-sub-primitive
[
ds-reg dup 8 SUBI
] \ 2drop define-sub-primitive
[
ds-reg dup 12 SUBI
] \ 3drop define-sub-primitive
[
3 ds-reg 0 LWZ
3 ds-reg 4 STWU
] \ dup define-sub-primitive
[
3 ds-reg 0 LWZ
4 ds-reg -4 LWZ
ds-reg dup 8 ADDI
3 ds-reg 0 STW
4 ds-reg -4 STW
] \ 2dup define-sub-primitive
[
3 ds-reg 0 LWZ
4 ds-reg -4 LWZ
5 ds-reg -8 LWZ
ds-reg dup 12 ADDI
3 ds-reg 0 STW
4 ds-reg -4 STW
5 ds-reg -8 STW
] \ 3dup define-sub-primitive
[
3 ds-reg 0 LWZ
ds-reg dup 4 SUBI
3 ds-reg 0 STW
] \ nip define-sub-primitive
[
3 ds-reg 0 LWZ
ds-reg dup 8 SUBI
3 ds-reg 0 STW
] \ 2nip define-sub-primitive
[
3 ds-reg -4 LWZ
3 ds-reg 4 STWU
] \ over define-sub-primitive
[
3 ds-reg -8 LWZ
3 ds-reg 4 STWU
] \ pick define-sub-primitive
[
3 ds-reg 0 LWZ
4 ds-reg -4 LWZ
4 ds-reg 0 STW
3 ds-reg 4 STWU
] \ dupd define-sub-primitive
[
3 ds-reg 0 LWZ
4 ds-reg -4 LWZ
3 ds-reg -4 STW
4 ds-reg 0 STW
] \ swap define-sub-primitive
[
3 ds-reg -4 LWZ
4 ds-reg -8 LWZ
3 ds-reg -8 STW
4 ds-reg -4 STW
] \ swapd define-sub-primitive
[
3 ds-reg 0 LWZ
4 ds-reg -4 LWZ
5 ds-reg -8 LWZ
4 ds-reg -8 STW
3 ds-reg -4 STW
5 ds-reg 0 STW
] \ rot define-sub-primitive
[
3 ds-reg 0 LWZ
4 ds-reg -4 LWZ
5 ds-reg -8 LWZ
3 ds-reg -8 STW
5 ds-reg -4 STW
4 ds-reg 0 STW
] \ -rot define-sub-primitive
[ jit->r ] \ load-local define-sub-primitive
! Comparisons
: jit-compare ( insn -- )
t jit-literal
0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
4 ds-reg 0 LWZ
5 ds-reg -4 LWZU
5 0 4 CMP
2 swap execute( offset -- ) ! magic number
\ f type-number 3 LI
3 ds-reg 0 STW ;
: define-jit-compare ( insn word -- )
[ [ jit-compare ] curry ] dip define-sub-primitive ;
\ BEQ \ eq? define-jit-compare
\ BGE \ fixnum>= define-jit-compare
\ BLE \ fixnum<= define-jit-compare
\ BGT \ fixnum> define-jit-compare
\ BLT \ fixnum< define-jit-compare
! Math
[
3 ds-reg 0 LWZ
ds-reg ds-reg 4 SUBI
4 ds-reg 0 LWZ
3 3 4 OR
3 3 tag-mask get ANDI
\ f type-number 4 LI
0 3 0 CMPI
[ BNE ] [ 1 tag-fixnum 4 LI ] jit-conditional*
4 ds-reg 0 STW
] \ both-fixnums? define-sub-primitive
: jit-math ( insn -- )
3 ds-reg 0 LWZ
4 ds-reg -4 LWZU
[ 5 3 4 ] dip execute( dst src1 src2 -- )
5 ds-reg 0 STW ;
[ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
[ \ SUBF jit-math ] \ fixnum-fast define-sub-primitive
[
3 ds-reg 0 LWZ
4 ds-reg -4 LWZU
4 4 tag-bits get SRAWI
5 3 4 MULLW
5 ds-reg 0 STW
] \ fixnum*fast define-sub-primitive
[ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
[ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
[ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
[
3 ds-reg 0 LWZ
3 3 NOT
3 3 tag-mask get XORI
3 ds-reg 0 STW
] \ fixnum-bitnot define-sub-primitive
[
3 ds-reg 0 LWZ
3 3 tag-bits get SRAWI
ds-reg ds-reg 4 SUBI
4 ds-reg 0 LWZ
5 4 3 SLW
6 3 NEG
7 4 6 SRAW
7 7 0 0 31 tag-bits get - RLWINM
0 3 0 CMPI
[ BGT ] [ 5 7 MR ] jit-conditional*
5 ds-reg 0 STW
] \ fixnum-shift-fast define-sub-primitive
[
3 ds-reg 0 LWZ
ds-reg ds-reg 4 SUBI
4 ds-reg 0 LWZ
5 4 3 DIVW
6 5 3 MULLW
7 6 4 SUBF
7 ds-reg 0 STW
] \ fixnum-mod define-sub-primitive
[
3 ds-reg 0 LWZ
ds-reg ds-reg 4 SUBI
4 ds-reg 0 LWZ
5 4 3 DIVW
5 5 tag-bits get SLWI
5 ds-reg 0 STW
] \ fixnum/i-fast define-sub-primitive
[
3 ds-reg 0 LWZ
4 ds-reg -4 LWZ
5 4 3 DIVW
6 5 3 MULLW
7 6 4 SUBF
5 5 tag-bits get SLWI
5 ds-reg -4 STW
7 ds-reg 0 STW
] \ fixnum/mod-fast define-sub-primitive
[
3 ds-reg 0 LWZ
3 3 2 SRAWI
rs-reg 3 3 LWZX
3 ds-reg 0 STW
] \ get-local define-sub-primitive
[
3 ds-reg 0 LWZ
ds-reg ds-reg 4 SUBI
3 3 2 SRAWI
rs-reg 3 rs-reg SUBF
] \ drop-locals define-sub-primitive
! Overflowing fixnum arithmetic
:: jit-overflow ( insn func -- )
ds-reg ds-reg 4 SUBI
jit-save-context
3 ds-reg 0 LWZ
4 ds-reg 4 LWZ
0 0 LI
0 MTXER
6 4 3 insn call( d a s -- )
6 ds-reg 0 STW
[ BNO ]
[
5 vm-reg MR
func jit-call
]
jit-conditional* ;
[ [ ADDO. ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
[ [ SUBFO. ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
[
ds-reg ds-reg 4 SUBI
jit-save-context
3 ds-reg 0 LWZ
3 3 tag-bits get SRAWI
4 ds-reg 4 LWZ
0 0 LI
0 MTXER
6 3 4 MULLWO.
6 ds-reg 0 STW
[ BNO ]
[
4 4 tag-bits get SRAWI
5 vm-reg MR
"overflow_fixnum_multiply" jit-call
]
jit-conditional*
] \ fixnum* define-sub-primitive
! Contexts
: jit-switch-context ( reg -- )
! Save ds, rs registers
jit-save-context
! Make the new context the current one
ctx-reg swap MR
ctx-reg vm-reg vm-context-offset STW
! Load new stack pointer
1 ctx-reg context-callstack-top-offset LWZ
! Load new ds, rs registers
jit-restore-context ;
: jit-pop-context-and-param ( -- )
3 ds-reg 0 LWZ
3 3 alien-offset LWZ
4 ds-reg -4 LWZ
ds-reg ds-reg 8 SUBI ;
: jit-push-param ( -- )
ds-reg ds-reg 4 ADDI
4 ds-reg 0 STW ;
: jit-set-context ( -- )
jit-pop-context-and-param
3 jit-switch-context
jit-push-param ;
[ jit-set-context ] \ (set-context) define-sub-primitive
: jit-pop-quot-and-param ( -- )
3 ds-reg 0 LWZ
4 ds-reg -4 LWZ
ds-reg ds-reg 8 SUBI ;
: jit-start-context ( -- )
! Create the new context in return-reg
3 vm-reg MR
"new_context" jit-call
6 3 MR
jit-pop-quot-and-param
6 jit-switch-context
jit-push-param
jit-jump-quot ;
[ jit-start-context ] \ (start-context) define-sub-primitive
: jit-delete-current-context ( -- )
jit-load-context
3 vm-reg MR
4 ctx-reg MR
"delete_context" jit-call ;
[
jit-delete-current-context
jit-set-context
] \ (set-context-and-delete) define-sub-primitive
[
jit-delete-current-context
jit-start-context
] \ (start-context-and-delete) define-sub-primitive
[ "bootstrap.ppc" forget-vocab ] with-compilation-unit

10
unmaintained/ppc/linux/bootstrap.factor
View File

@ -1,10 +0,0 @@
! Copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: parser system kernel sequences ;
IN: bootstrap.ppc
: reserved-size ( -- n ) 24 ;
: lr-save ( -- n ) 4 ;
<< "vocab:cpu/ppc/bootstrap.factor" parse-file suffix! >>
call

28
unmaintained/ppc/linux/linux.factor
View File

@ -1,28 +0,0 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors system kernel layouts
alien.c-types cpu.architecture cpu.ppc ;
IN: cpu.ppc.linux
<<
t "longlong" c-type stack-align?<<
t "ulonglong" c-type stack-align?<<
>>
M: linux reserved-area-size 2 cells ;
M: linux lr-save 1 cells ;
M: ppc param-regs
drop {
{ int-regs { 3 4 5 6 7 8 9 10 } }
{ float-regs { 1 2 3 4 5 6 7 8 } }
} ;
M: ppc value-struct? drop f ;
M: ppc dummy-stack-params? f ;
M: ppc dummy-int-params? f ;
M: ppc dummy-fp-params? f ;

1
unmaintained/ppc/linux/summary.txt
View File

@ -1 +0,0 @@
Linux/PPC ABI support

1
unmaintained/ppc/linux/tags.txt
View File

@ -1 +0,0 @@
not loaded

10
unmaintained/ppc/macosx/bootstrap.factor
View File

@ -1,10 +0,0 @@
! Copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: parser system kernel sequences ;
IN: bootstrap.ppc
: reserved-size ( -- n ) 24 ;
: lr-save ( -- n ) 8 ;
<< "vocab:cpu/ppc/bootstrap.factor" parse-file suffix! >>
call

23
unmaintained/ppc/macosx/macosx.factor
View File

@ -1,23 +0,0 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors system kernel layouts
alien.c-types cpu.architecture cpu.ppc ;
IN: cpu.ppc.macosx
M: macosx reserved-area-size 6 cells ;
M: macosx lr-save 2 cells ;
M: ppc param-regs
drop {
{ int-regs { 3 4 5 6 7 8 9 10 } }
{ float-regs { 1 2 3 4 5 6 7 8 9 10 11 12 13 } }
} ;
M: ppc value-struct? drop t ;
M: ppc dummy-stack-params? t ;
M: ppc dummy-int-params? t ;
M: ppc dummy-fp-params? f ;

1
unmaintained/ppc/macosx/summary.txt
View File

@ -1 +0,0 @@
Mac OS X/PPC ABI support

1
unmaintained/ppc/macosx/tags.txt
View File

@ -1 +0,0 @@
not loaded

826
unmaintained/ppc/ppc.factor
View File

@ -1,826 +0,0 @@
! Copyright (C) 2005, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs sequences kernel combinators
classes.algebra byte-arrays make math math.order math.ranges
system namespaces locals layouts words alien alien.accessors
alien.c-types alien.complex alien.data alien.libraries
literals cpu.architecture cpu.ppc.assembler cpu.ppc.assembler.backend
compiler.cfg.registers compiler.cfg.instructions
compiler.cfg.comparisons compiler.codegen.fixup
compiler.cfg.intrinsics compiler.cfg.stack-frame
compiler.cfg.build-stack-frame compiler.units compiler.constants
compiler.codegen vm ;
QUALIFIED-WITH: alien.c-types c
FROM: cpu.ppc.assembler => B ;
FROM: layouts => cell ;
FROM: math => float ;
IN: cpu.ppc
! PowerPC register assignments:
! r2-r12: integer vregs
! r13: data stack
! r14: retain stack
! r15: VM pointer
! r16-r29: integer vregs
! r30: integer scratch
! f0-f29: float vregs
! f30: float scratch
! Add some methods to the assembler that are useful to us
M: label (B) [ 0 ] 2dip (B) rc-relative-ppc-3 label-fixup ;
M: label BC [ 0 BC ] dip rc-relative-ppc-2 label-fixup ;
enable-float-intrinsics
M: ppc machine-registers
{
{ int-regs $[ 2 12 [a,b] 16 29 [a,b] append ] }
{ float-regs $[ 0 29 [a,b] ] }
} ;
CONSTANT: scratch-reg 30
CONSTANT: fp-scratch-reg 30
M: ppc complex-addressing? f ;
M: ppc fused-unboxing? f ;
M: ppc %load-immediate ( reg n -- ) swap LOAD ;
M: ppc %load-reference ( reg obj -- )
[ [ 0 swap LOAD32 ] [ rc-absolute-ppc-2/2 rel-literal ] bi* ]
[ \ f type-number swap LI ]
if* ;
M: ppc %alien-global ( register symbol dll -- )
[ 0 swap LOAD32 ] 2dip rc-absolute-ppc-2/2 rel-dlsym ;
CONSTANT: ds-reg 13
CONSTANT: rs-reg 14
CONSTANT: vm-reg 15
: %load-vm-addr ( reg -- ) vm-reg MR ;
M: ppc %vm-field ( dst field -- ) [ vm-reg ] dip LWZ ;
M: ppc %set-vm-field ( src field -- ) [ vm-reg ] dip STW ;
GENERIC: loc-reg ( loc -- reg )
M: ds-loc loc-reg drop ds-reg ;
M: rs-loc loc-reg drop rs-reg ;
: loc>operand ( loc -- reg n )
[ loc-reg ] [ n>> cells neg ] bi ; inline
M: ppc %peek loc>operand LWZ ;
M: ppc %replace loc>operand STW ;
:: (%inc) ( n reg -- ) reg reg n cells ADDI ; inline
M: ppc %inc-d ( n -- ) ds-reg (%inc) ;
M: ppc %inc-r ( n -- ) rs-reg (%inc) ;
HOOK: reserved-area-size os ( -- n )
! The start of the stack frame contains the size of this frame
! as well as the currently executing code block
: factor-area-size ( -- n ) 2 cells ; foldable
: next-save ( n -- i ) cell - ; foldable
: xt-save ( n -- i ) 2 cells - ; foldable
! Next, we have the spill area as well as the FFI parameter area.
! It is safe for them to overlap, since basic blocks with FFI calls
! will never spill -- indeed, basic blocks with FFI calls do not
! use vregs at all, and the FFI call is a stack analysis sync point.
! In the future this will change and the stack frame logic will
! need to be untangled somewhat.
: param@ ( n -- x ) reserved-area-size + ; inline
: param-save-size ( -- n ) 8 cells ; foldable
: local@ ( n -- x )
reserved-area-size param-save-size + + ; inline
: spill@ ( n -- offset )
spill-offset local@ ;
! Some FP intrinsics need a temporary scratch area in the stack
! frame, 8 bytes in size. This is in the param-save area so it
! does not overlap with spill slots.
: scratch@ ( n -- offset )
factor-area-size + ;
! Finally we have the linkage area
HOOK: lr-save os ( -- n )
M: ppc stack-frame-size ( stack-frame -- i )
(stack-frame-size)
param-save-size +
reserved-area-size +
factor-area-size +
4 cells align ;
M: ppc %call ( word -- ) 0 BL rc-relative-ppc-3 rel-word-pic ;
M: ppc %jump ( word -- )
0 6 LOAD32 4 rc-absolute-ppc-2/2 rel-here
0 B rc-relative-ppc-3 rel-word-pic-tail ;
M: ppc %jump-label ( label -- ) B ;
M: ppc %return ( -- ) BLR ;
M:: ppc %dispatch ( src temp -- )
0 temp LOAD32
3 cells rc-absolute-ppc-2/2 rel-here
temp temp src LWZX
temp MTCTR
BCTR ;
: (%slot) ( dst obj slot scale tag -- obj dst slot )
[ 0 assert= ] bi@ swapd ;
M: ppc %slot ( dst obj slot scale tag -- ) (%slot) LWZX ;
M: ppc %slot-imm ( dst obj slot tag -- ) slot-offset LWZ ;
M: ppc %set-slot ( src obj slot scale tag -- ) (%slot) STWX ;
M: ppc %set-slot-imm ( src obj slot tag -- ) slot-offset STW ;
M: ppc %add ADD ;
M: ppc %add-imm ADDI ;
M: ppc %sub swap SUBF ;
M: ppc %sub-imm SUBI ;
M: ppc %mul MULLW ;
M: ppc %mul-imm MULLI ;
M: ppc %and AND ;
M: ppc %and-imm ANDI ;
M: ppc %or OR ;
M: ppc %or-imm ORI ;
M: ppc %xor XOR ;
M: ppc %xor-imm XORI ;
M: ppc %shl SLW ;
M: ppc %shl-imm swapd SLWI ;
M: ppc %shr SRW ;
M: ppc %shr-imm swapd SRWI ;
M: ppc %sar SRAW ;
M: ppc %sar-imm SRAWI ;
M: ppc %not NOT ;
M: ppc %neg NEG ;
:: overflow-template ( label dst src1 src2 cc insn -- )
0 0 LI
0 MTXER
dst src2 src1 insn call
cc {
{ cc-o [ label BO ] }
{ cc/o [ label BNO ] }
} case ; inline
M: ppc %fixnum-add ( label dst src1 src2 cc -- )
[ ADDO. ] overflow-template ;
M: ppc %fixnum-sub ( label dst src1 src2 cc -- )
[ SUBFO. ] overflow-template ;
M: ppc %fixnum-mul ( label dst src1 src2 cc -- )
[ MULLWO. ] overflow-template ;
M: ppc %add-float FADD ;
M: ppc %sub-float FSUB ;
M: ppc %mul-float FMUL ;
M: ppc %div-float FDIV ;
M: ppc integer-float-needs-stack-frame? t ;
M:: ppc %integer>float ( dst src -- )
HEX: 4330 scratch-reg LIS
scratch-reg 1 0 scratch@ STW
scratch-reg src MR
scratch-reg dup HEX: 8000 XORIS
scratch-reg 1 4 scratch@ STW
dst 1 0 scratch@ LFD
scratch-reg 4503601774854144.0 %load-reference
fp-scratch-reg scratch-reg float-offset LFD
dst dst fp-scratch-reg FSUB ;
M:: ppc %float>integer ( dst src -- )
fp-scratch-reg src FCTIWZ
fp-scratch-reg 1 0 scratch@ STFD
dst 1 4 scratch@ LWZ ;
M: ppc %copy ( dst src rep -- )
2over eq? [ 3drop ] [
{
{ tagged-rep [ MR ] }
{ int-rep [ MR ] }
{ double-rep [ FMR ] }
} case
] if ;
GENERIC: float-function-param* ( dst src -- )
M: spill-slot float-function-param* [ 1 ] dip n>> spill@ LFD ;
M: integer float-function-param* FMR ;
: float-function-param ( i src -- )
[ float-regs cdecl param-regs at nth ] dip float-function-param* ;
: float-function-return ( reg -- )
float-regs return-regs at first double-rep %copy ;
M:: ppc %unary-float-function ( dst src func -- )
0 src float-function-param
func f %c-invoke
dst float-function-return ;
M:: ppc %binary-float-function ( dst src1 src2 func -- )
0 src1 float-function-param
1 src2 float-function-param
func f %c-invoke
dst float-function-return ;
! Internal format is always double-precision on PowerPC
M: ppc %single>double-float double-rep %copy ;
M: ppc %double>single-float FRSP ;
M: ppc %unbox-alien ( dst src -- )
alien-offset LWZ ;
M:: ppc %unbox-any-c-ptr ( dst src -- )
[
"end" define-label
0 dst LI
! Is the object f?
0 src \ f type-number CMPI
"end" get BEQ
! Compute tag in dst register
dst src tag-mask get ANDI
! Is the object an alien?
0 dst alien type-number CMPI
! Add an offset to start of byte array's data
dst src byte-array-offset ADDI
"end" get BNE
! If so, load the offset and add it to the address
dst src alien-offset LWZ
"end" resolve-label
] with-scope ;
: alien@ ( n -- n' ) cells alien type-number - ;
M:: ppc %box-alien ( dst src temp -- )
[
"f" define-label
dst \ f type-number %load-immediate
0 src 0 CMPI
"f" get BEQ
dst 5 cells alien temp %allot
temp \ f type-number %load-immediate
temp dst 1 alien@ STW
temp dst 2 alien@ STW
src dst 3 alien@ STW
src dst 4 alien@ STW
"f" resolve-label
] with-scope ;
:: %box-displaced-alien/f ( dst displacement base -- )
base dst 1 alien@ STW
displacement dst 3 alien@ STW
displacement dst 4 alien@ STW ;
:: %box-displaced-alien/alien ( dst displacement base temp -- )
! Set new alien's base to base.base
temp base 1 alien@ LWZ
temp dst 1 alien@ STW
! Compute displacement
temp base 3 alien@ LWZ
temp temp displacement ADD
temp dst 3 alien@ STW
! Compute address
temp base 4 alien@ LWZ
temp temp displacement ADD
temp dst 4 alien@ STW ;
:: %box-displaced-alien/byte-array ( dst displacement base temp -- )
base dst 1 alien@ STW
displacement dst 3 alien@ STW
temp base byte-array-offset ADDI
temp temp displacement ADD
temp dst 4 alien@ STW ;
:: %box-displaced-alien/dynamic ( dst displacement base temp -- )
"not-f" define-label
"not-alien" define-label
! Is base f?
0 base \ f type-number CMPI
"not-f" get BNE
! Yes, it is f. Fill in new object
dst displacement base %box-displaced-alien/f
"end" get B
"not-f" resolve-label
! Check base type
temp base tag-mask get ANDI
! Is base an alien?
0 temp alien type-number CMPI
"not-alien" get BNE
dst displacement base temp %box-displaced-alien/alien
! We are done
"end" get B
! Is base a byte array? It has to be, by now...
"not-alien" resolve-label
dst displacement base temp %box-displaced-alien/byte-array ;
M:: ppc %box-displaced-alien ( dst displacement base temp base-class -- )
! This is ridiculous
[
"end" define-label
! If displacement is zero, return the base
dst base MR
0 displacement 0 CMPI
"end" get BEQ
! Displacement is non-zero, we're going to be allocating a new
! object
dst 5 cells alien temp %allot
! Set expired to f
temp \ f type-number %load-immediate
temp dst 2 alien@ STW
dst displacement base temp
{
{ [ base-class \ f class<= ] [ drop %box-displaced-alien/f ] }
{ [ base-class \ alien class<= ] [ %box-displaced-alien/alien ] }
{ [ base-class \ byte-array class<= ] [ %box-displaced-alien/byte-array ] }
[ %box-displaced-alien/dynamic ]
} cond
"end" resolve-label
] with-scope ;
: (%memory) ( val base displacement scale offset rep c-type -- base val displacement rep c-type )
[ [ 0 assert= ] bi@ swapd ] 2dip ; inline
M: ppc %load-memory-imm ( dst base offset rep c-type -- )
[
{
{ c:char [ [ dup ] 2dip LBZ dup EXTSB ] }
{ c:uchar [ LBZ ] }
{ c:short [ LHA ] }
{ c:ushort [ LHZ ] }
{ c:int [ LWZ ] }
{ c:uint [ LWZ ] }
} case
] [
{
{ int-rep [ LWZ ] }
{ float-rep [ LFS ] }
{ double-rep [ LFD ] }
} case
] ?if ;
M: ppc %load-memory ( dst base displacement scale offset rep c-type -- )
(%memory) [
{
{ c:char [ [ LBZX ] [ drop dup EXTSB ] 2bi ] }
{ c:uchar [ LBZX ] }
{ c:short [ LHAX ] }
{ c:ushort [ LHZX ] }
{ c:int [ LWZX ] }
{ c:uint [ LWZX ] }
} case
] [
{
{ int-rep [ LWZX ] }
{ float-rep [ LFSX ] }
{ double-rep [ LFDX ] }
} case
] ?if ;
M: ppc %store-memory-imm ( src base offset rep c-type -- )
[
{
{ c:char [ STB ] }
{ c:uchar [ STB ] }
{ c:short [ STH ] }
{ c:ushort [ STH ] }
{ c:int [ STW ] }
{ c:uint [ STW ] }
} case
] [
{
{ int-rep [ STW ] }
{ float-rep [ STFS ] }
{ double-rep [ STFD ] }
} case
] ?if ;
M: ppc %store-memory ( src base displacement scale offset rep c-type -- )
(%memory) [
{
{ c:char [ STBX ] }
{ c:uchar [ STBX ] }
{ c:short [ STHX ] }
{ c:ushort [ STHX ] }
{ c:int [ STWX ] }
{ c:uint [ STWX ] }
} case
] [
{
{ int-rep [ STWX ] }
{ float-rep [ STFSX ] }
{ double-rep [ STFDX ] }
} case
] ?if ;
: load-zone-ptr ( reg -- )
vm-reg "nursery" vm-field-offset ADDI ;
: load-allot-ptr ( nursery-ptr allot-ptr -- )
[ drop load-zone-ptr ] [ swap 0 LWZ ] 2bi ;
:: inc-allot-ptr ( nursery-ptr allot-ptr n -- )
scratch-reg allot-ptr n data-alignment get align ADDI
scratch-reg nursery-ptr 0 STW ;
:: store-header ( dst class -- )
class type-number tag-header scratch-reg LI
scratch-reg dst 0 STW ;
: store-tagged ( dst tag -- )
dupd type-number ORI ;
M:: ppc %allot ( dst size class nursery-ptr -- )
nursery-ptr dst load-allot-ptr
nursery-ptr dst size inc-allot-ptr
dst class store-header
dst class store-tagged ;
: load-cards-offset ( dst -- )
0 swap LOAD32 rc-absolute-ppc-2/2 rel-cards-offset ;
: load-decks-offset ( dst -- )
0 swap LOAD32 rc-absolute-ppc-2/2 rel-decks-offset ;
:: (%write-barrier) ( temp1 temp2 -- )
card-mark scratch-reg LI
! Mark the card
temp1 temp1 card-bits SRWI
temp2 load-cards-offset
temp1 scratch-reg temp2 STBX
! Mark the card deck
temp1 temp1 deck-bits card-bits - SRWI
temp2 load-decks-offset
temp1 scratch-reg temp2 STBX ;
M:: ppc %write-barrier ( src slot scale tag temp1 temp2 -- )
scale 0 assert= tag 0 assert=
temp1 src slot ADD
temp1 temp2 (%write-barrier) ;
M:: ppc %write-barrier-imm ( src slot tag temp1 temp2 -- )
temp1 src slot tag slot-offset ADDI
temp1 temp2 (%write-barrier) ;
M:: ppc %check-nursery-branch ( label size cc temp1 temp2 -- )
temp1 vm-reg "nursery" vm-field-offset LWZ
temp2 vm-reg "nursery" vm-field-offset 2 cells + LWZ
temp1 temp1 size ADDI
! is here >= end?
temp1 0 temp2 CMP
cc {
{ cc<= [ label BLE ] }
{ cc/<= [ label BGT ] }
} case ;
: gc-root-offsets ( seq -- seq' )
[ n>> spill@ ] map f like ;
M: ppc %call-gc ( gc-roots -- )
3 swap gc-root-offsets %load-reference
4 %load-vm-addr
"inline_gc" f %c-invoke ;
M: ppc %prologue ( n -- )
0 11 LOAD32 rc-absolute-ppc-2/2 rel-this
0 MFLR
{
[ [ 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 ] dip lr-save + LWZ ]
[ [ 1 1 ] dip ADDI ] bi
0 MTLR ;
:: (%boolean) ( dst temp branch1 branch2 -- )
"end" define-label
dst \ f type-number %load-immediate
"end" get branch1 execute( label -- )
branch2 [ "end" get branch2 execute( label -- ) ] when
dst \ t %load-reference
"end" get resolve-label ; inline
:: %boolean ( dst cc temp -- )
cc negate-cc order-cc {
{ cc< [ dst temp \ BLT f (%boolean) ] }
{ cc<= [ dst temp \ BLE f (%boolean) ] }
{ cc> [ dst temp \ BGT f (%boolean) ] }
{ cc>= [ dst temp \ BGE f (%boolean) ] }
{ cc= [ dst temp \ BEQ f (%boolean) ] }
{ cc/= [ dst temp \ BNE f (%boolean) ] }
} case ;
: (%compare) ( src1 src2 -- ) [ 0 ] dip CMP ; inline
: (%compare-integer-imm) ( src1 src2 -- )
[ 0 ] 2dip CMPI ; inline
: (%compare-imm) ( src1 src2 -- )
[ tag-fixnum ] [ \ f type-number ] if* (%compare-integer-imm) ; inline
: (%compare-float-unordered) ( src1 src2 -- )
[ 0 ] dip FCMPU ; inline
: (%compare-float-ordered) ( src1 src2 -- )
[ 0 ] dip FCMPO ; inline
:: (%compare-float) ( src1 src2 cc compare -- branch1 branch2 )
cc {
{ cc< [ src1 src2 \ compare execute( a b -- ) \ BLT f ] }
{ cc<= [ src1 src2 \ compare execute( a b -- ) \ BLT \ BEQ ] }
{ cc> [ src1 src2 \ compare execute( a b -- ) \ BGT f ] }
{ cc>= [ src1 src2 \ compare execute( a b -- ) \ BGT \ BEQ ] }
{ cc= [ src1 src2 \ compare execute( a b -- ) \ BEQ f ] }
{ cc<> [ src1 src2 \ compare execute( a b -- ) \ BLT \ BGT ] }
{ cc<>= [ src1 src2 \ compare execute( a b -- ) \ BNO f ] }
{ cc/< [ src1 src2 \ compare execute( a b -- ) \ BGE f ] }
{ cc/<= [ src1 src2 \ compare execute( a b -- ) \ BGT \ BO ] }
{ cc/> [ src1 src2 \ compare execute( a b -- ) \ BLE f ] }
{ cc/>= [ src1 src2 \ compare execute( a b -- ) \ BLT \ BO ] }
{ cc/= [ src1 src2 \ compare execute( a b -- ) \ BNE f ] }
{ cc/<> [ src1 src2 \ compare execute( a b -- ) \ BEQ \ BO ] }
{ cc/<>= [ src1 src2 \ compare execute( a b -- ) \ BO f ] }
} case ; inline
M: ppc %compare [ (%compare) ] 2dip %boolean ;
M: ppc %compare-imm [ (%compare-imm) ] 2dip %boolean ;
M: ppc %compare-integer-imm [ (%compare-integer-imm) ] 2dip %boolean ;
M:: ppc %compare-float-ordered ( dst src1 src2 cc temp -- )
src1 src2 cc negate-cc \ (%compare-float-ordered) (%compare-float) :> ( branch1 branch2 )
dst temp branch1 branch2 (%boolean) ;
M:: ppc %compare-float-unordered ( dst src1 src2 cc temp -- )
src1 src2 cc negate-cc \ (%compare-float-unordered) (%compare-float) :> ( branch1 branch2 )
dst temp branch1 branch2 (%boolean) ;
:: %branch ( label cc -- )
cc order-cc {
{ cc< [ label BLT ] }
{ cc<= [ label BLE ] }
{ cc> [ label BGT ] }
{ cc>= [ label BGE ] }
{ cc= [ label BEQ ] }
{ cc/= [ label BNE ] }
} case ;
M:: ppc %compare-branch ( label src1 src2 cc -- )
src1 src2 (%compare)
label cc %branch ;
M:: ppc %compare-imm-branch ( label src1 src2 cc -- )
src1 src2 (%compare-imm)
label cc %branch ;
M:: ppc %compare-integer-imm-branch ( label src1 src2 cc -- )
src1 src2 (%compare-integer-imm)
label cc %branch ;
:: (%branch) ( label branch1 branch2 -- )
label branch1 execute( label -- )
branch2 [ label branch2 execute( label -- ) ] when ; inline
M:: ppc %compare-float-ordered-branch ( label src1 src2 cc -- )
src1 src2 cc \ (%compare-float-ordered) (%compare-float) :> ( branch1 branch2 )
label branch1 branch2 (%branch) ;
M:: ppc %compare-float-unordered-branch ( label src1 src2 cc -- )
src1 src2 cc \ (%compare-float-unordered) (%compare-float) :> ( branch1 branch2 )
label branch1 branch2 (%branch) ;
: load-from-frame ( dst n rep -- )
{
{ int-rep [ [ 1 ] dip LWZ ] }
{ tagged-rep [ [ 1 ] dip LWZ ] }
{ float-rep [ [ 1 ] dip LFS ] }
{ double-rep [ [ 1 ] dip LFD ] }
{ stack-params [ [ 0 1 ] dip LWZ [ 0 1 ] dip param@ STW ] }
} case ;
: next-param@ ( n -- reg x )
[ 17 ] dip param@ ;
: store-to-frame ( src n rep -- )
{
{ int-rep [ [ 1 ] dip STW ] }
{ tagged-rep [ [ 1 ] dip STW ] }
{ float-rep [ [ 1 ] dip STFS ] }
{ double-rep [ [ 1 ] dip STFD ] }
{ stack-params [ [ [ 0 ] dip next-param@ LWZ 0 1 ] dip STW ] }
} case ;
M: ppc %spill ( src rep dst -- )
swap [ n>> spill@ ] dip store-to-frame ;
M: ppc %reload ( dst rep src -- )
swap [ n>> spill@ ] dip load-from-frame ;
M: ppc %loop-entry ;
M: ppc return-regs
{
{ int-regs { 3 4 5 6 } }
{ float-regs { 1 } }
} ;
M:: ppc %save-param-reg ( stack reg rep -- )
reg stack local@ rep store-to-frame ;
M:: ppc %load-param-reg ( stack reg rep -- )
reg stack local@ rep load-from-frame ;
GENERIC: load-param ( reg src -- )
M: integer load-param int-rep %copy ;
M: spill-slot load-param [ 1 ] dip n>> spill@ LWZ ;
GENERIC: store-param ( reg dst -- )
M: integer store-param swap int-rep %copy ;
M: spill-slot store-param [ 1 ] dip n>> spill@ STW ;
:: call-unbox-func ( src func -- )
3 src load-param
4 %load-vm-addr
func f %c-invoke ;
M:: ppc %unbox ( src n rep func -- )
src func call-unbox-func
! Store the return value on the C stack
n [ rep reg-class-of return-regs at first rep %save-param-reg ] when* ;
M:: ppc %unbox-long-long ( src n func -- )
src func call-unbox-func
! Store the return value on the C stack
n [
3 1 n local@ STW
4 1 n cell + local@ STW
] when ;
M:: ppc %unbox-large-struct ( src n c-type -- )
4 src load-param
3 1 n local@ ADDI
c-type heap-size 5 LI
"memcpy" "libc" load-library %c-invoke ;
M:: ppc %box ( dst n rep func -- )
n [ 0 rep reg-class-of cdecl param-reg rep %load-param-reg ] when*
rep double-rep? 5 4 ? %load-vm-addr
func f %c-invoke
3 dst store-param ;
M:: ppc %box-long-long ( dst n func -- )
n [
3 1 n local@ LWZ
4 1 n cell + local@ LWZ
] when
5 %load-vm-addr
func f %c-invoke
3 dst store-param ;
: struct-return@ ( n -- n )
[ stack-frame get params>> ] unless* local@ ;
M: ppc %prepare-box-struct ( -- )
#! Compute target address for value struct return
3 1 f struct-return@ ADDI
3 1 0 local@ STW ;
M:: ppc %box-large-struct ( dst n c-type -- )
! If n = f, then we're boxing a returned struct
! Compute destination address and load struct size
3 1 n struct-return@ ADDI
c-type heap-size 4 LI
5 %load-vm-addr
! Call the function
"from_value_struct" f %c-invoke
3 dst store-param ;
M:: ppc %restore-context ( temp1 temp2 -- )
temp1 %context
ds-reg temp1 "datastack" context-field-offset LWZ
rs-reg temp1 "retainstack" context-field-offset LWZ ;
M:: ppc %save-context ( temp1 temp2 -- )
temp1 %context
1 temp1 "callstack-top" context-field-offset STW
ds-reg temp1 "datastack" context-field-offset STW
rs-reg temp1 "retainstack" context-field-offset STW ;
M: ppc %c-invoke ( symbol dll -- )
[ 11 ] 2dip %alien-global 11 MTLR BLRL ;
M: ppc %alien-indirect ( src -- )
[ 11 ] dip load-param 11 MTLR BLRL ;
M: ppc immediate-arithmetic? ( n -- ? ) -32768 32767 between? ;
M: ppc immediate-bitwise? ( n -- ? ) 0 65535 between? ;
M: ppc immediate-store? drop f ;
M: ppc return-struct-in-registers? ( c-type -- ? )
c-type return-in-registers?>> ;
M:: ppc %box-small-struct ( dst c-type -- )
#! Box a <= 16-byte struct returned in r3:r4:r5:r6
c-type heap-size 7 LI
8 %load-vm-addr
"from_medium_struct" f %c-invoke
3 dst store-param ;
: %unbox-struct-1 ( -- )
! Alien must be in r3.
3 3 0 LWZ ;
: %unbox-struct-2 ( -- )
! Alien must be in r3.
4 3 4 LWZ
3 3 0 LWZ ;
: %unbox-struct-4 ( -- )
! Alien must be in r3.
6 3 12 LWZ
5 3 8 LWZ
4 3 4 LWZ
3 3 0 LWZ ;
M:: ppc %unbox-small-struct ( src c-type -- )
src 3 load-param
c-type heap-size {
{ [ dup 4 <= ] [ drop %unbox-struct-1 ] }
{ [ dup 8 <= ] [ drop %unbox-struct-2 ] }
{ [ dup 16 <= ] [ drop %unbox-struct-4 ] }
} cond ;
M: ppc %begin-callback ( -- )
3 %load-vm-addr
"begin_callback" f %c-invoke ;
M: ppc %alien-callback ( quot -- )
3 swap %load-reference
4 3 quot-entry-point-offset LWZ
4 MTLR
BLRL ;
M: ppc %end-callback ( -- )
3 %load-vm-addr
"end_callback" f %c-invoke ;
enable-float-functions
USE: vocabs.loader
{
{ [ os macosx? ] [ "cpu.ppc.macosx" require ] }
{ [ os linux? ] [ "cpu.ppc.linux" require ] }
} cond
complex-double c-type t >>return-in-registers? drop

1
unmaintained/ppc/summary.txt
View File

@ -1 +0,0 @@
32-bit PowerPC compiler backend

2
unmaintained/ppc/tags.txt
View File

@ -1,2 +0,0 @@
compiler
not loaded

3
vm/Config.freebsd
View File

@ -1,4 +1,3 @@
include vm/Config.unix
PLAF_DLL_OBJS += vm/os-genunix.o vm/os-freebsd.o vm/mvm-unix.o
CFLAGS += -export-dynamic
LIBS = -L/usr/local/lib/ -lm -lrt $(X11_UI_LIBS)
LIBS = -L/usr/local/lib/ -lm -lrt $(X11_UI_LIBS) -Wl,--export-dynamic

3
vm/Config.linux
View File

@ -1,4 +1,3 @@
include vm/Config.unix
PLAF_DLL_OBJS += vm/os-genunix.o vm/os-linux.o vm/mvm-unix.o
CFLAGS += -export-dynamic
LIBS = -ldl -lm -lrt -lpthread $(X11_UI_LIBS)
LIBS = -ldl -lm -lrt -lpthread $(X11_UI_LIBS) -Wl,--export-dynamic

3
vm/Config.linux.ppc
View File

@ -1,3 +0,0 @@
include vm/Config.linux
include vm/Config.ppc
CFLAGS += -mregnames

3
vm/Config.linux.ppc.32 Normal file
View File

@ -0,0 +1,3 @@
include vm/Config.linux
PLAF_DLL_OBJS += vm/cpu-ppc.linux.o
CFLAGS += -m32

3
vm/Config.linux.ppc.64 Normal file
View File

@ -0,0 +1,3 @@
include vm/Config.linux
PLAF_DLL_OBJS += vm/cpu-ppc.linux.o
CFLAGS += -m64

2
vm/Config.macosx.ppc
View File

@ -1,3 +1,3 @@
include vm/Config.macosx
include vm/Config.ppc
PLAF_DLL_OBJS += vm/cpu-ppc.macosx.o
CFLAGS += -arch ppc -force_cpusubtype_ALL

3
vm/Config.netbsd
View File

@ -1,5 +1,4 @@
include vm/Config.unix
PLAF_DLL_OBJS += vm/os-genunix.o vm/os-netbsd.o vm/mvm-none.o
CFLAGS += -export-dynamic
LIBPATH = -L/usr/X11R7/lib -Wl,-rpath,/usr/X11R7/lib -L/usr/pkg/lib -Wl,-rpath,/usr/pkg/lib
LIBS = -lm -lrt -lssl -lcrypto $(X11_UI_LIBS)
LIBS = -lm -lrt -lssl -lcrypto $(X11_UI_LIBS) -Wl,--export-dynamic

4
vm/Config.openbsd
View File

@ -2,5 +2,5 @@ include vm/Config.unix
PLAF_DLL_OBJS += vm/os-genunix.o vm/os-openbsd.o vm/mvm-unix.o
CC = egcc
CPP = eg++
CFLAGS += -export-dynamic -fno-inline-functions
LIBS = -L/usr/local/lib/ -lm $(X11_UI_LIBS) -lz -lssl -lcrypto -lpthread
CFLAGS += -fno-inline-functions
LIBS = -L/usr/local/lib/ -lm $(X11_UI_LIBS) -lz -lssl -lcrypto -lpthread -Wl,--export-dynamic

1
vm/Config.ppc
View File

@ -1 +0,0 @@
PLAF_DLL_OBJS += vm/cpu-ppc.o

4
vm/Config.solaris
View File

@ -1,6 +1,6 @@
include vm/Config.unix
PLAF_DLL_OBJS += vm/os-genunix.o vm/os-solaris.o
CFLAGS += -D_STDC_C99 -Drestrict="" -export-dynamic
CFLAGS += -D_STDC_C99 -Drestrict=""
LIBS += -ldl -lsocket -lnsl -lm -lrt -R/opt/PM/lib -R/opt/csw/lib \
-R/usr/local/lib -R/usr/sfw/lib -R/usr/X11R6/lib \
-R/opt/sfw/lib $(X11_UI_LIBS)
-R/opt/sfw/lib $(X11_UI_LIBS) -Wl,--export-dynamic

23
vm/alien.cpp
View File

@ -138,6 +138,29 @@ void factor_vm::primitive_dlsym()
ctx->push(allot_alien(ffi_dlsym(NULL,sym)));
}
/* look up a symbol in a native library */
void factor_vm::primitive_dlsym_raw()
{
data_root<object> library(ctx->pop(),this);
data_root<byte_array> name(ctx->pop(),this);
name.untag_check(this);
symbol_char *sym = name->data<symbol_char>();
if(to_boolean(library.value()))
{
dll *d = untag_check<dll>(library.value());
if(d->handle == NULL)
ctx->push(false_object);
else
ctx->push(allot_alien(ffi_dlsym_raw(d,sym)));
}
else
ctx->push(allot_alien(ffi_dlsym_raw(NULL,sym)));
}
/* close a native library handle */
void factor_vm::primitive_dlclose()
{

23
vm/bitwise_hacks.hpp
View File

@ -17,9 +17,18 @@ inline cell log2(cell x)
#else
asm ("bsr %1, %0;":"=r"(n):"r"(x));
#endif
#elif defined(FACTOR_PPC)
asm ("cntlzw %1, %0;":"=r"(n):"r"(x));
n = (31 - n);
#elif defined(FACTOR_PPC64)
#if defined(__GNUC__)
n = (63 - __builtin_clzll(x));
#else
#error Unsupported compiler
#endif
#elif defined(FACTOR_PPC32)
#if defined(__GNUC__)
n = (31 - __builtin_clz(x));
#else
#error Unsupported compiler
#endif
#else
#error Unsupported CPU
#endif
@ -38,6 +47,13 @@ inline cell rightmost_set_bit(cell x)
inline cell popcount(cell x)
{
#if defined(__GNUC__)
#ifdef FACTOR_64
return __builtin_popcountll(x);
#else
return __builtin_popcount(x);
#endif
#else
#ifdef FACTOR_64
u64 k1 = 0x5555555555555555ll;
u64 k2 = 0x3333333333333333ll;
@ -58,6 +74,7 @@ inline cell popcount(cell x)
x = (x * kf) >> ks; // returns 8 most significant bits of x + (x<<8) + (x<<16) + (x<<24) + ...
return x;
#endif
}
inline bool bitmap_p(u8 *bitmap, cell index)

5
vm/callbacks.cpp
View File

@ -140,7 +140,10 @@ void factor_vm::primitive_callback()
tagged<word> w(ctx->pop());
w.untag_check(this);
ctx->push(allot_alien(callbacks->add(w.value(),return_rewind)->entry_point()));
void* func = callbacks->add(w.value(),return_rewind)->entry_point();
CODE_TO_FUNCTION_POINTER_CALLBACK(this, func);
ctx->push(allot_alien(func));
}
}

2
vm/callstack.hpp
View File

@ -11,7 +11,7 @@ keep the callstack in a GC root and use relative offsets */
template<typename Iterator> void factor_vm::iterate_callstack_object(callstack *stack_, Iterator &iterator)
{
data_root<callstack> stack(stack_,this);
fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
fixnum frame_offset = factor::untag_fixnum(stack->length) - sizeof(stack_frame);
while(frame_offset >= 0)
{

60
vm/code_blocks.cpp
View File

@ -160,8 +160,10 @@ cell factor_vm::compute_dlsym_address(array *literals, cell index)
dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
void* undefined_symbol = (void*)factor::undefined_symbol;
undefined_symbol = FUNCTION_CODE_POINTER(undefined_symbol);
if(d != NULL && !d->handle)
return (cell)factor::undefined_symbol;
return (cell)undefined_symbol;
switch(tagged<object>(symbol).type())
{
@ -173,7 +175,7 @@ cell factor_vm::compute_dlsym_address(array *literals, cell index)
if(sym)
return (cell)sym;
else
return (cell)factor::undefined_symbol;
return (cell)undefined_symbol;
}
case ARRAY_TYPE:
{
@ -186,14 +188,59 @@ cell factor_vm::compute_dlsym_address(array *literals, cell index)
if(sym)
return (cell)sym;
}
return (cell)factor::undefined_symbol;
return (cell)undefined_symbol;
}
default:
critical_error("Bad symbol specifier",symbol);
return (cell)factor::undefined_symbol;
return (cell)undefined_symbol;
}
}
#ifdef FACTOR_PPC
cell factor_vm::compute_dlsym_toc_address(array *literals, cell index)
{
cell symbol = array_nth(literals,index);
cell library = array_nth(literals,index + 1);
dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
void* undefined_toc = (void*)factor::undefined_symbol;
undefined_toc = FUNCTION_TOC_POINTER(undefined_toc);
if(d != NULL && !d->handle)
return (cell)undefined_toc;
switch(tagged<object>(symbol).type())
{
case BYTE_ARRAY_TYPE:
{
symbol_char *name = alien_offset(symbol);
void* toc = ffi_dlsym_toc(d,name);
if(toc)
return (cell)toc;
else
return (cell)undefined_toc;
}
case ARRAY_TYPE:
{
array *names = untag<array>(symbol);
for(cell i = 0; i < array_capacity(names); i++)
{
symbol_char *name = alien_offset(array_nth(names,i));
void *toc = ffi_dlsym_toc(d,name);
if(toc)
return (cell)toc;
}
return (cell)undefined_toc;
}
default:
critical_error("Bad symbol specifier",symbol);
return (cell)undefined_toc;
}
}
#endif
cell factor_vm::compute_vm_address(cell arg)
{
return (cell)this + untag_fixnum(arg);
@ -229,6 +276,11 @@ void factor_vm::store_external_address(instruction_operand op)
case RT_EXCEPTION_HANDLER:
op.store_value((cell)&factor::exception_handler);
break;
#endif
#ifdef FACTOR_PPC
case RT_DLSYM_TOC:
op.store_value(compute_dlsym_toc_address(parameters,index));
break;
#endif
default:
critical_error("Bad rel type in store_external_address()",op.rel_type());

73
vm/cpu-ppc.S
View File

@ -1,73 +0,0 @@
#if defined(__APPLE__)
#define MANGLE(sym) _##sym
#define XX @
#else
#define MANGLE(sym) sym
#define XX ;
#endif
/* The returns and args are just for documentation */
#define DEF(returns,symbol,args) .globl MANGLE(symbol) XX \
MANGLE(symbol)
/* Thanks to Joshua Grams for this code.
On PowerPC processors, we must flush the instruction cache manually
after writing to the code heap. */
DEF(void,flush_icache,(void*, int)):
/* compute number of cache lines to flush */
add r4,r4,r3
/* align addr to next lower cache line boundary */
clrrwi r3,r3,5
/* then n_lines = (len + 0x1f) / 0x20 */
sub r4,r4,r3
addi r4,r4,0x1f
/* note '.' suffix */
srwi. r4,r4,5
/* if n_lines == 0, just return. */
beqlr
/* flush cache lines */
mtctr r4
/* for each line... */
0: dcbf 0,r3
sync
icbi 0,r3
addi r3,r3,0x20
bdnz 0b
/* finish up */
sync
isync
blr
DEF(void,get_ppc_fpu_env,(void*)):
mffs f0
stfd f0,0(r3)
blr
DEF(void,set_ppc_fpu_env,(const void*)):
lfd f0,0(r3)
mtfsf 0xff,f0
blr
DEF(void,get_ppc_vmx_env,(void*)):
mfvscr v0
subi r4,r1,16
li r5,0xf
andc r4,r4,r5
stvxl v0,0,r4
li r5,0xc
lwzx r6,r5,r4
stw r6,0(r3)
blr
DEF(void,set_ppc_vmx_env,(const void*)):
subi r4,r1,16
li r5,0xf
andc r4,r4,r5
li r5,0xc
lwz r6,0(r3)
stwx r6,r5,r4
lvxl v0,0,r4
mtvscr v0
blr

28
vm/cpu-ppc.hpp
View File

@ -1,7 +1,11 @@
namespace factor
{
#define FACTOR_CPU_STRING "ppc"
#ifdef FACTOR_64
#define FACTOR_CPU_STRING "ppc.64"
#else
#define FACTOR_CPU_STRING "ppc.32"
#endif
#define CALLSTACK_BOTTOM(ctx) (stack_frame *)(ctx->callstack_seg->end - 32)
@ -16,36 +20,36 @@ static const fixnum xt_tail_pic_offset = 4;
inline static void check_call_site(cell return_address)
{
cell insn = *(cell *)return_address;
u32 insn = *(u32 *)return_address;
/* Check that absolute bit is 0 */
assert((insn & 0x2) == 0x0);
/* Check that instruction is branch */
assert((insn >> 26) == 0x12);
}
static const cell b_mask = 0x3fffffc;
static const u32 b_mask = 0x3fffffc;
inline static void *get_call_target(cell return_address)
{
return_address -= sizeof(cell);
return_address -= 4;
check_call_site(return_address);
cell insn = *(cell *)return_address;
cell unsigned_addr = (insn & b_mask);
fixnum signed_addr = (fixnum)(unsigned_addr << 6) >> 6;
u32 insn = *(u32 *)return_address;
u32 unsigned_addr = (insn & b_mask);
s32 signed_addr = (s32)(unsigned_addr << 6) >> 6;
return (void *)(signed_addr + return_address);
}
inline static void set_call_target(cell return_address, void *target)
{
return_address -= sizeof(cell);
return_address -= 4;
check_call_site(return_address);
cell insn = *(cell *)return_address;
u32 insn = *(u32 *)return_address;
fixnum relative_address = ((cell)target - return_address);
insn = ((insn & ~b_mask) | (relative_address & b_mask));
*(cell *)return_address = insn;
*(u32 *)return_address = insn;
/* Flush the cache line containing the call we just patched */
__asm__ __volatile__ ("icbi 0, %0\n" "sync\n"::"r" (return_address):);
@ -53,8 +57,8 @@ inline static void set_call_target(cell return_address, void *target)
inline static bool tail_call_site_p(cell return_address)
{
return_address -= sizeof(cell);
cell insn = *(cell *)return_address;
return_address -= 4;
u32 insn = *(u32 *)return_address;
return (insn & 0x1) == 0;
}

46
vm/cpu-ppc.linux.S Normal file
View File

@ -0,0 +1,46 @@
.file "cpu-ppc.linux.S"
.section ".text"
.align 2
.globl flush_icache
.type flush_icache, @function
flush_icache:
add 4,4,3 # end += ptr
#ifdef _ARCH_PPC64
clrrdi 3,3,5 # ptr &= ~0x1f
#else
clrrwi 3,3,5 # ptr &= ~0x1f
#endif
sub 4,4,3 # end -= aligned_ptr
addi 4,4,0x1f # end += 0x1f
#ifdef _ARCH_PPC64
srdi. 4,4,5 # end >>= 5, set cr
#else
srwi. 4,4,5 # end >>= 5, set cr
#endif
beqlr
# Loop over the buffer by cache line and flush the data cache.
mr 5,3
mtctr 4
loop1:
dcbst 0,5
addi 5,5,0x20
bdnz loop1
# Synchronize to ensure the cache line flushes are complete.
sync
# Loop over the buffer by cache line and flush the instruction cache.
mr 5,3
mtctr 4
loop2:
icbi 0,5
addi 5,5,0x20
bdnz loop2
# Clear instruction pipeline to force reloading of instructions.
isync
blr
.size flush_icache,.-flush_icache
.section .note.GNU-stack,"",@progbits

20
vm/entry_points.cpp
View File

@ -13,9 +13,10 @@ void factor_vm::c_to_factor(cell quot)
{
tagged<word> c_to_factor_word(special_objects[C_TO_FACTOR_WORD]);
code_block *c_to_factor_block = callbacks->add(c_to_factor_word.value(),0);
c_to_factor_func = (c_to_factor_func_type)c_to_factor_block->entry_point();
void* func = c_to_factor_block->entry_point();
CODE_TO_FUNCTION_POINTER_CALLBACK(this, func);
c_to_factor_func = (c_to_factor_func_type)func;
}
c_to_factor_func(quot);
}
@ -31,17 +32,26 @@ template<typename Func> Func factor_vm::get_entry_point(cell n)
void factor_vm::unwind_native_frames(cell quot, stack_frame *to)
{
get_entry_point<unwind_native_frames_func_type>(UNWIND_NATIVE_FRAMES_WORD)(quot,to);
tagged<word> entry_point_word(special_objects[UNWIND_NATIVE_FRAMES_WORD]);
void *func = entry_point_word->code->entry_point();
CODE_TO_FUNCTION_POINTER(func);
((unwind_native_frames_func_type)func)(quot,to);
}
cell factor_vm::get_fpu_state()
{
return get_entry_point<get_fpu_state_func_type>(GET_FPU_STATE_WORD)();
tagged<word> entry_point_word(special_objects[GET_FPU_STATE_WORD]);
void *func = entry_point_word->code->entry_point();
CODE_TO_FUNCTION_POINTER(func);
return ((get_fpu_state_func_type)func)();
}
void factor_vm::set_fpu_state(cell state)
{
get_entry_point<set_fpu_state_func_type>(GET_FPU_STATE_WORD)(state);
tagged<word> entry_point_word(special_objects[SET_FPU_STATE_WORD]);
void *func = entry_point_word->code->entry_point();
CODE_TO_FUNCTION_POINTER(func);
((set_fpu_state_func_type)func)(state);
}
}

15
vm/factor.cpp
View File

@ -179,8 +179,9 @@ void factor_vm::stop_factor()
char *factor_vm::factor_eval_string(char *string)
{
char *(*callback)(char *) = (char *(*)(char *))alien_offset(special_objects[OBJ_EVAL_CALLBACK]);
return callback(string);
void *func = alien_offset(special_objects[OBJ_EVAL_CALLBACK]);
CODE_TO_FUNCTION_POINTER(func);
return ((char *(*)(char *))func)(string);
}
void factor_vm::factor_eval_free(char *result)
@ -190,14 +191,16 @@ void factor_vm::factor_eval_free(char *result)
void factor_vm::factor_yield()
{
void (*callback)() = (void (*)())alien_offset(special_objects[OBJ_YIELD_CALLBACK]);
callback();
void *func = alien_offset(special_objects[OBJ_YIELD_CALLBACK]);
CODE_TO_FUNCTION_POINTER(func);
((void (*)())func)();
}
void factor_vm::factor_sleep(long us)
{
void (*callback)(long) = (void (*)(long))alien_offset(special_objects[OBJ_SLEEP_CALLBACK]);
callback(us);
void *func = alien_offset(special_objects[OBJ_SLEEP_CALLBACK]);
CODE_TO_FUNCTION_POINTER(func);
((void (*)(long))func)(us);
}
void factor_vm::start_standalone_factor(int argc, vm_char **argv)

Some files were not shown because too many files have changed in this diff Show More