Merge branch 'master' of git://factorcode.org/git/factor
commit
ebf7ad486e
|
@ -13,8 +13,7 @@ HELP: heap-size
|
||||||
{ $values { "type" string } { "size" math:integer } }
|
{ $values { "type" string } { "size" math:integer } }
|
||||||
{ $description "Outputs the number of bytes needed for a heap-allocated value of this C type." }
|
{ $description "Outputs the number of bytes needed for a heap-allocated value of this C type." }
|
||||||
{ $examples
|
{ $examples
|
||||||
"On a 32-bit system, you will get the following output:"
|
{ $example "USING: alien alien.c-types prettyprint ;\nint heap-size ." "4" }
|
||||||
{ $unchecked-example "USE: alien\n\"void*\" heap-size ." "4" }
|
|
||||||
}
|
}
|
||||||
{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
|
{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
|
||||||
|
|
||||||
|
|
|
@ -53,7 +53,7 @@ ERROR: no-c-type name ;
|
||||||
PREDICATE: c-type-word < word
|
PREDICATE: c-type-word < word
|
||||||
"c-type" word-prop ;
|
"c-type" word-prop ;
|
||||||
|
|
||||||
UNION: c-type-name string c-type-word ;
|
UNION: c-type-name string word ;
|
||||||
|
|
||||||
! C type protocol
|
! C type protocol
|
||||||
GENERIC: c-type ( name -- type ) foldable
|
GENERIC: c-type ( name -- type ) foldable
|
||||||
|
@ -479,6 +479,8 @@ M: short-8-rep rep-component-type drop short ;
|
||||||
M: ushort-8-rep rep-component-type drop ushort ;
|
M: ushort-8-rep rep-component-type drop ushort ;
|
||||||
M: int-4-rep rep-component-type drop int ;
|
M: int-4-rep rep-component-type drop int ;
|
||||||
M: uint-4-rep rep-component-type drop uint ;
|
M: uint-4-rep rep-component-type drop uint ;
|
||||||
|
M: longlong-2-rep rep-component-type drop longlong ;
|
||||||
|
M: ulonglong-2-rep rep-component-type drop ulonglong ;
|
||||||
M: float-4-rep rep-component-type drop float ;
|
M: float-4-rep rep-component-type drop float ;
|
||||||
M: double-2-rep rep-component-type drop double ;
|
M: double-2-rep rep-component-type drop double ;
|
||||||
|
|
||||||
|
|
|
@ -25,7 +25,7 @@ STRUCT: T-class { real N } { imaginary N } ;
|
||||||
T-class c-type
|
T-class c-type
|
||||||
<T> 1quotation >>unboxer-quot
|
<T> 1quotation >>unboxer-quot
|
||||||
*T 1quotation >>boxer-quot
|
*T 1quotation >>boxer-quot
|
||||||
number >>boxed-class
|
complex >>boxed-class
|
||||||
drop
|
drop
|
||||||
|
|
||||||
;FUNCTOR
|
;FUNCTOR
|
||||||
|
|
|
@ -190,7 +190,7 @@ M: ##slot-imm insn-slot# slot>> ;
|
||||||
M: ##set-slot insn-slot# slot>> constant ;
|
M: ##set-slot insn-slot# slot>> constant ;
|
||||||
M: ##set-slot-imm insn-slot# slot>> ;
|
M: ##set-slot-imm insn-slot# slot>> ;
|
||||||
M: ##alien-global insn-slot# [ library>> ] [ symbol>> ] bi 2array ;
|
M: ##alien-global insn-slot# [ library>> ] [ symbol>> ] bi 2array ;
|
||||||
M: ##vm-field-ptr insn-slot# fieldname>> 1array ; ! is this right?
|
M: ##vm-field-ptr insn-slot# field-name>> ; ! is this right?
|
||||||
|
|
||||||
M: ##slot insn-object obj>> resolve ;
|
M: ##slot insn-object obj>> resolve ;
|
||||||
M: ##slot-imm insn-object obj>> resolve ;
|
M: ##slot-imm insn-object obj>> resolve ;
|
||||||
|
|
|
@ -380,6 +380,27 @@ def: dst
|
||||||
use: src1 src2
|
use: src1 src2
|
||||||
literal: rep ;
|
literal: rep ;
|
||||||
|
|
||||||
|
PURE-INSN: ##shl-vector
|
||||||
|
def: dst
|
||||||
|
use: src1 src2/scalar-rep
|
||||||
|
literal: rep ;
|
||||||
|
|
||||||
|
PURE-INSN: ##shr-vector
|
||||||
|
def: dst
|
||||||
|
use: src1 src2/scalar-rep
|
||||||
|
literal: rep ;
|
||||||
|
|
||||||
|
! Scalar/integer conversion
|
||||||
|
PURE-INSN: ##scalar>integer
|
||||||
|
def: dst/int-rep
|
||||||
|
use: src
|
||||||
|
literal: rep ;
|
||||||
|
|
||||||
|
PURE-INSN: ##integer>scalar
|
||||||
|
def: dst
|
||||||
|
use: src/int-rep
|
||||||
|
literal: rep ;
|
||||||
|
|
||||||
! Boxing and unboxing aliens
|
! Boxing and unboxing aliens
|
||||||
PURE-INSN: ##box-alien
|
PURE-INSN: ##box-alien
|
||||||
def: dst/int-rep
|
def: dst/int-rep
|
||||||
|
@ -492,7 +513,7 @@ literal: symbol library ;
|
||||||
|
|
||||||
INSN: ##vm-field-ptr
|
INSN: ##vm-field-ptr
|
||||||
def: dst/int-rep
|
def: dst/int-rep
|
||||||
literal: fieldname ;
|
literal: field-name ;
|
||||||
|
|
||||||
! FFI
|
! FFI
|
||||||
INSN: ##alien-invoke
|
INSN: ##alien-invoke
|
||||||
|
|
|
@ -169,6 +169,8 @@ IN: compiler.cfg.intrinsics
|
||||||
{ math.vectors.simd.intrinsics:(simd-vbitand) [ [ ^^and-vector ] emit-binary-vector-op ] }
|
{ math.vectors.simd.intrinsics:(simd-vbitand) [ [ ^^and-vector ] emit-binary-vector-op ] }
|
||||||
{ math.vectors.simd.intrinsics:(simd-vbitor) [ [ ^^or-vector ] emit-binary-vector-op ] }
|
{ math.vectors.simd.intrinsics:(simd-vbitor) [ [ ^^or-vector ] emit-binary-vector-op ] }
|
||||||
{ math.vectors.simd.intrinsics:(simd-vbitxor) [ [ ^^xor-vector ] emit-binary-vector-op ] }
|
{ math.vectors.simd.intrinsics:(simd-vbitxor) [ [ ^^xor-vector ] emit-binary-vector-op ] }
|
||||||
|
{ math.vectors.simd.intrinsics:(simd-vlshift) [ [ ^^shl-vector ] emit-binary-vector-op ] }
|
||||||
|
{ math.vectors.simd.intrinsics:(simd-vrshift) [ [ ^^shr-vector ] emit-binary-vector-op ] }
|
||||||
{ math.vectors.simd.intrinsics:(simd-broadcast) [ [ ^^broadcast-vector ] emit-unary-vector-op ] }
|
{ math.vectors.simd.intrinsics:(simd-broadcast) [ [ ^^broadcast-vector ] emit-unary-vector-op ] }
|
||||||
{ math.vectors.simd.intrinsics:(simd-gather-2) [ emit-gather-vector-2 ] }
|
{ math.vectors.simd.intrinsics:(simd-gather-2) [ emit-gather-vector-2 ] }
|
||||||
{ math.vectors.simd.intrinsics:(simd-gather-4) [ emit-gather-vector-4 ] }
|
{ math.vectors.simd.intrinsics:(simd-gather-4) [ emit-gather-vector-4 ] }
|
||||||
|
|
|
@ -3,8 +3,8 @@
|
||||||
USING: kernel accessors sequences arrays fry namespaces generic
|
USING: kernel accessors sequences arrays fry namespaces generic
|
||||||
words sets combinators generalizations cpu.architecture compiler.units
|
words sets combinators generalizations cpu.architecture compiler.units
|
||||||
compiler.cfg.utilities compiler.cfg compiler.cfg.rpo
|
compiler.cfg.utilities compiler.cfg compiler.cfg.rpo
|
||||||
compiler.cfg.instructions compiler.cfg.instructions.syntax
|
compiler.cfg.instructions compiler.cfg.def-use ;
|
||||||
compiler.cfg.def-use ;
|
FROM: compiler.cfg.instructions.syntax => insn-def-slot insn-use-slots insn-temp-slots scalar-rep ;
|
||||||
IN: compiler.cfg.representations.preferred
|
IN: compiler.cfg.representations.preferred
|
||||||
|
|
||||||
GENERIC: defs-vreg-rep ( insn -- rep/f )
|
GENERIC: defs-vreg-rep ( insn -- rep/f )
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2009 Slava Pestov
|
! Copyright (C) 2009 Slava Pestov
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel fry accessors sequences assocs sets namespaces
|
USING: kernel fry accessors sequences assocs sets namespaces
|
||||||
arrays combinators make locals deques dlists
|
arrays combinators make locals deques dlists layouts
|
||||||
cpu.architecture compiler.utilities
|
cpu.architecture compiler.utilities
|
||||||
compiler.cfg
|
compiler.cfg
|
||||||
compiler.cfg.rpo
|
compiler.cfg.rpo
|
||||||
|
@ -22,19 +22,18 @@ ERROR: bad-conversion dst src dst-rep src-rep ;
|
||||||
GENERIC: emit-box ( dst src rep -- )
|
GENERIC: emit-box ( dst src rep -- )
|
||||||
GENERIC: emit-unbox ( dst src rep -- )
|
GENERIC: emit-unbox ( dst src rep -- )
|
||||||
|
|
||||||
M: float-rep emit-box
|
M:: float-rep emit-box ( dst src rep -- )
|
||||||
drop
|
double-rep next-vreg-rep :> temp
|
||||||
[ double-rep next-vreg-rep dup ] dip ##single>double-float
|
temp src ##single>double-float
|
||||||
int-rep next-vreg-rep ##box-float ;
|
dst temp int-rep next-vreg-rep ##box-float ;
|
||||||
|
|
||||||
M: float-rep emit-unbox
|
M:: float-rep emit-unbox ( dst src rep -- )
|
||||||
drop
|
double-rep next-vreg-rep :> temp
|
||||||
[ double-rep next-vreg-rep dup ] dip ##unbox-float
|
temp src ##unbox-float
|
||||||
##double>single-float ;
|
dst temp ##double>single-float ;
|
||||||
|
|
||||||
M: double-rep emit-box
|
M: double-rep emit-box
|
||||||
drop
|
drop int-rep next-vreg-rep ##box-float ;
|
||||||
int-rep next-vreg-rep ##box-float ;
|
|
||||||
|
|
||||||
M: double-rep emit-unbox
|
M: double-rep emit-unbox
|
||||||
drop ##unbox-float ;
|
drop ##unbox-float ;
|
||||||
|
@ -45,6 +44,16 @@ M: vector-rep emit-box
|
||||||
M: vector-rep emit-unbox
|
M: vector-rep emit-unbox
|
||||||
##unbox-vector ;
|
##unbox-vector ;
|
||||||
|
|
||||||
|
M:: scalar-rep emit-box ( dst src rep -- )
|
||||||
|
int-rep next-vreg-rep :> temp
|
||||||
|
temp src rep ##scalar>integer
|
||||||
|
dst temp tag-bits get ##shl-imm ;
|
||||||
|
|
||||||
|
M:: scalar-rep emit-unbox ( dst src rep -- )
|
||||||
|
int-rep next-vreg-rep :> temp
|
||||||
|
temp src tag-bits get ##sar-imm
|
||||||
|
dst temp rep ##integer>scalar ;
|
||||||
|
|
||||||
: emit-conversion ( dst src dst-rep src-rep -- )
|
: emit-conversion ( dst src dst-rep src-rep -- )
|
||||||
{
|
{
|
||||||
{ [ 2dup eq? ] [ drop ##copy ] }
|
{ [ 2dup eq? ] [ drop ##copy ] }
|
||||||
|
|
|
@ -58,7 +58,9 @@ UNION: two-operand-insn
|
||||||
##max-vector
|
##max-vector
|
||||||
##and-vector
|
##and-vector
|
||||||
##or-vector
|
##or-vector
|
||||||
##xor-vector ;
|
##xor-vector
|
||||||
|
##shl-vector
|
||||||
|
##shr-vector ;
|
||||||
|
|
||||||
GENERIC: convert-two-operand* ( insn -- )
|
GENERIC: convert-two-operand* ( insn -- )
|
||||||
|
|
||||||
|
|
|
@ -184,6 +184,10 @@ CODEGEN: ##abs-vector %abs-vector
|
||||||
CODEGEN: ##and-vector %and-vector
|
CODEGEN: ##and-vector %and-vector
|
||||||
CODEGEN: ##or-vector %or-vector
|
CODEGEN: ##or-vector %or-vector
|
||||||
CODEGEN: ##xor-vector %xor-vector
|
CODEGEN: ##xor-vector %xor-vector
|
||||||
|
CODEGEN: ##shl-vector %shl-vector
|
||||||
|
CODEGEN: ##shr-vector %shr-vector
|
||||||
|
CODEGEN: ##integer>scalar %integer>scalar
|
||||||
|
CODEGEN: ##scalar>integer %scalar>integer
|
||||||
CODEGEN: ##box-alien %box-alien
|
CODEGEN: ##box-alien %box-alien
|
||||||
CODEGEN: ##box-displaced-alien %box-displaced-alien
|
CODEGEN: ##box-displaced-alien %box-displaced-alien
|
||||||
CODEGEN: ##unbox-alien %unbox-alien
|
CODEGEN: ##unbox-alien %unbox-alien
|
||||||
|
@ -212,6 +216,7 @@ CODEGEN: ##compare-imm %compare-imm
|
||||||
CODEGEN: ##compare-float-ordered %compare-float-ordered
|
CODEGEN: ##compare-float-ordered %compare-float-ordered
|
||||||
CODEGEN: ##compare-float-unordered %compare-float-unordered
|
CODEGEN: ##compare-float-unordered %compare-float-unordered
|
||||||
CODEGEN: ##save-context %save-context
|
CODEGEN: ##save-context %save-context
|
||||||
|
CODEGEN: ##vm-field-ptr %vm-field-ptr
|
||||||
|
|
||||||
CODEGEN: _fixnum-add %fixnum-add
|
CODEGEN: _fixnum-add %fixnum-add
|
||||||
CODEGEN: _fixnum-sub %fixnum-sub
|
CODEGEN: _fixnum-sub %fixnum-sub
|
||||||
|
@ -278,9 +283,6 @@ M: ##alien-global generate-insn
|
||||||
[ dst>> ] [ symbol>> ] [ library>> ] tri
|
[ dst>> ] [ symbol>> ] [ library>> ] tri
|
||||||
%alien-global ;
|
%alien-global ;
|
||||||
|
|
||||||
M: ##vm-field-ptr generate-insn
|
|
||||||
[ dst>> ] [ fieldname>> ] bi %vm-field-ptr ;
|
|
||||||
|
|
||||||
! ##alien-invoke
|
! ##alien-invoke
|
||||||
GENERIC: next-fastcall-param ( rep -- )
|
GENERIC: next-fastcall-param ( rep -- )
|
||||||
|
|
||||||
|
|
|
@ -9,7 +9,7 @@ compiler.tree.propagation.info compiler.tree.def-use
|
||||||
compiler.tree.debugger compiler.tree.checker
|
compiler.tree.debugger compiler.tree.checker
|
||||||
slots.private words hashtables classes assocs locals
|
slots.private words hashtables classes assocs locals
|
||||||
specialized-arrays system sorting math.libm
|
specialized-arrays system sorting math.libm
|
||||||
math.intervals quotations effects alien ;
|
math.intervals quotations effects alien alien.data ;
|
||||||
FROM: math => float ;
|
FROM: math => float ;
|
||||||
SPECIALIZED-ARRAY: double
|
SPECIALIZED-ARRAY: double
|
||||||
IN: compiler.tree.propagation.tests
|
IN: compiler.tree.propagation.tests
|
||||||
|
@ -894,3 +894,6 @@ M: tuple-with-read-only-slot clone
|
||||||
[ t ] [ [ >fixnum dup 0 >= [ 16 /i ] when ] { /i fixnum/i fixnum/i-fast } inlined? ] unit-test
|
[ t ] [ [ >fixnum dup 0 >= [ 16 /i ] when ] { /i fixnum/i fixnum/i-fast } inlined? ] unit-test
|
||||||
[ f ] [ [ >fixnum dup 0 >= [ 16 /i ] when ] { fixnum-shift-fast } inlined? ] unit-test
|
[ f ] [ [ >fixnum dup 0 >= [ 16 /i ] when ] { fixnum-shift-fast } inlined? ] unit-test
|
||||||
[ f ] [ [ >float dup 0 >= [ 16 /i ] when ] { /i float/f } inlined? ] unit-test
|
[ f ] [ [ >float dup 0 >= [ 16 /i ] when ] { /i float/f } inlined? ] unit-test
|
||||||
|
|
||||||
|
! We want this to inline
|
||||||
|
[ t ] [ [ void* <c-direct-array> ] { <c-direct-array> } inlined? ] unit-test
|
||||||
|
|
|
@ -19,6 +19,8 @@ IN: compiler.tree.propagation.simd
|
||||||
(simd-vbitand)
|
(simd-vbitand)
|
||||||
(simd-vbitor)
|
(simd-vbitor)
|
||||||
(simd-vbitxor)
|
(simd-vbitxor)
|
||||||
|
(simd-vlshift)
|
||||||
|
(simd-vrshift)
|
||||||
(simd-broadcast)
|
(simd-broadcast)
|
||||||
(simd-gather-2)
|
(simd-gather-2)
|
||||||
(simd-gather-4)
|
(simd-gather-4)
|
||||||
|
@ -30,7 +32,7 @@ IN: compiler.tree.propagation.simd
|
||||||
literal>> scalar-rep-of {
|
literal>> scalar-rep-of {
|
||||||
{ float-rep [ float ] }
|
{ float-rep [ float ] }
|
||||||
{ double-rep [ float ] }
|
{ double-rep [ float ] }
|
||||||
{ int-rep [ integer ] }
|
[ integer ]
|
||||||
} case
|
} case
|
||||||
] [ drop real ] if
|
] [ drop real ] if
|
||||||
<class-info>
|
<class-info>
|
||||||
|
|
|
@ -27,7 +27,20 @@ uchar-16-rep
|
||||||
short-8-rep
|
short-8-rep
|
||||||
ushort-8-rep
|
ushort-8-rep
|
||||||
int-4-rep
|
int-4-rep
|
||||||
uint-4-rep ;
|
uint-4-rep
|
||||||
|
longlong-2-rep
|
||||||
|
ulonglong-2-rep ;
|
||||||
|
|
||||||
|
! Scalar values in the high component of a vector register
|
||||||
|
SINGLETONS:
|
||||||
|
char-scalar-rep
|
||||||
|
uchar-scalar-rep
|
||||||
|
short-scalar-rep
|
||||||
|
ushort-scalar-rep
|
||||||
|
int-scalar-rep
|
||||||
|
uint-scalar-rep
|
||||||
|
longlong-scalar-rep
|
||||||
|
ulonglong-scalar-rep ;
|
||||||
|
|
||||||
SINGLETONS:
|
SINGLETONS:
|
||||||
float-4-rep
|
float-4-rep
|
||||||
|
@ -39,7 +52,19 @@ uchar-16-rep
|
||||||
short-8-rep
|
short-8-rep
|
||||||
ushort-8-rep
|
ushort-8-rep
|
||||||
int-4-rep
|
int-4-rep
|
||||||
uint-4-rep ;
|
uint-4-rep
|
||||||
|
longlong-2-rep
|
||||||
|
ulonglong-2-rep ;
|
||||||
|
|
||||||
|
UNION: scalar-rep
|
||||||
|
char-scalar-rep
|
||||||
|
uchar-scalar-rep
|
||||||
|
short-scalar-rep
|
||||||
|
ushort-scalar-rep
|
||||||
|
int-scalar-rep
|
||||||
|
uint-scalar-rep
|
||||||
|
longlong-scalar-rep
|
||||||
|
ulonglong-scalar-rep ;
|
||||||
|
|
||||||
UNION: float-vector-rep
|
UNION: float-vector-rep
|
||||||
float-4-rep
|
float-4-rep
|
||||||
|
@ -55,7 +80,8 @@ tagged-rep
|
||||||
int-rep
|
int-rep
|
||||||
float-rep
|
float-rep
|
||||||
double-rep
|
double-rep
|
||||||
vector-rep ;
|
vector-rep
|
||||||
|
scalar-rep ;
|
||||||
|
|
||||||
! Register classes
|
! Register classes
|
||||||
SINGLETONS: int-regs float-regs ;
|
SINGLETONS: int-regs float-regs ;
|
||||||
|
@ -66,13 +92,18 @@ CONSTANT: reg-classes { int-regs float-regs }
|
||||||
! A pseudo-register class for parameters spilled on the stack
|
! A pseudo-register class for parameters spilled on the stack
|
||||||
SINGLETON: stack-params
|
SINGLETON: stack-params
|
||||||
|
|
||||||
|
! On x86, vectors and floats are stored in the same register bank
|
||||||
|
! On PowerPC they are distinct
|
||||||
|
HOOK: vector-regs cpu ( -- reg-class )
|
||||||
|
|
||||||
GENERIC: reg-class-of ( rep -- reg-class )
|
GENERIC: reg-class-of ( rep -- reg-class )
|
||||||
|
|
||||||
M: tagged-rep reg-class-of drop int-regs ;
|
M: tagged-rep reg-class-of drop int-regs ;
|
||||||
M: int-rep reg-class-of drop int-regs ;
|
M: int-rep reg-class-of drop int-regs ;
|
||||||
M: float-rep reg-class-of drop float-regs ;
|
M: float-rep reg-class-of drop float-regs ;
|
||||||
M: double-rep reg-class-of drop float-regs ;
|
M: double-rep reg-class-of drop float-regs ;
|
||||||
M: vector-rep reg-class-of drop float-regs ;
|
M: vector-rep reg-class-of drop vector-regs ;
|
||||||
|
M: scalar-rep reg-class-of drop vector-regs ;
|
||||||
M: stack-params reg-class-of drop stack-params ;
|
M: stack-params reg-class-of drop stack-params ;
|
||||||
|
|
||||||
GENERIC: rep-size ( rep -- n ) foldable
|
GENERIC: rep-size ( rep -- n ) foldable
|
||||||
|
@ -92,7 +123,14 @@ GENERIC: scalar-rep-of ( rep -- rep' )
|
||||||
|
|
||||||
M: float-4-rep scalar-rep-of drop float-rep ;
|
M: float-4-rep scalar-rep-of drop float-rep ;
|
||||||
M: double-2-rep scalar-rep-of drop double-rep ;
|
M: double-2-rep scalar-rep-of drop double-rep ;
|
||||||
M: int-vector-rep scalar-rep-of drop int-rep ;
|
M: char-16-rep scalar-rep-of drop char-scalar-rep ;
|
||||||
|
M: uchar-16-rep scalar-rep-of drop uchar-scalar-rep ;
|
||||||
|
M: short-8-rep scalar-rep-of drop short-scalar-rep ;
|
||||||
|
M: ushort-8-rep scalar-rep-of drop ushort-scalar-rep ;
|
||||||
|
M: int-4-rep scalar-rep-of drop int-scalar-rep ;
|
||||||
|
M: uint-4-rep scalar-rep-of drop uint-scalar-rep ;
|
||||||
|
M: longlong-2-rep scalar-rep-of drop longlong-scalar-rep ;
|
||||||
|
M: ulonglong-2-rep scalar-rep-of drop ulonglong-scalar-rep ;
|
||||||
|
|
||||||
! Mapping from register class to machine registers
|
! Mapping from register class to machine registers
|
||||||
HOOK: machine-registers cpu ( -- assoc )
|
HOOK: machine-registers cpu ( -- assoc )
|
||||||
|
@ -196,6 +234,11 @@ HOOK: %abs-vector cpu ( dst src rep -- )
|
||||||
HOOK: %and-vector cpu ( dst src1 src2 rep -- )
|
HOOK: %and-vector cpu ( dst src1 src2 rep -- )
|
||||||
HOOK: %or-vector cpu ( dst src1 src2 rep -- )
|
HOOK: %or-vector cpu ( dst src1 src2 rep -- )
|
||||||
HOOK: %xor-vector cpu ( dst src1 src2 rep -- )
|
HOOK: %xor-vector cpu ( dst src1 src2 rep -- )
|
||||||
|
HOOK: %shl-vector cpu ( dst src1 src2 rep -- )
|
||||||
|
HOOK: %shr-vector cpu ( dst src1 src2 rep -- )
|
||||||
|
|
||||||
|
HOOK: %integer>scalar cpu ( dst src rep -- )
|
||||||
|
HOOK: %scalar>integer cpu ( dst src rep -- )
|
||||||
|
|
||||||
HOOK: %broadcast-vector-reps cpu ( -- reps )
|
HOOK: %broadcast-vector-reps cpu ( -- reps )
|
||||||
HOOK: %gather-vector-2-reps cpu ( -- reps )
|
HOOK: %gather-vector-2-reps cpu ( -- reps )
|
||||||
|
@ -216,6 +259,8 @@ HOOK: %abs-vector-reps cpu ( -- reps )
|
||||||
HOOK: %and-vector-reps cpu ( -- reps )
|
HOOK: %and-vector-reps cpu ( -- reps )
|
||||||
HOOK: %or-vector-reps cpu ( -- reps )
|
HOOK: %or-vector-reps cpu ( -- reps )
|
||||||
HOOK: %xor-vector-reps cpu ( -- reps )
|
HOOK: %xor-vector-reps cpu ( -- reps )
|
||||||
|
HOOK: %shl-vector-reps cpu ( -- reps )
|
||||||
|
HOOK: %shr-vector-reps cpu ( -- reps )
|
||||||
|
|
||||||
HOOK: %unbox-alien cpu ( dst src -- )
|
HOOK: %unbox-alien cpu ( dst src -- )
|
||||||
HOOK: %unbox-any-c-ptr cpu ( dst src temp -- )
|
HOOK: %unbox-any-c-ptr cpu ( dst src temp -- )
|
||||||
|
|
|
@ -284,10 +284,12 @@ M:: ppc %float>integer ( dst src -- )
|
||||||
dst 1 4 scratch@ LWZ ;
|
dst 1 4 scratch@ LWZ ;
|
||||||
|
|
||||||
M: ppc %copy ( dst src rep -- )
|
M: ppc %copy ( dst src rep -- )
|
||||||
{
|
2over eq? [ 3drop ] [
|
||||||
{ int-rep [ MR ] }
|
{
|
||||||
{ double-rep [ FMR ] }
|
{ int-rep [ MR ] }
|
||||||
} case ;
|
{ double-rep [ FMR ] }
|
||||||
|
} case
|
||||||
|
] if ;
|
||||||
|
|
||||||
M: ppc %unbox-float ( dst src -- ) float-offset LFD ;
|
M: ppc %unbox-float ( dst src -- ) float-offset LFD ;
|
||||||
|
|
||||||
|
@ -299,7 +301,7 @@ M:: ppc %box-float ( dst src temp -- )
|
||||||
[ float-regs param-regs nth 1 ] [ n>> spill@ ] bi* LFD ;
|
[ float-regs param-regs nth 1 ] [ n>> spill@ ] bi* LFD ;
|
||||||
|
|
||||||
: float-function-return ( reg -- )
|
: float-function-return ( reg -- )
|
||||||
float-regs return-reg 2dup = [ 2drop ] [ FMR ] if ;
|
float-regs return-reg double-rep %copy ;
|
||||||
|
|
||||||
M:: ppc %unary-float-function ( dst src func -- )
|
M:: ppc %unary-float-function ( dst src func -- )
|
||||||
0 src float-function-param
|
0 src float-function-param
|
||||||
|
@ -313,9 +315,29 @@ M:: ppc %binary-float-function ( dst src1 src2 func -- )
|
||||||
dst float-function-return ;
|
dst float-function-return ;
|
||||||
|
|
||||||
! Internal format is always double-precision on PowerPC
|
! Internal format is always double-precision on PowerPC
|
||||||
M: ppc %single>double-float FMR ;
|
M: ppc %single>double-float double-rep %copy ;
|
||||||
|
M: ppc %double>single-float double-rep %copy ;
|
||||||
|
|
||||||
M: ppc %double>single-float FMR ;
|
! VMX/AltiVec not supported yet
|
||||||
|
M: ppc %broadcast-vector-reps { } ;
|
||||||
|
M: ppc %gather-vector-2-reps { } ;
|
||||||
|
M: ppc %gather-vector-4-reps { } ;
|
||||||
|
M: ppc %add-vector-reps { } ;
|
||||||
|
M: ppc %saturated-add-vector-reps { } ;
|
||||||
|
M: ppc %add-sub-vector-reps { } ;
|
||||||
|
M: ppc %sub-vector-reps { } ;
|
||||||
|
M: ppc %saturated-sub-vector-reps { } ;
|
||||||
|
M: ppc %mul-vector-reps { } ;
|
||||||
|
M: ppc %saturated-mul-vector-reps { } ;
|
||||||
|
M: ppc %div-vector-reps { } ;
|
||||||
|
M: ppc %min-vector-reps { } ;
|
||||||
|
M: ppc %max-vector-reps { } ;
|
||||||
|
M: ppc %sqrt-vector-reps { } ;
|
||||||
|
M: ppc %horizontal-add-vector-reps { } ;
|
||||||
|
M: ppc %abs-vector-reps { } ;
|
||||||
|
M: ppc %and-vector-reps { } ;
|
||||||
|
M: ppc %or-vector-reps { } ;
|
||||||
|
M: ppc %xor-vector-reps { } ;
|
||||||
|
|
||||||
M: ppc %unbox-alien ( dst src -- )
|
M: ppc %unbox-alien ( dst src -- )
|
||||||
alien-offset LWZ ;
|
alien-offset LWZ ;
|
||||||
|
|
|
@ -11,7 +11,7 @@ IN: bootstrap.x86
|
||||||
: shift-arg ( -- reg ) ECX ;
|
: shift-arg ( -- reg ) ECX ;
|
||||||
: div-arg ( -- reg ) EAX ;
|
: div-arg ( -- reg ) EAX ;
|
||||||
: mod-arg ( -- reg ) EDX ;
|
: mod-arg ( -- reg ) EDX ;
|
||||||
: arg ( -- reg ) EAX ;
|
: arg1 ( -- reg ) EAX ;
|
||||||
: arg2 ( -- reg ) EDX ;
|
: arg2 ( -- reg ) EDX ;
|
||||||
: temp0 ( -- reg ) EAX ;
|
: temp0 ( -- reg ) EAX ;
|
||||||
: temp1 ( -- reg ) EDX ;
|
: temp1 ( -- reg ) EDX ;
|
||||||
|
@ -29,7 +29,7 @@ IN: bootstrap.x86
|
||||||
! save stack pointer
|
! save stack pointer
|
||||||
temp0 [] stack-reg MOV
|
temp0 [] stack-reg MOV
|
||||||
! pass vm ptr to primitive
|
! pass vm ptr to primitive
|
||||||
arg 0 MOV rc-absolute-cell rt-vm jit-rel
|
arg1 0 MOV rc-absolute-cell rt-vm jit-rel
|
||||||
! call the primitive
|
! call the primitive
|
||||||
0 JMP rc-relative rt-primitive jit-rel
|
0 JMP rc-relative rt-primitive jit-rel
|
||||||
] jit-primitive jit-define
|
] jit-primitive jit-define
|
||||||
|
|
|
@ -58,9 +58,9 @@ M: stack-params copy-register*
|
||||||
{ [ over integer? ] [ R11 swap MOV param@ R11 MOV ] }
|
{ [ over integer? ] [ R11 swap MOV param@ R11 MOV ] }
|
||||||
} cond ;
|
} cond ;
|
||||||
|
|
||||||
M: x86 %save-param-reg [ param@ ] 2dip copy-register ;
|
M: x86 %save-param-reg [ param@ ] 2dip %copy ;
|
||||||
|
|
||||||
M: x86 %load-param-reg [ swap param@ ] dip copy-register ;
|
M: x86 %load-param-reg [ swap param@ ] dip %copy ;
|
||||||
|
|
||||||
: with-return-regs ( quot -- )
|
: with-return-regs ( quot -- )
|
||||||
[
|
[
|
||||||
|
@ -133,9 +133,7 @@ M:: x86.64 %unbox-large-struct ( n c-type -- )
|
||||||
[ [ 0 ] dip reg-class-of param-reg ]
|
[ [ 0 ] dip reg-class-of param-reg ]
|
||||||
[ reg-class-of return-reg ]
|
[ reg-class-of return-reg ]
|
||||||
[ ]
|
[ ]
|
||||||
tri copy-register ;
|
tri %copy ;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
M:: x86.64 %box ( n rep func -- )
|
M:: x86.64 %box ( n rep func -- )
|
||||||
n [
|
n [
|
||||||
|
@ -222,7 +220,7 @@ M: x86.64 %callback-value ( ctype -- )
|
||||||
[ float-regs param-regs nth ] [ n>> spill@ ] bi* MOVSD ;
|
[ float-regs param-regs nth ] [ n>> spill@ ] bi* MOVSD ;
|
||||||
|
|
||||||
: float-function-return ( reg -- )
|
: float-function-return ( reg -- )
|
||||||
float-regs return-reg double-rep copy-register ;
|
float-regs return-reg double-rep %copy ;
|
||||||
|
|
||||||
M:: x86.64 %unary-float-function ( dst src func -- )
|
M:: x86.64 %unary-float-function ( dst src func -- )
|
||||||
0 src float-function-param
|
0 src float-function-param
|
||||||
|
|
|
@ -21,7 +21,6 @@ IN: bootstrap.x86
|
||||||
: rex-length ( -- n ) 1 ;
|
: rex-length ( -- n ) 1 ;
|
||||||
|
|
||||||
[
|
[
|
||||||
|
|
||||||
! load stack_chain
|
! load stack_chain
|
||||||
temp0 0 MOV rc-absolute-cell rt-stack-chain jit-rel
|
temp0 0 MOV rc-absolute-cell rt-stack-chain jit-rel
|
||||||
temp0 temp0 [] MOV
|
temp0 temp0 [] MOV
|
||||||
|
@ -30,7 +29,7 @@ IN: bootstrap.x86
|
||||||
! load XT
|
! load XT
|
||||||
temp1 0 MOV rc-absolute-cell rt-primitive jit-rel
|
temp1 0 MOV rc-absolute-cell rt-primitive jit-rel
|
||||||
! load vm ptr
|
! load vm ptr
|
||||||
arg 0 MOV rc-absolute-cell rt-vm jit-rel
|
arg1 0 MOV rc-absolute-cell rt-vm jit-rel
|
||||||
! go
|
! go
|
||||||
temp1 JMP
|
temp1 JMP
|
||||||
] jit-primitive jit-define
|
] jit-primitive jit-define
|
||||||
|
|
|
@ -5,7 +5,7 @@ cpu.x86.assembler cpu.x86.assembler.operands layouts vocabs parser ;
|
||||||
IN: bootstrap.x86
|
IN: bootstrap.x86
|
||||||
|
|
||||||
: stack-frame-size ( -- n ) 4 bootstrap-cells ;
|
: stack-frame-size ( -- n ) 4 bootstrap-cells ;
|
||||||
: arg ( -- reg ) RDI ;
|
: arg1 ( -- reg ) RDI ;
|
||||||
: arg2 ( -- reg ) RSI ;
|
: arg2 ( -- reg ) RSI ;
|
||||||
|
|
||||||
<< "vocab:cpu/x86/64/bootstrap.factor" parse-file parsed >>
|
<< "vocab:cpu/x86/64/bootstrap.factor" parse-file parsed >>
|
||||||
|
|
|
@ -6,7 +6,7 @@ cpu.x86.assembler.operands ;
|
||||||
IN: bootstrap.x86
|
IN: bootstrap.x86
|
||||||
|
|
||||||
: stack-frame-size ( -- n ) 8 bootstrap-cells ;
|
: stack-frame-size ( -- n ) 8 bootstrap-cells ;
|
||||||
: arg ( -- reg ) RCX ;
|
: arg1 ( -- reg ) RCX ;
|
||||||
: arg2 ( -- reg ) RDX ;
|
: arg2 ( -- reg ) RDX ;
|
||||||
|
|
||||||
<< "vocab:cpu/x86/64/bootstrap.factor" parse-file parsed >>
|
<< "vocab:cpu/x86/64/bootstrap.factor" parse-file parsed >>
|
||||||
|
|
|
@ -198,12 +198,16 @@ M: register POP f HEX: 58 short-operand ;
|
||||||
M: operand POP { BIN: 000 f HEX: 8f } 1-operand ;
|
M: operand POP { BIN: 000 f HEX: 8f } 1-operand ;
|
||||||
|
|
||||||
! MOV where the src is immediate.
|
! MOV where the src is immediate.
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
GENERIC: (MOV-I) ( src dst -- )
|
GENERIC: (MOV-I) ( src dst -- )
|
||||||
M: register (MOV-I) t HEX: b8 short-operand cell, ;
|
M: register (MOV-I) t HEX: b8 short-operand cell, ;
|
||||||
M: operand (MOV-I)
|
M: operand (MOV-I)
|
||||||
{ BIN: 000 t HEX: c6 }
|
{ BIN: 000 t HEX: c6 }
|
||||||
pick byte? [ immediate-1 ] [ immediate-4 ] if ;
|
pick byte? [ immediate-1 ] [ immediate-4 ] if ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
GENERIC: MOV ( dst src -- )
|
GENERIC: MOV ( dst src -- )
|
||||||
M: immediate MOV swap (MOV-I) ;
|
M: immediate MOV swap (MOV-I) ;
|
||||||
M: operand MOV HEX: 88 2-operand ;
|
M: operand MOV HEX: 88 2-operand ;
|
||||||
|
@ -219,9 +223,13 @@ GENERIC: CALL ( op -- )
|
||||||
M: integer CALL HEX: e8 , 4, ;
|
M: integer CALL HEX: e8 , 4, ;
|
||||||
M: operand CALL { BIN: 010 t HEX: ff } 1-operand ;
|
M: operand CALL { BIN: 010 t HEX: ff } 1-operand ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
GENERIC# JUMPcc 1 ( addr opcode -- )
|
GENERIC# JUMPcc 1 ( addr opcode -- )
|
||||||
M: integer JUMPcc extended-opcode, 4, ;
|
M: integer JUMPcc extended-opcode, 4, ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
: JO ( dst -- ) HEX: 80 JUMPcc ;
|
: JO ( dst -- ) HEX: 80 JUMPcc ;
|
||||||
: JNO ( dst -- ) HEX: 81 JUMPcc ;
|
: JNO ( dst -- ) HEX: 81 JUMPcc ;
|
||||||
: JB ( dst -- ) HEX: 82 JUMPcc ;
|
: JB ( dst -- ) HEX: 82 JUMPcc ;
|
||||||
|
@ -296,6 +304,8 @@ M: operand TEST OCT: 204 2-operand ;
|
||||||
: CDQ ( -- ) HEX: 99 , ;
|
: CDQ ( -- ) HEX: 99 , ;
|
||||||
: CQO ( -- ) HEX: 48 , CDQ ;
|
: CQO ( -- ) HEX: 48 , CDQ ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
: (SHIFT) ( dst src op -- )
|
: (SHIFT) ( dst src op -- )
|
||||||
over CL eq? [
|
over CL eq? [
|
||||||
nip t HEX: d3 3array 1-operand
|
nip t HEX: d3 3array 1-operand
|
||||||
|
@ -303,6 +313,8 @@ M: operand TEST OCT: 204 2-operand ;
|
||||||
swapd t HEX: c0 3array immediate-1
|
swapd t HEX: c0 3array immediate-1
|
||||||
] if ; inline
|
] if ; inline
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
: ROL ( dst n -- ) BIN: 000 (SHIFT) ;
|
: ROL ( dst n -- ) BIN: 000 (SHIFT) ;
|
||||||
: ROR ( dst n -- ) BIN: 001 (SHIFT) ;
|
: ROR ( dst n -- ) BIN: 001 (SHIFT) ;
|
||||||
: RCL ( dst n -- ) BIN: 010 (SHIFT) ;
|
: RCL ( dst n -- ) BIN: 010 (SHIFT) ;
|
||||||
|
|
|
@ -0,0 +1,2 @@
|
||||||
|
Slava Pestov
|
||||||
|
Joe Groff
|
|
@ -0,0 +1 @@
|
||||||
|
x86 registers and memory operands
|
|
@ -248,13 +248,13 @@ big-endian off
|
||||||
! Quotations and words
|
! Quotations and words
|
||||||
[
|
[
|
||||||
! load from stack
|
! load from stack
|
||||||
arg ds-reg [] MOV
|
arg1 ds-reg [] MOV
|
||||||
! pop stack
|
! pop stack
|
||||||
ds-reg bootstrap-cell SUB
|
ds-reg bootstrap-cell SUB
|
||||||
! pass vm pointer
|
! pass vm pointer
|
||||||
arg2 0 MOV rc-absolute-cell rt-vm jit-rel
|
arg2 0 MOV rc-absolute-cell rt-vm jit-rel
|
||||||
! call quotation
|
! call quotation
|
||||||
arg quot-xt-offset [+] JMP
|
arg1 quot-xt-offset [+] JMP
|
||||||
] \ (call) define-sub-primitive
|
] \ (call) define-sub-primitive
|
||||||
|
|
||||||
! Objects
|
! Objects
|
||||||
|
|
|
@ -2,10 +2,10 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors assocs alien alien.c-types arrays strings
|
USING: accessors assocs alien alien.c-types arrays strings
|
||||||
cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands
|
cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands
|
||||||
cpu.architecture kernel kernel.private math memory namespaces make
|
cpu.x86.features cpu.x86.features.private cpu.architecture kernel
|
||||||
sequences words system layouts combinators math.order fry locals
|
kernel.private math memory namespaces make sequences words system
|
||||||
compiler.constants byte-arrays io macros quotations cpu.x86.features
|
layouts combinators math.order fry locals compiler.constants
|
||||||
cpu.x86.features.private compiler compiler.units init vm
|
byte-arrays io macros quotations compiler compiler.units init vm
|
||||||
compiler.cfg.registers
|
compiler.cfg.registers
|
||||||
compiler.cfg.instructions
|
compiler.cfg.instructions
|
||||||
compiler.cfg.intrinsics
|
compiler.cfg.intrinsics
|
||||||
|
@ -22,6 +22,8 @@ M: label JUMPcc [ 0 ] dip JUMPcc rc-relative label-fixup ;
|
||||||
|
|
||||||
M: x86 two-operand? t ;
|
M: x86 two-operand? t ;
|
||||||
|
|
||||||
|
M: x86 vector-regs float-regs ;
|
||||||
|
|
||||||
HOOK: stack-reg cpu ( -- reg )
|
HOOK: stack-reg cpu ( -- reg )
|
||||||
|
|
||||||
HOOK: reserved-area-size cpu ( -- n )
|
HOOK: reserved-area-size cpu ( -- n )
|
||||||
|
@ -140,11 +142,9 @@ M: float-4-rep copy-register* drop MOVUPS ;
|
||||||
M: double-2-rep copy-register* drop MOVUPD ;
|
M: double-2-rep copy-register* drop MOVUPD ;
|
||||||
M: vector-rep copy-register* drop MOVDQU ;
|
M: vector-rep copy-register* drop MOVDQU ;
|
||||||
|
|
||||||
: copy-register ( dst src rep -- )
|
M: x86 %copy ( dst src rep -- )
|
||||||
2over eq? [ 3drop ] [ copy-register* ] if ;
|
2over eq? [ 3drop ] [ copy-register* ] if ;
|
||||||
|
|
||||||
M: x86 %copy ( dst src rep -- ) copy-register ;
|
|
||||||
|
|
||||||
:: overflow-template ( label dst src1 src2 insn -- )
|
:: overflow-template ( label dst src1 src2 insn -- )
|
||||||
src1 src2 insn call
|
src1 src2 insn call
|
||||||
label JO ; inline
|
label JO ; inline
|
||||||
|
@ -243,11 +243,11 @@ M:: x86 %box-vector ( dst src rep temp -- )
|
||||||
dst rep rep-size 2 cells + byte-array temp %allot
|
dst rep rep-size 2 cells + byte-array temp %allot
|
||||||
16 tag-fixnum dst 1 byte-array tag-number %set-slot-imm
|
16 tag-fixnum dst 1 byte-array tag-number %set-slot-imm
|
||||||
dst byte-array-offset [+]
|
dst byte-array-offset [+]
|
||||||
src rep copy-register ;
|
src rep %copy ;
|
||||||
|
|
||||||
M:: x86 %unbox-vector ( dst src rep -- )
|
M:: x86 %unbox-vector ( dst src rep -- )
|
||||||
dst src byte-array-offset [+]
|
dst src byte-array-offset [+]
|
||||||
rep copy-register ;
|
rep %copy ;
|
||||||
|
|
||||||
MACRO: available-reps ( alist -- )
|
MACRO: available-reps ( alist -- )
|
||||||
! Each SSE version adds new representations and supports
|
! Each SSE version adds new representations and supports
|
||||||
|
@ -259,14 +259,15 @@ MACRO: available-reps ( alist -- )
|
||||||
|
|
||||||
M: x86 %broadcast-vector ( dst src rep -- )
|
M: x86 %broadcast-vector ( dst src rep -- )
|
||||||
{
|
{
|
||||||
{ float-4-rep [ [ MOVSS ] [ drop dup 0 SHUFPS ] 2bi ] }
|
{ float-4-rep [ [ float-4-rep %copy ] [ drop dup 0 SHUFPS ] 2bi ] }
|
||||||
{ double-2-rep [ [ MOVSD ] [ drop dup UNPCKLPD ] 2bi ] }
|
{ double-2-rep [ [ double-2-rep %copy ] [ drop dup UNPCKLPD ] 2bi ] }
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
M: x86 %broadcast-vector-reps
|
M: x86 %broadcast-vector-reps
|
||||||
{
|
{
|
||||||
{ sse? { float-4-rep } }
|
! Can't do this with sse1 since it will want to unbox
|
||||||
{ sse2? { double-2-rep } }
|
! a double-precision float and convert to single precision
|
||||||
|
{ sse2? { float-4-rep double-2-rep } }
|
||||||
} available-reps ;
|
} available-reps ;
|
||||||
|
|
||||||
M:: x86 %gather-vector-4 ( dst src1 src2 src3 src4 rep -- )
|
M:: x86 %gather-vector-4 ( dst src1 src2 src3 src4 rep -- )
|
||||||
|
@ -274,7 +275,7 @@ M:: x86 %gather-vector-4 ( dst src1 src2 src3 src4 rep -- )
|
||||||
{
|
{
|
||||||
float-4-rep
|
float-4-rep
|
||||||
[
|
[
|
||||||
dst src1 MOVSS
|
dst src1 float-4-rep %copy
|
||||||
dst src2 UNPCKLPS
|
dst src2 UNPCKLPS
|
||||||
src3 src4 UNPCKLPS
|
src3 src4 UNPCKLPS
|
||||||
dst src3 MOVLHPS
|
dst src3 MOVLHPS
|
||||||
|
@ -284,7 +285,9 @@ M:: x86 %gather-vector-4 ( dst src1 src2 src3 src4 rep -- )
|
||||||
|
|
||||||
M: x86 %gather-vector-4-reps
|
M: x86 %gather-vector-4-reps
|
||||||
{
|
{
|
||||||
{ sse? { float-4-rep } }
|
! Can't do this with sse1 since it will want to unbox
|
||||||
|
! double-precision floats and convert to single precision
|
||||||
|
{ sse2? { float-4-rep } }
|
||||||
} available-reps ;
|
} available-reps ;
|
||||||
|
|
||||||
M:: x86 %gather-vector-2 ( dst src1 src2 rep -- )
|
M:: x86 %gather-vector-2 ( dst src1 src2 rep -- )
|
||||||
|
@ -292,7 +295,7 @@ M:: x86 %gather-vector-2 ( dst src1 src2 rep -- )
|
||||||
{
|
{
|
||||||
double-2-rep
|
double-2-rep
|
||||||
[
|
[
|
||||||
dst src1 MOVSD
|
dst src1 double-2-rep %copy
|
||||||
dst src2 UNPCKLPD
|
dst src2 UNPCKLPD
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
@ -313,12 +316,14 @@ M: x86 %add-vector ( dst src1 src2 rep -- )
|
||||||
{ ushort-8-rep [ PADDW ] }
|
{ ushort-8-rep [ PADDW ] }
|
||||||
{ int-4-rep [ PADDD ] }
|
{ int-4-rep [ PADDD ] }
|
||||||
{ uint-4-rep [ PADDD ] }
|
{ uint-4-rep [ PADDD ] }
|
||||||
|
{ longlong-2-rep [ PADDQ ] }
|
||||||
|
{ ulonglong-2-rep [ PADDQ ] }
|
||||||
} case drop ;
|
} case drop ;
|
||||||
|
|
||||||
M: x86 %add-vector-reps
|
M: x86 %add-vector-reps
|
||||||
{
|
{
|
||||||
{ sse? { float-4-rep } }
|
{ sse? { float-4-rep } }
|
||||||
{ sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } }
|
{ sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
|
||||||
} available-reps ;
|
} available-reps ;
|
||||||
|
|
||||||
M: x86 %saturated-add-vector ( dst src1 src2 rep -- )
|
M: x86 %saturated-add-vector ( dst src1 src2 rep -- )
|
||||||
|
@ -355,12 +360,14 @@ M: x86 %sub-vector ( dst src1 src2 rep -- )
|
||||||
{ ushort-8-rep [ PSUBW ] }
|
{ ushort-8-rep [ PSUBW ] }
|
||||||
{ int-4-rep [ PSUBD ] }
|
{ int-4-rep [ PSUBD ] }
|
||||||
{ uint-4-rep [ PSUBD ] }
|
{ uint-4-rep [ PSUBD ] }
|
||||||
|
{ longlong-2-rep [ PSUBQ ] }
|
||||||
|
{ ulonglong-2-rep [ PSUBQ ] }
|
||||||
} case drop ;
|
} case drop ;
|
||||||
|
|
||||||
M: x86 %sub-vector-reps
|
M: x86 %sub-vector-reps
|
||||||
{
|
{
|
||||||
{ sse? { float-4-rep } }
|
{ sse? { float-4-rep } }
|
||||||
{ sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } }
|
{ sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
|
||||||
} available-reps ;
|
} available-reps ;
|
||||||
|
|
||||||
M: x86 %saturated-sub-vector ( dst src1 src2 rep -- )
|
M: x86 %saturated-sub-vector ( dst src1 src2 rep -- )
|
||||||
|
@ -389,7 +396,8 @@ M: x86 %mul-vector ( dst src1 src2 rep -- )
|
||||||
M: x86 %mul-vector-reps
|
M: x86 %mul-vector-reps
|
||||||
{
|
{
|
||||||
{ sse? { float-4-rep } }
|
{ sse? { float-4-rep } }
|
||||||
{ sse2? { double-2-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } }
|
{ sse2? { double-2-rep short-8-rep ushort-8-rep } }
|
||||||
|
{ sse4.1? { int-4-rep uint-4-rep } }
|
||||||
} available-reps ;
|
} available-reps ;
|
||||||
|
|
||||||
M: x86 %saturated-mul-vector-reps
|
M: x86 %saturated-mul-vector-reps
|
||||||
|
@ -448,8 +456,8 @@ M: x86 %max-vector-reps
|
||||||
|
|
||||||
M: x86 %horizontal-add-vector ( dst src rep -- )
|
M: x86 %horizontal-add-vector ( dst src rep -- )
|
||||||
{
|
{
|
||||||
{ float-4-rep [ [ MOVAPS ] [ HADDPS ] [ HADDPS ] 2tri ] }
|
{ float-4-rep [ [ float-4-rep %copy ] [ HADDPS ] [ HADDPS ] 2tri ] }
|
||||||
{ double-2-rep [ [ MOVAPD ] [ HADDPD ] 2bi ] }
|
{ double-2-rep [ [ double-2-rep %copy ] [ HADDPD ] 2bi ] }
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
M: x86 %horizontal-add-vector-reps
|
M: x86 %horizontal-add-vector-reps
|
||||||
|
@ -485,56 +493,74 @@ M: x86 %and-vector ( dst src1 src2 rep -- )
|
||||||
{
|
{
|
||||||
{ float-4-rep [ ANDPS ] }
|
{ float-4-rep [ ANDPS ] }
|
||||||
{ double-2-rep [ ANDPD ] }
|
{ double-2-rep [ ANDPD ] }
|
||||||
{ char-16-rep [ PAND ] }
|
[ drop PAND ]
|
||||||
{ uchar-16-rep [ PAND ] }
|
|
||||||
{ short-8-rep [ PAND ] }
|
|
||||||
{ ushort-8-rep [ PAND ] }
|
|
||||||
{ int-4-rep [ PAND ] }
|
|
||||||
{ uint-4-rep [ PAND ] }
|
|
||||||
} case drop ;
|
} case drop ;
|
||||||
|
|
||||||
M: x86 %and-vector-reps
|
M: x86 %and-vector-reps
|
||||||
{
|
{
|
||||||
{ sse? { float-4-rep } }
|
{ sse? { float-4-rep } }
|
||||||
{ sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } }
|
{ sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
|
||||||
} available-reps ;
|
} available-reps ;
|
||||||
|
|
||||||
M: x86 %or-vector ( dst src1 src2 rep -- )
|
M: x86 %or-vector ( dst src1 src2 rep -- )
|
||||||
{
|
{
|
||||||
{ float-4-rep [ ORPS ] }
|
{ float-4-rep [ ORPS ] }
|
||||||
{ double-2-rep [ ORPD ] }
|
{ double-2-rep [ ORPD ] }
|
||||||
{ char-16-rep [ POR ] }
|
[ drop POR ]
|
||||||
{ uchar-16-rep [ POR ] }
|
|
||||||
{ short-8-rep [ POR ] }
|
|
||||||
{ ushort-8-rep [ POR ] }
|
|
||||||
{ int-4-rep [ POR ] }
|
|
||||||
{ uint-4-rep [ POR ] }
|
|
||||||
} case drop ;
|
} case drop ;
|
||||||
|
|
||||||
M: x86 %or-vector-reps
|
M: x86 %or-vector-reps
|
||||||
{
|
{
|
||||||
{ sse? { float-4-rep } }
|
{ sse? { float-4-rep } }
|
||||||
{ sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } }
|
{ sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
|
||||||
} available-reps ;
|
} available-reps ;
|
||||||
|
|
||||||
M: x86 %xor-vector ( dst src1 src2 rep -- )
|
M: x86 %xor-vector ( dst src1 src2 rep -- )
|
||||||
{
|
{
|
||||||
{ float-4-rep [ XORPS ] }
|
{ float-4-rep [ XORPS ] }
|
||||||
{ double-2-rep [ XORPD ] }
|
{ double-2-rep [ XORPD ] }
|
||||||
{ char-16-rep [ PXOR ] }
|
[ drop PXOR ]
|
||||||
{ uchar-16-rep [ PXOR ] }
|
|
||||||
{ short-8-rep [ PXOR ] }
|
|
||||||
{ ushort-8-rep [ PXOR ] }
|
|
||||||
{ int-4-rep [ PXOR ] }
|
|
||||||
{ uint-4-rep [ PXOR ] }
|
|
||||||
} case drop ;
|
} case drop ;
|
||||||
|
|
||||||
M: x86 %xor-vector-reps
|
M: x86 %xor-vector-reps
|
||||||
{
|
{
|
||||||
{ sse? { float-4-rep } }
|
{ sse? { float-4-rep } }
|
||||||
{ sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } }
|
{ sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
|
||||||
} available-reps ;
|
} available-reps ;
|
||||||
|
|
||||||
|
M: x86 %shl-vector ( dst src1 src2 rep -- )
|
||||||
|
{
|
||||||
|
{ short-8-rep [ PSLLW ] }
|
||||||
|
{ ushort-8-rep [ PSLLW ] }
|
||||||
|
{ int-4-rep [ PSLLD ] }
|
||||||
|
{ uint-4-rep [ PSLLD ] }
|
||||||
|
{ longlong-2-rep [ PSLLQ ] }
|
||||||
|
{ ulonglong-2-rep [ PSLLQ ] }
|
||||||
|
} case drop ;
|
||||||
|
|
||||||
|
M: x86 %shl-vector-reps
|
||||||
|
{
|
||||||
|
{ sse2? { short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
|
||||||
|
} available-reps ;
|
||||||
|
|
||||||
|
M: x86 %shr-vector ( dst src1 src2 rep -- )
|
||||||
|
{
|
||||||
|
{ short-8-rep [ PSRAW ] }
|
||||||
|
{ ushort-8-rep [ PSRLW ] }
|
||||||
|
{ int-4-rep [ PSRAD ] }
|
||||||
|
{ uint-4-rep [ PSRLD ] }
|
||||||
|
{ ulonglong-2-rep [ PSRLQ ] }
|
||||||
|
} case drop ;
|
||||||
|
|
||||||
|
M: x86 %shr-vector-reps
|
||||||
|
{
|
||||||
|
{ sse2? { short-8-rep ushort-8-rep int-4-rep uint-4-rep ulonglong-2-rep } }
|
||||||
|
} available-reps ;
|
||||||
|
|
||||||
|
M: x86 %integer>scalar drop MOVD ;
|
||||||
|
|
||||||
|
M: x86 %scalar>integer drop MOVD ;
|
||||||
|
|
||||||
M: x86 %unbox-alien ( dst src -- )
|
M: x86 %unbox-alien ( dst src -- )
|
||||||
alien-offset [+] MOV ;
|
alien-offset [+] MOV ;
|
||||||
|
|
||||||
|
@ -648,9 +674,6 @@ M: x86.64 has-small-reg? 2drop t ;
|
||||||
[ quot call ] with-save/restore
|
[ quot call ] with-save/restore
|
||||||
] if ; inline
|
] if ; inline
|
||||||
|
|
||||||
: ?MOV ( dst src -- )
|
|
||||||
2dup = [ 2drop ] [ MOV ] if ; inline
|
|
||||||
|
|
||||||
M:: x86 %string-nth ( dst src index temp -- )
|
M:: x86 %string-nth ( dst src index temp -- )
|
||||||
! We request a small-reg of size 8 since those of size 16 are
|
! We request a small-reg of size 8 since those of size 16 are
|
||||||
! a superset.
|
! a superset.
|
||||||
|
@ -678,12 +701,12 @@ M:: x86 %string-nth ( dst src index temp -- )
|
||||||
! Compute code point
|
! Compute code point
|
||||||
new-dst temp XOR
|
new-dst temp XOR
|
||||||
"end" resolve-label
|
"end" resolve-label
|
||||||
dst new-dst ?MOV
|
dst new-dst int-rep %copy
|
||||||
] with-small-register ;
|
] with-small-register ;
|
||||||
|
|
||||||
M:: x86 %set-string-nth-fast ( ch str index temp -- )
|
M:: x86 %set-string-nth-fast ( ch str index temp -- )
|
||||||
ch { index str temp } 8 [| new-ch |
|
ch { index str temp } 8 [| new-ch |
|
||||||
new-ch ch ?MOV
|
new-ch ch int-rep %copy
|
||||||
temp str index [+] LEA
|
temp str index [+] LEA
|
||||||
temp string-offset [+] new-ch 8-bit-version-of MOV
|
temp string-offset [+] new-ch 8-bit-version-of MOV
|
||||||
] with-small-register ;
|
] with-small-register ;
|
||||||
|
@ -692,7 +715,7 @@ M:: x86 %set-string-nth-fast ( ch str index temp -- )
|
||||||
dst { src } size [| new-dst |
|
dst { src } size [| new-dst |
|
||||||
new-dst dup size n-bit-version-of dup src [] MOV
|
new-dst dup size n-bit-version-of dup src [] MOV
|
||||||
quot call
|
quot call
|
||||||
dst new-dst ?MOV
|
dst new-dst int-rep %copy
|
||||||
] with-small-register ; inline
|
] with-small-register ; inline
|
||||||
|
|
||||||
: %alien-unsigned-getter ( dst src size -- )
|
: %alien-unsigned-getter ( dst src size -- )
|
||||||
|
@ -712,11 +735,11 @@ M: x86 %alien-signed-4 32 %alien-signed-getter ;
|
||||||
M: x86 %alien-cell [] MOV ;
|
M: x86 %alien-cell [] MOV ;
|
||||||
M: x86 %alien-float [] MOVSS ;
|
M: x86 %alien-float [] MOVSS ;
|
||||||
M: x86 %alien-double [] MOVSD ;
|
M: x86 %alien-double [] MOVSD ;
|
||||||
M: x86 %alien-vector [ [] ] dip copy-register ;
|
M: x86 %alien-vector [ [] ] dip %copy ;
|
||||||
|
|
||||||
:: %alien-integer-setter ( ptr value size -- )
|
:: %alien-integer-setter ( ptr value size -- )
|
||||||
value { ptr } size [| new-value |
|
value { ptr } size [| new-value |
|
||||||
new-value value ?MOV
|
new-value value int-rep %copy
|
||||||
ptr [] new-value size n-bit-version-of MOV
|
ptr [] new-value size n-bit-version-of MOV
|
||||||
] with-small-register ; inline
|
] with-small-register ; inline
|
||||||
|
|
||||||
|
@ -726,7 +749,7 @@ M: x86 %set-alien-integer-4 32 %alien-integer-setter ;
|
||||||
M: x86 %set-alien-cell [ [] ] dip MOV ;
|
M: x86 %set-alien-cell [ [] ] dip MOV ;
|
||||||
M: x86 %set-alien-float [ [] ] dip MOVSS ;
|
M: x86 %set-alien-float [ [] ] dip MOVSS ;
|
||||||
M: x86 %set-alien-double [ [] ] dip MOVSD ;
|
M: x86 %set-alien-double [ [] ] dip MOVSD ;
|
||||||
M: x86 %set-alien-vector [ [] ] 2dip copy-register ;
|
M: x86 %set-alien-vector [ [] ] 2dip %copy ;
|
||||||
|
|
||||||
: shift-count? ( reg -- ? ) { ECX RCX } memq? ;
|
: shift-count? ( reg -- ? ) { ECX RCX } memq? ;
|
||||||
|
|
||||||
|
@ -931,10 +954,10 @@ M: x86 %compare-float-unordered-branch ( label src1 src2 cc -- )
|
||||||
\ UCOMISD (%compare-float-branch) ;
|
\ UCOMISD (%compare-float-branch) ;
|
||||||
|
|
||||||
M:: x86 %spill ( src rep n -- )
|
M:: x86 %spill ( src rep n -- )
|
||||||
n spill@ src rep copy-register ;
|
n spill@ src rep %copy ;
|
||||||
|
|
||||||
M:: x86 %reload ( dst rep n -- )
|
M:: x86 %reload ( dst rep n -- )
|
||||||
dst n spill@ rep copy-register ;
|
dst n spill@ rep %copy ;
|
||||||
|
|
||||||
M: x86 %loop-entry 16 code-alignment [ NOP ] times ;
|
M: x86 %loop-entry 16 code-alignment [ NOP ] times ;
|
||||||
|
|
||||||
|
|
|
@ -1,8 +1,8 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: assocs classes.predicate fry generic io.pathnames kernel
|
USING: assocs classes.predicate fry generic help.topics
|
||||||
macros sequences vocabs words words.symbol words.constant
|
io.pathnames kernel lexer macros namespaces parser sequences
|
||||||
lexer parser help.topics help.markup namespaces sorting ;
|
vocabs words words.constant words.symbol ;
|
||||||
IN: definitions.icons
|
IN: definitions.icons
|
||||||
|
|
||||||
GENERIC: definition-icon ( definition -- path )
|
GENERIC: definition-icon ( definition -- path )
|
||||||
|
@ -41,10 +41,3 @@ ICON: topic help-article
|
||||||
ICON: runnable-vocab runnable-vocab
|
ICON: runnable-vocab runnable-vocab
|
||||||
ICON: vocab open-vocab
|
ICON: vocab open-vocab
|
||||||
ICON: vocab-link unopen-vocab
|
ICON: vocab-link unopen-vocab
|
||||||
|
|
||||||
: $definition-icons ( element -- )
|
|
||||||
drop
|
|
||||||
icons get >alist sort-keys
|
|
||||||
[ [ <$link> ] [ definition-icon-path <$image> ] bi* swap ] assoc-map
|
|
||||||
{ "" "Definition class" } prefix
|
|
||||||
$table ;
|
|
|
@ -3,17 +3,13 @@ IN: grouping
|
||||||
|
|
||||||
ARTICLE: "grouping" "Groups and clumps"
|
ARTICLE: "grouping" "Groups and clumps"
|
||||||
"Splitting a sequence into disjoint, fixed-length subsequences:"
|
"Splitting a sequence into disjoint, fixed-length subsequences:"
|
||||||
{ $subsection group }
|
{ $subsections group }
|
||||||
"A virtual sequence for splitting a sequence into disjoint, fixed-length subsequences:"
|
"A virtual sequence for splitting a sequence into disjoint, fixed-length subsequences:"
|
||||||
{ $subsection groups }
|
{ $subsections groups <groups> <sliced-groups> }
|
||||||
{ $subsection <groups> }
|
|
||||||
{ $subsection <sliced-groups> }
|
|
||||||
"Splitting a sequence into overlapping, fixed-length subsequences:"
|
"Splitting a sequence into overlapping, fixed-length subsequences:"
|
||||||
{ $subsection clump }
|
{ $subsections clump }
|
||||||
"A virtual sequence for splitting a sequence into overlapping, fixed-length subsequences:"
|
"A virtual sequence for splitting a sequence into overlapping, fixed-length subsequences:"
|
||||||
{ $subsection clumps }
|
{ $subsections clumps <clumps> <sliced-clumps> }
|
||||||
{ $subsection <clumps> }
|
|
||||||
{ $subsection <sliced-clumps> }
|
|
||||||
"The difference can be summarized as the following:"
|
"The difference can be summarized as the following:"
|
||||||
{ $list
|
{ $list
|
||||||
{ "With groups, the subsequences form the original sequence when concatenated:"
|
{ "With groups, the subsequences form the original sequence when concatenated:"
|
||||||
|
@ -29,11 +25,11 @@ ARTICLE: "grouping" "Groups and clumps"
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
$nl
|
||||||
"A combinator built using clumps:"
|
"A combinator built using clumps:"
|
||||||
{ $subsection monotonic? }
|
{ $subsections monotonic? }
|
||||||
"Testing how elements are related:"
|
"Testing how elements are related:"
|
||||||
{ $subsection all-eq? }
|
{ $subsections all-eq? all-equal? } ;
|
||||||
{ $subsection all-equal? } ;
|
|
||||||
|
|
||||||
ABOUT: "grouping"
|
ABOUT: "grouping"
|
||||||
|
|
||||||
|
|
|
@ -10,7 +10,7 @@ IN: help.crossref
|
||||||
collect-elements [ >link ] map ;
|
collect-elements [ >link ] map ;
|
||||||
|
|
||||||
: article-children ( topic -- seq )
|
: article-children ( topic -- seq )
|
||||||
{ $subsection } article-links ;
|
{ $subsection $subsections } article-links ;
|
||||||
|
|
||||||
: help-path ( topic -- seq )
|
: help-path ( topic -- seq )
|
||||||
[ article-parent ] follow rest ;
|
[ article-parent ] follow rest ;
|
||||||
|
|
|
@ -148,9 +148,30 @@ HELP: :help
|
||||||
|
|
||||||
HELP: $subsection
|
HELP: $subsection
|
||||||
{ $values { "element" "a markup element of the form " { $snippet "{ topic }" } } }
|
{ $values { "element" "a markup element of the form " { $snippet "{ topic }" } } }
|
||||||
{ $description "Prints a large clickable link to the help topic named by the first string element of " { $snippet "element" } "." }
|
{ $description "Prints a large clickable link to the help topic named by the first item in " { $snippet "element" } ". The link is printed along with its associated definition icon." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $code "{ $subsection \"sequences\" }" }
|
{ $markup-example { $subsection "sequences" } }
|
||||||
|
{ $markup-example { $subsection nth } }
|
||||||
|
{ $markup-example { $subsection each } }
|
||||||
|
} ;
|
||||||
|
|
||||||
|
HELP: $subsections
|
||||||
|
{ $values { "children" "a " { $link sequence } " of one or more " { $link topic } "s or, in the case of a help article, the article's string name." } }
|
||||||
|
{ $description "Prints a large clickable link for each of the listed help topics in " { $snippet "children" } ". The link is printed along with its associated definition icon." }
|
||||||
|
{ $examples
|
||||||
|
{ $markup-example { $subsections "sequences" nth each } }
|
||||||
|
} ;
|
||||||
|
|
||||||
|
{ $subsection $subsections $link } related-words
|
||||||
|
|
||||||
|
HELP: $vocab-subsection
|
||||||
|
{ $values { "element" "a markup element of the form " { $snippet "{ title vocab }" } } }
|
||||||
|
{ $description "Prints a large clickable link for " { $snippet "vocab" } ". If " { $snippet "vocab" } " has a main help article, the link will point at that article and the " { $snippet "title" } " input will be ignored. Otherwise, the link text will be taken from " { $snippet "title" } " and point to " { $snippet "vocab" } "'s automatically generated documentation."
|
||||||
|
$nl
|
||||||
|
"The link will be printed along with its associated definition icon." }
|
||||||
|
{ $examples
|
||||||
|
{ $markup-example { $vocab-subsection "SQLite" "db.sqlite" } }
|
||||||
|
{ $markup-example { $vocab-subsection "Alien" "alien" } }
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: $index
|
HELP: $index
|
||||||
|
|
|
@ -125,7 +125,7 @@ M: word set-article-parent swap "help-parent" set-word-prop ;
|
||||||
: print-topic ( topic -- )
|
: print-topic ( topic -- )
|
||||||
>link
|
>link
|
||||||
last-element off
|
last-element off
|
||||||
[ $title ] [ article-content print-content nl ] bi ;
|
[ $title ] [ nl article-content print-content nl ] bi ;
|
||||||
|
|
||||||
SYMBOL: help-hook
|
SYMBOL: help-hook
|
||||||
|
|
||||||
|
|
|
@ -1,10 +1,11 @@
|
||||||
! Copyright (C) 2005, 2009 Slava Pestov.
|
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors arrays definitions generic io kernel assocs
|
USING: accessors arrays assocs classes colors.constants
|
||||||
hashtables namespaces make parser prettyprint sequences strings
|
combinators definitions definitions.icons effects fry generic
|
||||||
io.styles vectors words math sorting splitting classes slots fry
|
hashtables help.stylesheet help.topics io io.styles kernel make
|
||||||
sets vocabs help.stylesheet help.topics vocabs.loader quotations
|
math namespaces parser present prettyprint
|
||||||
combinators see present ;
|
prettyprint.stylesheet quotations see sequences sets slots
|
||||||
|
sorting splitting strings vectors vocabs vocabs.loader words ;
|
||||||
FROM: prettyprint.sections => with-pprint ;
|
FROM: prettyprint.sections => with-pprint ;
|
||||||
IN: help.markup
|
IN: help.markup
|
||||||
|
|
||||||
|
@ -70,7 +71,7 @@ ALIAS: $slot $snippet
|
||||||
] ($span) ;
|
] ($span) ;
|
||||||
|
|
||||||
: $nl ( children -- )
|
: $nl ( children -- )
|
||||||
nl nl drop ;
|
nl last-block? [ nl ] unless drop ;
|
||||||
|
|
||||||
! Some blocks
|
! Some blocks
|
||||||
: ($heading) ( children quot -- )
|
: ($heading) ( children quot -- )
|
||||||
|
@ -156,45 +157,73 @@ ALIAS: $slot $snippet
|
||||||
: write-link ( string object -- )
|
: write-link ( string object -- )
|
||||||
link-style get [ write-object ] with-style ;
|
link-style get [ write-object ] with-style ;
|
||||||
|
|
||||||
: ($link) ( article -- )
|
: link-icon ( topic -- )
|
||||||
[ [ article-name ] [ >link ] bi write-link ] ($span) ;
|
definition-icon 1array $image ;
|
||||||
|
|
||||||
: $link ( element -- )
|
: link-text ( topic -- )
|
||||||
first ($link) ;
|
|
||||||
|
|
||||||
: ($definition-link) ( word -- )
|
|
||||||
[ article-name ] keep write-link ;
|
[ article-name ] keep write-link ;
|
||||||
|
|
||||||
: $definition-link ( element -- )
|
: link-effect ( topic -- )
|
||||||
first ($definition-link) ;
|
dup word? [
|
||||||
|
stack-effect [ effect>string ] [ effect-style ] bi
|
||||||
|
[ write ] with-style
|
||||||
|
] [ drop ] if ;
|
||||||
|
|
||||||
: ($long-link) ( object -- )
|
: inter-cleave ( x seq between -- )
|
||||||
[ article-title ] [ >link ] bi write-link ;
|
[ [ call( x -- ) ] with ] dip swap interleave ; inline
|
||||||
|
|
||||||
: $long-link ( object -- )
|
: (($link)) ( topic words -- )
|
||||||
first ($long-link) ;
|
[ dup topic? [ >link ] unless ] dip
|
||||||
|
[ [ bl ] inter-cleave ] ($span) ; inline
|
||||||
|
|
||||||
|
: ($link) ( topic -- )
|
||||||
|
{ [ link-text ] } (($link)) ;
|
||||||
|
|
||||||
|
: $link ( element -- ) first ($link) ;
|
||||||
|
|
||||||
|
: ($long-link) ( topic -- )
|
||||||
|
{ [ link-text ] [ link-effect ] } (($link)) ;
|
||||||
|
|
||||||
|
: $long-link ( element -- ) first ($long-link) ;
|
||||||
|
|
||||||
|
: ($pretty-link) ( topic -- )
|
||||||
|
{ [ link-icon ] [ link-text ] } (($link)) ;
|
||||||
|
|
||||||
|
: $pretty-link ( element -- ) first ($pretty-link) ;
|
||||||
|
|
||||||
|
: ($long-pretty-link) ( topic -- )
|
||||||
|
{ [ link-icon ] [ link-text ] [ link-effect ] } (($link)) ;
|
||||||
|
|
||||||
|
: $long-pretty-link ( element -- ) first ($long-pretty-link) ;
|
||||||
|
|
||||||
|
: <$pretty-link> ( definition -- element )
|
||||||
|
1array \ $pretty-link prefix ;
|
||||||
|
|
||||||
: ($subsection) ( element quot -- )
|
: ($subsection) ( element quot -- )
|
||||||
[
|
[
|
||||||
subsection-style get [
|
subsection-style get [ call ] with-style
|
||||||
bullet get write bl
|
|
||||||
call
|
|
||||||
] with-style
|
|
||||||
] ($block) ; inline
|
] ($block) ; inline
|
||||||
|
|
||||||
|
: $subsection* ( topic -- )
|
||||||
|
[
|
||||||
|
[ ($long-pretty-link) ] with-scope
|
||||||
|
] ($subsection) ;
|
||||||
|
|
||||||
|
: $subsections ( children -- )
|
||||||
|
[ $subsection* ] each nl ;
|
||||||
|
|
||||||
: $subsection ( element -- )
|
: $subsection ( element -- )
|
||||||
[ first ($long-link) ] ($subsection) ;
|
first $subsection* ;
|
||||||
|
|
||||||
: ($vocab-link) ( text vocab -- )
|
: ($vocab-link) ( text vocab -- )
|
||||||
>vocab-link write-link ;
|
>vocab-link write-link ;
|
||||||
|
|
||||||
: $vocab-subsection ( element -- )
|
: $vocab-subsection ( element -- )
|
||||||
[
|
[
|
||||||
first2 dup vocab-help dup [
|
first2 dup vocab-help
|
||||||
2nip ($long-link)
|
[ 2nip ($long-pretty-link) ]
|
||||||
] [
|
[ [ >vocab-link link-icon bl ] [ ($vocab-link) ] bi ]
|
||||||
drop ($vocab-link)
|
if*
|
||||||
] if
|
|
||||||
] ($subsection) ;
|
] ($subsection) ;
|
||||||
|
|
||||||
: $vocab-link ( element -- )
|
: $vocab-link ( element -- )
|
||||||
|
@ -390,3 +419,10 @@ M: array elements*
|
||||||
|
|
||||||
: <$snippet> ( str -- element )
|
: <$snippet> ( str -- element )
|
||||||
1array \ $snippet prefix ;
|
1array \ $snippet prefix ;
|
||||||
|
|
||||||
|
: $definition-icons ( element -- )
|
||||||
|
drop
|
||||||
|
icons get >alist sort-keys
|
||||||
|
[ [ <$link> ] [ definition-icon-path <$image> ] bi* swap ] assoc-map
|
||||||
|
{ "" "Definition class" } prefix
|
||||||
|
$table ;
|
|
@ -3,25 +3,17 @@
|
||||||
USING: accessors arrays assocs classes classes.builtin
|
USING: accessors arrays assocs classes classes.builtin
|
||||||
classes.intersection classes.mixin classes.predicate
|
classes.intersection classes.mixin classes.predicate
|
||||||
classes.singleton classes.tuple classes.union combinators
|
classes.singleton classes.tuple classes.union combinators
|
||||||
definitions effects fry generic help help.markup help.stylesheet
|
effects fry generic help help.markup help.stylesheet
|
||||||
help.topics io io.files io.pathnames io.styles kernel macros
|
help.topics io io.pathnames io.styles kernel macros make
|
||||||
make namespaces prettyprint sequences sets sorting summary
|
namespaces sequences sorting summary vocabs vocabs.files
|
||||||
vocabs vocabs.files vocabs.hierarchy vocabs.loader
|
vocabs.hierarchy vocabs.loader vocabs.metadata words
|
||||||
vocabs.metadata words words.symbol definitions.icons ;
|
words.symbol ;
|
||||||
FROM: vocabs.hierarchy => child-vocabs ;
|
FROM: vocabs.hierarchy => child-vocabs ;
|
||||||
IN: help.vocabs
|
IN: help.vocabs
|
||||||
|
|
||||||
: about ( vocab -- )
|
: about ( vocab -- )
|
||||||
[ require ] [ vocab help ] bi ;
|
[ require ] [ vocab help ] bi ;
|
||||||
|
|
||||||
: $pretty-link ( element -- )
|
|
||||||
[ first definition-icon 1array $image " " print-element ]
|
|
||||||
[ $definition-link ]
|
|
||||||
bi ;
|
|
||||||
|
|
||||||
: <$pretty-link> ( definition -- element )
|
|
||||||
1array \ $pretty-link prefix ;
|
|
||||||
|
|
||||||
: vocab-row ( vocab -- row )
|
: vocab-row ( vocab -- row )
|
||||||
[ <$pretty-link> ] [ vocab-summary ] bi 2array ;
|
[ <$pretty-link> ] [ vocab-summary ] bi 2array ;
|
||||||
|
|
||||||
|
|
|
@ -22,3 +22,6 @@ IN: html
|
||||||
|
|
||||||
: simple-link ( xml url -- xml' )
|
: simple-link ( xml url -- xml' )
|
||||||
url-encode swap [XML <a href=<->><-></a> XML] ;
|
url-encode swap [XML <a href=<->><-></a> XML] ;
|
||||||
|
|
||||||
|
: simple-image ( url -- xml )
|
||||||
|
url-encode [XML <img src=<-> /> XML] ;
|
|
@ -61,4 +61,12 @@ M: funky url-of "http://www.funky-town.com/" swap town>> append ;
|
||||||
[ H{ } [ ] with-nesting nl ] make-html-string
|
[ H{ } [ ] with-nesting nl ] make-html-string
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ ] [ [ { 1 2 3 } describe ] with-html-writer drop ] unit-test
|
[ ] [ [ { 1 2 3 } describe ] with-html-writer drop ] unit-test
|
||||||
|
|
||||||
|
[ "<img src=\"/icons/class-word.tiff\"/>" ] [
|
||||||
|
[
|
||||||
|
"text"
|
||||||
|
{ { image "vocab:definitions/icons/class-word.tiff" } }
|
||||||
|
format
|
||||||
|
] make-html-string
|
||||||
|
] unit-test
|
||||||
|
|
|
@ -1,8 +1,9 @@
|
||||||
! Copyright (C) 2004, 2009 Slava Pestov.
|
! Copyright (C) 2004, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors kernel assocs io io.styles math math.order math.parser
|
USING: accessors assocs combinators destructors fry html io
|
||||||
sequences strings make words combinators macros xml.syntax html fry
|
io.backend io.pathnames io.styles kernel macros make math
|
||||||
destructors ;
|
math.order math.parser namespaces sequences strings words
|
||||||
|
splitting xml xml.syntax ;
|
||||||
IN: html.streams
|
IN: html.streams
|
||||||
|
|
||||||
GENERIC: url-of ( object -- url )
|
GENERIC: url-of ( object -- url )
|
||||||
|
@ -87,9 +88,21 @@ MACRO: make-css ( pairs -- str )
|
||||||
: emit-html ( quot stream -- )
|
: emit-html ( quot stream -- )
|
||||||
dip data>> push ; inline
|
dip data>> push ; inline
|
||||||
|
|
||||||
|
: image-path ( path -- images-path )
|
||||||
|
"vocab:definitions/icons/" ?head [ "/icons/" prepend ] when ;
|
||||||
|
|
||||||
|
: img-tag ( xml style -- xml )
|
||||||
|
image swap at [ nip image-path simple-image ] when* ;
|
||||||
|
|
||||||
: format-html-span ( string style stream -- )
|
: format-html-span ( string style stream -- )
|
||||||
[ [ span-tag ] [ href-link-tag ] [ object-link-tag ] tri ]
|
[
|
||||||
emit-html ;
|
{
|
||||||
|
[ span-tag ]
|
||||||
|
[ href-link-tag ]
|
||||||
|
[ object-link-tag ]
|
||||||
|
[ img-tag ]
|
||||||
|
} cleave
|
||||||
|
] emit-html ;
|
||||||
|
|
||||||
TUPLE: html-span-stream < html-sub-stream ;
|
TUPLE: html-span-stream < html-sub-stream ;
|
||||||
|
|
||||||
|
|
|
@ -8,7 +8,7 @@ f describe
|
||||||
H{ } describe
|
H{ } describe
|
||||||
H{ } describe
|
H{ } describe
|
||||||
|
|
||||||
[ "fixnum instance\n\n" ] [ [ 3 describe ] with-string-writer ] unit-test
|
[ "fixnum\n\n" ] [ [ 3 describe ] with-string-writer ] unit-test
|
||||||
|
|
||||||
[ ] [ H{ } clone inspect ] unit-test
|
[ ] [ H{ } clone inspect ] unit-test
|
||||||
|
|
||||||
|
|
|
@ -3,103 +3,91 @@ sequences quotations math.functions.private ;
|
||||||
IN: math.functions
|
IN: math.functions
|
||||||
|
|
||||||
ARTICLE: "integer-functions" "Integer functions"
|
ARTICLE: "integer-functions" "Integer functions"
|
||||||
{ $subsection align }
|
{ $subsections
|
||||||
{ $subsection gcd }
|
align
|
||||||
{ $subsection log2 }
|
gcd
|
||||||
{ $subsection next-power-of-2 }
|
log2
|
||||||
|
next-power-of-2
|
||||||
|
}
|
||||||
"Modular exponentiation:"
|
"Modular exponentiation:"
|
||||||
{ $subsection ^mod }
|
{ $subsections ^mod mod-inv }
|
||||||
{ $subsection mod-inv }
|
|
||||||
"Tests:"
|
"Tests:"
|
||||||
{ $subsection power-of-2? }
|
{ $subsections
|
||||||
{ $subsection even? }
|
power-of-2?
|
||||||
{ $subsection odd? }
|
even?
|
||||||
{ $subsection divisor? } ;
|
odd?
|
||||||
|
divisor?
|
||||||
|
} ;
|
||||||
|
|
||||||
ARTICLE: "arithmetic-functions" "Arithmetic functions"
|
ARTICLE: "arithmetic-functions" "Arithmetic functions"
|
||||||
"Computing additive and multiplicative inverses:"
|
"Computing additive and multiplicative inverses:"
|
||||||
{ $subsection neg }
|
{ $subsections neg recip }
|
||||||
{ $subsection recip }
|
|
||||||
"Complex conjugation:"
|
"Complex conjugation:"
|
||||||
{ $subsection conjugate }
|
{ $subsections conjugate }
|
||||||
"Tests:"
|
"Tests:"
|
||||||
{ $subsection zero? }
|
{ $subsections zero? between? }
|
||||||
{ $subsection between? }
|
|
||||||
"Control flow:"
|
"Control flow:"
|
||||||
{ $subsection if-zero }
|
{ $subsections
|
||||||
{ $subsection when-zero }
|
if-zero
|
||||||
{ $subsection unless-zero }
|
when-zero
|
||||||
|
unless-zero
|
||||||
|
}
|
||||||
"Sign:"
|
"Sign:"
|
||||||
{ $subsection sgn }
|
{ $subsections sgn }
|
||||||
"Rounding:"
|
"Rounding:"
|
||||||
{ $subsection ceiling }
|
{ $subsections
|
||||||
{ $subsection floor }
|
ceiling
|
||||||
{ $subsection truncate }
|
floor
|
||||||
{ $subsection round }
|
truncate
|
||||||
|
round
|
||||||
|
}
|
||||||
"Inexact comparison:"
|
"Inexact comparison:"
|
||||||
{ $subsection ~ }
|
{ $subsections ~ }
|
||||||
"Numbers implement the " { $link "math.order" } ", therefore operations such as " { $link min } " and " { $link max } " can be used with numbers." ;
|
"Numbers implement the " { $link "math.order" } ", therefore operations such as " { $link min } " and " { $link max } " can be used with numbers." ;
|
||||||
|
|
||||||
ARTICLE: "power-functions" "Powers and logarithms"
|
ARTICLE: "power-functions" "Powers and logarithms"
|
||||||
"Squares:"
|
"Squares:"
|
||||||
{ $subsection sq }
|
{ $subsections sq sqrt }
|
||||||
{ $subsection sqrt }
|
|
||||||
"Exponential and natural logarithm:"
|
"Exponential and natural logarithm:"
|
||||||
{ $subsection exp }
|
{ $subsections exp cis log }
|
||||||
{ $subsection cis }
|
|
||||||
{ $subsection log }
|
|
||||||
"Other logarithms:"
|
"Other logarithms:"
|
||||||
{ $subsection log1+ }
|
{ $subsection log1+ log10 }
|
||||||
{ $subsection log10 }
|
|
||||||
"Raising a number to a power:"
|
"Raising a number to a power:"
|
||||||
{ $subsection ^ }
|
{ $subsections ^ 10^ }
|
||||||
{ $subsection 10^ }
|
|
||||||
"Converting between rectangular and polar form:"
|
"Converting between rectangular and polar form:"
|
||||||
{ $subsection abs }
|
{ $subsections
|
||||||
{ $subsection absq }
|
abs
|
||||||
{ $subsection arg }
|
absq
|
||||||
{ $subsection >polar }
|
arg
|
||||||
{ $subsection polar> } ;
|
>polar
|
||||||
|
polar>
|
||||||
|
} ;
|
||||||
|
|
||||||
ARTICLE: "trig-hyp-functions" "Trigonometric and hyperbolic functions"
|
ARTICLE: "trig-hyp-functions" "Trigonometric and hyperbolic functions"
|
||||||
"Trigonometric functions:"
|
"Trigonometric functions:"
|
||||||
{ $subsection cos }
|
{ $subsections cos sin tan }
|
||||||
{ $subsection sin }
|
|
||||||
{ $subsection tan }
|
|
||||||
"Reciprocals:"
|
"Reciprocals:"
|
||||||
{ $subsection sec }
|
{ $subsections sec cosec cot }
|
||||||
{ $subsection cosec }
|
|
||||||
{ $subsection cot }
|
|
||||||
"Inverses:"
|
"Inverses:"
|
||||||
{ $subsection acos }
|
{ $subsections acos asin atan }
|
||||||
{ $subsection asin }
|
|
||||||
{ $subsection atan }
|
|
||||||
"Inverse reciprocals:"
|
"Inverse reciprocals:"
|
||||||
{ $subsection asec }
|
{ $subsections asec acosec acot }
|
||||||
{ $subsection acosec }
|
|
||||||
{ $subsection acot }
|
|
||||||
"Hyperbolic functions:"
|
"Hyperbolic functions:"
|
||||||
{ $subsection cosh }
|
{ $subsections cosh sinh tanh }
|
||||||
{ $subsection sinh }
|
|
||||||
{ $subsection tanh }
|
|
||||||
"Reciprocals:"
|
"Reciprocals:"
|
||||||
{ $subsection sech }
|
{ $subsections sech cosech coth }
|
||||||
{ $subsection cosech }
|
|
||||||
{ $subsection coth }
|
|
||||||
"Inverses:"
|
"Inverses:"
|
||||||
{ $subsection acosh }
|
{ $subsections acosh asinh atanh }
|
||||||
{ $subsection asinh }
|
|
||||||
{ $subsection atanh }
|
|
||||||
"Inverse reciprocals:"
|
"Inverse reciprocals:"
|
||||||
{ $subsection asech }
|
{ $subsections asech acosech acoth } ;
|
||||||
{ $subsection acosech }
|
|
||||||
{ $subsection acoth } ;
|
|
||||||
|
|
||||||
ARTICLE: "math-functions" "Mathematical functions"
|
ARTICLE: "math-functions" "Mathematical functions"
|
||||||
{ $subsection "integer-functions" }
|
{ $subsections
|
||||||
{ $subsection "arithmetic-functions" }
|
"integer-functions"
|
||||||
{ $subsection "power-functions" }
|
"arithmetic-functions"
|
||||||
{ $subsection "trig-hyp-functions" } ;
|
"power-functions"
|
||||||
|
"trig-hyp-functions"
|
||||||
|
} ;
|
||||||
|
|
||||||
ABOUT: "math-functions"
|
ABOUT: "math-functions"
|
||||||
|
|
||||||
|
|
|
@ -78,12 +78,13 @@ ERROR: bad-schema schema ;
|
||||||
} append
|
} append
|
||||||
] when ;
|
] when ;
|
||||||
|
|
||||||
:: simd-vector-words ( class ctor rep vv->v v->v v->n -- )
|
:: simd-vector-words ( class ctor rep vv->v vn->v v->v v->n -- )
|
||||||
rep rep-component-type c-type-boxed-class :> elt-class
|
rep rep-component-type c-type-boxed-class :> elt-class
|
||||||
class
|
class
|
||||||
elt-class
|
elt-class
|
||||||
{
|
{
|
||||||
{ { +vector+ +vector+ -> +vector+ } vv->v }
|
{ { +vector+ +vector+ -> +vector+ } vv->v }
|
||||||
|
{ { +vector+ +scalar+ -> +vector+ } vn->v }
|
||||||
{ { +vector+ -> +vector+ } v->v }
|
{ { +vector+ -> +vector+ } v->v }
|
||||||
{ { +vector+ -> +scalar+ } v->n }
|
{ { +vector+ -> +scalar+ } v->n }
|
||||||
{ { +vector+ -> +nonnegative+ } v->n }
|
{ { +vector+ -> +nonnegative+ } v->n }
|
||||||
|
@ -118,6 +119,7 @@ SET-NTH [ T dup c-setter array-accessor ]
|
||||||
|
|
||||||
A-rep [ A name>> "-rep" append "cpu.architecture" lookup ]
|
A-rep [ A name>> "-rep" append "cpu.architecture" lookup ]
|
||||||
A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op
|
A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op
|
||||||
|
A-vn->v-op DEFINES-PRIVATE ${A}-vn->v-op
|
||||||
A-v->v-op DEFINES-PRIVATE ${A}-v->v-op
|
A-v->v-op DEFINES-PRIVATE ${A}-v->v-op
|
||||||
A-v->n-op DEFINES-PRIVATE ${A}-v->n-op
|
A-v->n-op DEFINES-PRIVATE ${A}-v->n-op
|
||||||
|
|
||||||
|
@ -175,13 +177,16 @@ INSTANCE: A sequence
|
||||||
: A-vv->v-op ( v1 v2 quot -- v3 )
|
: A-vv->v-op ( v1 v2 quot -- v3 )
|
||||||
[ [ underlying>> ] bi@ A-rep ] dip call \ A boa ; inline
|
[ [ underlying>> ] bi@ A-rep ] dip call \ A boa ; inline
|
||||||
|
|
||||||
|
: A-vn->v-op ( v1 v2 quot -- v3 )
|
||||||
|
[ [ underlying>> ] dip A-rep ] dip call \ A boa ; inline
|
||||||
|
|
||||||
: A-v->v-op ( v1 quot -- v2 )
|
: A-v->v-op ( v1 quot -- v2 )
|
||||||
[ underlying>> A-rep ] dip call \ A boa ; inline
|
[ underlying>> A-rep ] dip call \ A boa ; inline
|
||||||
|
|
||||||
: A-v->n-op ( v quot -- n )
|
: A-v->n-op ( v quot -- n )
|
||||||
[ underlying>> A-rep ] dip call ; inline
|
[ underlying>> A-rep ] dip call ; inline
|
||||||
|
|
||||||
\ A \ A-with \ A-rep \ A-vv->v-op \ A-v->v-op \ A-v->n-op simd-vector-words
|
\ A \ A-with \ A-rep \ A-vv->v-op \ A-vn->v-op \ A-v->v-op \ A-v->n-op simd-vector-words
|
||||||
\ A \ A-rep define-simd-128-type
|
\ A \ A-rep define-simd-128-type
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
@ -230,6 +235,7 @@ A-deref DEFINES-PRIVATE ${A}-deref
|
||||||
|
|
||||||
A-rep [ A/2 name>> "-rep" append "cpu.architecture" lookup ]
|
A-rep [ A/2 name>> "-rep" append "cpu.architecture" lookup ]
|
||||||
A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op
|
A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op
|
||||||
|
A-vn->v-op DEFINES-PRIVATE ${A}-vn->v-op
|
||||||
A-v->v-op DEFINES-PRIVATE ${A}-v->v-op
|
A-v->v-op DEFINES-PRIVATE ${A}-v->v-op
|
||||||
A-v->n-op DEFINES-PRIVATE ${A}-v->n-op
|
A-v->n-op DEFINES-PRIVATE ${A}-v->n-op
|
||||||
|
|
||||||
|
@ -296,6 +302,11 @@ INSTANCE: A sequence
|
||||||
[ [ [ underlying2>> ] bi@ A-rep ] dip call ] 3bi
|
[ [ [ underlying2>> ] bi@ A-rep ] dip call ] 3bi
|
||||||
\ A boa ; inline
|
\ A boa ; inline
|
||||||
|
|
||||||
|
: A-vn->v-op ( v1 v2 quot -- v3 )
|
||||||
|
[ [ [ underlying1>> ] dip A-rep ] dip call ]
|
||||||
|
[ [ [ underlying2>> ] dip A-rep ] dip call ] 3bi
|
||||||
|
\ A boa ; inline
|
||||||
|
|
||||||
: A-v->v-op ( v1 combine-quot -- v2 )
|
: A-v->v-op ( v1 combine-quot -- v2 )
|
||||||
[ [ underlying1>> A-rep ] dip call ]
|
[ [ underlying1>> A-rep ] dip call ]
|
||||||
[ [ underlying2>> A-rep ] dip call ] 2bi
|
[ [ underlying2>> A-rep ] dip call ] 2bi
|
||||||
|
@ -304,7 +315,7 @@ INSTANCE: A sequence
|
||||||
: A-v->n-op ( v1 combine-quot -- v2 )
|
: A-v->n-op ( v1 combine-quot -- v2 )
|
||||||
[ [ underlying1>> ] [ underlying2>> ] bi A-rep (simd-v+) A-rep ] dip call ; inline
|
[ [ underlying1>> ] [ underlying2>> ] bi A-rep (simd-v+) A-rep ] dip call ; inline
|
||||||
|
|
||||||
\ A \ A-with \ A-rep \ A-vv->v-op \ A-v->v-op \ A-v->n-op simd-vector-words
|
\ A \ A-with \ A-rep \ A-vv->v-op \ A-vn->v-op \ A-v->v-op \ A-v->n-op simd-vector-words
|
||||||
\ A \ A-rep define-simd-256-type
|
\ A \ A-rep define-simd-256-type
|
||||||
|
|
||||||
;FUNCTOR
|
;FUNCTOR
|
||||||
|
|
|
@ -42,6 +42,8 @@ SIMD-OP: vabs
|
||||||
SIMD-OP: vbitand
|
SIMD-OP: vbitand
|
||||||
SIMD-OP: vbitor
|
SIMD-OP: vbitor
|
||||||
SIMD-OP: vbitxor
|
SIMD-OP: vbitxor
|
||||||
|
SIMD-OP: vlshift
|
||||||
|
SIMD-OP: vrshift
|
||||||
|
|
||||||
: (simd-broadcast) ( x rep -- v ) bad-simd-call ;
|
: (simd-broadcast) ( x rep -- v ) bad-simd-call ;
|
||||||
: (simd-gather-2) ( a b rep -- v ) bad-simd-call ;
|
: (simd-gather-2) ( a b rep -- v ) bad-simd-call ;
|
||||||
|
@ -110,6 +112,8 @@ M: vector-rep supported-simd-op?
|
||||||
{ \ (simd-vbitand) [ %and-vector-reps ] }
|
{ \ (simd-vbitand) [ %and-vector-reps ] }
|
||||||
{ \ (simd-vbitor) [ %or-vector-reps ] }
|
{ \ (simd-vbitor) [ %or-vector-reps ] }
|
||||||
{ \ (simd-vbitxor) [ %xor-vector-reps ] }
|
{ \ (simd-vbitxor) [ %xor-vector-reps ] }
|
||||||
|
{ \ (simd-vlshift) [ %shl-vector-reps ] }
|
||||||
|
{ \ (simd-vrshift) [ %shr-vector-reps ] }
|
||||||
{ \ (simd-broadcast) [ %broadcast-vector-reps ] }
|
{ \ (simd-broadcast) [ %broadcast-vector-reps ] }
|
||||||
{ \ (simd-gather-2) [ %gather-vector-2-reps ] }
|
{ \ (simd-gather-2) [ %gather-vector-2-reps ] }
|
||||||
{ \ (simd-gather-4) [ %gather-vector-4-reps ] }
|
{ \ (simd-gather-4) [ %gather-vector-4-reps ] }
|
||||||
|
|
|
@ -52,6 +52,10 @@ $nl
|
||||||
"uint-4"
|
"uint-4"
|
||||||
"int-8"
|
"int-8"
|
||||||
"uint-8"
|
"uint-8"
|
||||||
|
"longlong-2"
|
||||||
|
"ulonglong-2"
|
||||||
|
"longlong-4"
|
||||||
|
"ulonglong-4"
|
||||||
"float-4"
|
"float-4"
|
||||||
"float-8"
|
"float-8"
|
||||||
"double-2"
|
"double-2"
|
||||||
|
@ -92,7 +96,7 @@ SYMBOLS: x y ;
|
||||||
{ $code
|
{ $code
|
||||||
"""USING: compiler.tree.debugger kernel.private
|
"""USING: compiler.tree.debugger kernel.private
|
||||||
math.vectors math.vectors.simd ;
|
math.vectors math.vectors.simd ;
|
||||||
SIMD: float-4
|
SIMD: float
|
||||||
IN: simd-demo
|
IN: simd-demo
|
||||||
|
|
||||||
: interpolate ( v a b -- w )
|
: interpolate ( v a b -- w )
|
||||||
|
@ -106,7 +110,7 @@ $nl
|
||||||
{ $code
|
{ $code
|
||||||
"""USING: compiler.tree.debugger hints
|
"""USING: compiler.tree.debugger hints
|
||||||
math.vectors math.vectors.simd ;
|
math.vectors math.vectors.simd ;
|
||||||
SIMD: float-4
|
SIMD: float
|
||||||
IN: simd-demo
|
IN: simd-demo
|
||||||
|
|
||||||
: interpolate ( v a b -- w )
|
: interpolate ( v a b -- w )
|
||||||
|
@ -122,7 +126,7 @@ $nl
|
||||||
"In the " { $snippet "interpolate" } " word, there is still a call to the " { $link <tuple-boa> } " primitive, because the return value at the end is being boxed on the heap. In the next example, no memory allocation occurs at all because the SIMD vectors are stored inside a struct class (see " { $link "classes.struct" } "); also note the use of inlining:"
|
"In the " { $snippet "interpolate" } " word, there is still a call to the " { $link <tuple-boa> } " primitive, because the return value at the end is being boxed on the heap. In the next example, no memory allocation occurs at all because the SIMD vectors are stored inside a struct class (see " { $link "classes.struct" } "); also note the use of inlining:"
|
||||||
{ $code
|
{ $code
|
||||||
"""USING: compiler.tree.debugger math.vectors math.vectors.simd ;
|
"""USING: compiler.tree.debugger math.vectors math.vectors.simd ;
|
||||||
SIMD: float-4
|
SIMD: float
|
||||||
IN: simd-demo
|
IN: simd-demo
|
||||||
|
|
||||||
STRUCT: actor
|
STRUCT: actor
|
||||||
|
@ -192,8 +196,8 @@ ARTICLE: "math.vectors.simd" "Hardware vector arithmetic (SIMD)"
|
||||||
{ $subsection "math.vectors.simd.intrinsics" } ;
|
{ $subsection "math.vectors.simd.intrinsics" } ;
|
||||||
|
|
||||||
HELP: SIMD:
|
HELP: SIMD:
|
||||||
{ $syntax "SIMD: type-length" }
|
{ $syntax "SIMD: type" }
|
||||||
{ $values { "type" "a scalar C type" } { "length" "a vector dimension" } }
|
{ $values { "type" "a scalar C type" } }
|
||||||
{ $description "Brings a SIMD array for holding " { $snippet "length" } " values of " { $snippet "type" } " into the vocabulary search path. The possible type/length combinations are listed in " { $link "math.vectors.simd.types" } " and the generated words are documented in " { $link "math.vectors.simd.words" } "." } ;
|
{ $description "Defines 128-bit and 256-bit SIMD arrays for holding elements of " { $snippet "type" } " into the vocabulary search path. The possible type/length combinations are listed in " { $link "math.vectors.simd.types" } " and the generated words are documented in " { $link "math.vectors.simd.words" } "." } ;
|
||||||
|
|
||||||
ABOUT: "math.vectors.simd"
|
ABOUT: "math.vectors.simd"
|
||||||
|
|
|
@ -5,35 +5,35 @@ math.vectors.simd.private prettyprint random sequences system
|
||||||
tools.test vocabs assocs compiler.cfg.debugger words
|
tools.test vocabs assocs compiler.cfg.debugger words
|
||||||
locals math.vectors.specialization combinators cpu.architecture
|
locals math.vectors.specialization combinators cpu.architecture
|
||||||
math.vectors.simd.intrinsics namespaces byte-arrays alien
|
math.vectors.simd.intrinsics namespaces byte-arrays alien
|
||||||
specialized-arrays classes.struct ;
|
specialized-arrays classes.struct eval ;
|
||||||
FROM: alien.c-types => c-type-boxed-class ;
|
FROM: alien.c-types => c-type-boxed-class ;
|
||||||
SPECIALIZED-ARRAY: float
|
SPECIALIZED-ARRAY: float
|
||||||
SIMD: char-16
|
SIMD: char
|
||||||
SIMD: uchar-16
|
SIMD: uchar
|
||||||
SIMD: char-32
|
SIMD: short
|
||||||
SIMD: uchar-32
|
SIMD: ushort
|
||||||
SIMD: short-8
|
SIMD: int
|
||||||
SIMD: ushort-8
|
SIMD: uint
|
||||||
SIMD: short-16
|
SIMD: longlong
|
||||||
SIMD: ushort-16
|
SIMD: ulonglong
|
||||||
SIMD: int-4
|
SIMD: float
|
||||||
SIMD: uint-4
|
SIMD: double
|
||||||
SIMD: int-8
|
|
||||||
SIMD: uint-8
|
|
||||||
SIMD: float-4
|
|
||||||
SIMD: float-8
|
|
||||||
SIMD: double-2
|
|
||||||
SIMD: double-4
|
|
||||||
IN: math.vectors.simd.tests
|
IN: math.vectors.simd.tests
|
||||||
|
|
||||||
[ float-4{ 0 0 0 0 } ] [ float-4 new ] unit-test
|
! Make sure the functor doesn't generate bogus vocabularies
|
||||||
|
2 [ [ "USE: math.vectors.simd SIMD: rubinius" eval( -- ) ] must-fail ] times
|
||||||
|
|
||||||
[ float-4{ 0 0 0 0 } ] [ [ float-4 new ] compile-call ] unit-test
|
[ f ] [ "math.vectors.simd.instances.rubinius" vocab ] unit-test
|
||||||
|
|
||||||
|
! Test type propagation
|
||||||
[ V{ float } ] [ [ { float-4 } declare norm-sq ] final-classes ] unit-test
|
[ V{ float } ] [ [ { float-4 } declare norm-sq ] final-classes ] unit-test
|
||||||
|
|
||||||
[ V{ float } ] [ [ { float-4 } declare norm ] final-classes ] unit-test
|
[ V{ float } ] [ [ { float-4 } declare norm ] final-classes ] unit-test
|
||||||
|
|
||||||
|
[ V{ float-4 } ] [ [ { float-4 } declare normalize ] final-classes ] unit-test
|
||||||
|
|
||||||
|
[ V{ float-4 } ] [ [ { float-4 float-4 } declare v+ ] final-classes ] unit-test
|
||||||
|
|
||||||
! Test puns; only on x86
|
! Test puns; only on x86
|
||||||
cpu x86? [
|
cpu x86? [
|
||||||
[ double-2{ 4 1024 } ] [
|
[ double-2{ 4 1024 } ] [
|
||||||
|
@ -62,6 +62,10 @@ CONSTANT: simd-classes
|
||||||
uint-4
|
uint-4
|
||||||
int-8
|
int-8
|
||||||
uint-8
|
uint-8
|
||||||
|
longlong-2
|
||||||
|
ulonglong-2
|
||||||
|
longlong-4
|
||||||
|
ulonglong-4
|
||||||
float-4
|
float-4
|
||||||
float-8
|
float-8
|
||||||
double-2
|
double-2
|
||||||
|
@ -137,9 +141,12 @@ CONSTANT: simd-classes
|
||||||
: remove-float-words ( alist -- alist' )
|
: remove-float-words ( alist -- alist' )
|
||||||
[ drop { vsqrt n/v v/n v/ normalize } member? not ] assoc-filter ;
|
[ drop { vsqrt n/v v/n v/ normalize } member? not ] assoc-filter ;
|
||||||
|
|
||||||
|
: remove-integer-words ( alist -- alist' )
|
||||||
|
[ drop { vlshift vrshift } member? not ] assoc-filter ;
|
||||||
|
|
||||||
: ops-to-check ( elt-class -- alist )
|
: ops-to-check ( elt-class -- alist )
|
||||||
[ vector-words >alist ] dip
|
[ vector-words >alist ] dip
|
||||||
float = [ remove-float-words ] unless ;
|
float = [ remove-integer-words ] [ remove-float-words ] if ;
|
||||||
|
|
||||||
: check-vector-ops ( class elt-class compare-quot -- )
|
: check-vector-ops ( class elt-class compare-quot -- )
|
||||||
[
|
[
|
||||||
|
@ -164,7 +171,7 @@ CONSTANT: simd-classes
|
||||||
simd-classes [
|
simd-classes [
|
||||||
{
|
{
|
||||||
{ [ dup name>> "float" head? ] [ float [ approx= ] ] }
|
{ [ dup name>> "float" head? ] [ float [ approx= ] ] }
|
||||||
{ [ dup name>> "double" tail? ] [ float [ = ] ] }
|
{ [ dup name>> "double" head? ] [ float [ = ] ] }
|
||||||
[ fixnum [ = ] ]
|
[ fixnum [ = ] ]
|
||||||
} cond 3array
|
} cond 3array
|
||||||
] map ;
|
] map ;
|
||||||
|
|
|
@ -3,30 +3,39 @@
|
||||||
USING: alien.c-types combinators fry kernel lexer math math.parser
|
USING: alien.c-types combinators fry kernel lexer math math.parser
|
||||||
math.vectors.simd.functor sequences splitting vocabs.generated
|
math.vectors.simd.functor sequences splitting vocabs.generated
|
||||||
vocabs.loader vocabs.parser words ;
|
vocabs.loader vocabs.parser words ;
|
||||||
|
QUALIFIED-WITH: alien.c-types c
|
||||||
IN: math.vectors.simd
|
IN: math.vectors.simd
|
||||||
|
|
||||||
ERROR: bad-vector-size bits ;
|
ERROR: bad-base-type type ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: simd-vocab ( type -- vocab )
|
: simd-vocab ( base-type -- vocab )
|
||||||
"math.vectors.simd.instances." prepend ;
|
"math.vectors.simd.instances." prepend ;
|
||||||
|
|
||||||
: parse-simd-name ( string -- c-type quot )
|
: parse-base-type ( string -- c-type )
|
||||||
"-" split1
|
{
|
||||||
[ "alien.c-types" lookup dup heap-size ] [ string>number ] bi*
|
{ "char" [ c:char ] }
|
||||||
* 8 * {
|
{ "uchar" [ c:uchar ] }
|
||||||
{ 128 [ [ define-simd-128 ] ] }
|
{ "short" [ c:short ] }
|
||||||
{ 256 [ [ define-simd-256 ] ] }
|
{ "ushort" [ c:ushort ] }
|
||||||
[ bad-vector-size ]
|
{ "int" [ c:int ] }
|
||||||
|
{ "uint" [ c:uint ] }
|
||||||
|
{ "longlong" [ c:longlong ] }
|
||||||
|
{ "ulonglong" [ c:ulonglong ] }
|
||||||
|
{ "float" [ c:float ] }
|
||||||
|
{ "double" [ c:double ] }
|
||||||
|
[ bad-base-type ]
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: define-simd-vocab ( type -- vocab )
|
: define-simd-vocab ( type -- vocab )
|
||||||
[ simd-vocab ]
|
[ simd-vocab ] keep '[
|
||||||
[ '[ _ parse-simd-name call( type -- ) ] ] bi
|
_ parse-base-type
|
||||||
generate-vocab ;
|
[ define-simd-128 ]
|
||||||
|
[ define-simd-256 ] bi
|
||||||
|
] generate-vocab ;
|
||||||
|
|
||||||
SYNTAX: SIMD:
|
SYNTAX: SIMD:
|
||||||
scan define-simd-vocab use-vocab ;
|
scan define-simd-vocab use-vocab ;
|
||||||
|
|
|
@ -13,10 +13,14 @@ SPECIALIZED-ARRAY: float
|
||||||
[ { float-array float } declare v*n norm ] final-classes
|
[ { float-array float } declare v*n norm ] final-classes
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ V{ number } ] [
|
[ V{ complex } ] [
|
||||||
[ { complex-float-array complex-float-array } declare v. ] final-classes
|
[ { complex-float-array complex-float-array } declare v. ] final-classes
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ V{ real } ] [
|
[ V{ float } ] [
|
||||||
|
[ { float-array float } declare v*n norm ] final-classes
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ V{ float } ] [
|
||||||
[ { complex-float-array complex } declare v*n norm ] final-classes
|
[ { complex-float-array complex } declare v*n norm ] final-classes
|
||||||
] unit-test
|
] unit-test
|
|
@ -1,9 +1,9 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.c-types words kernel make sequences effects
|
USING: words kernel make sequences effects sets kernel.private
|
||||||
kernel.private accessors combinators math math.intervals
|
accessors combinators math math.intervals math.vectors
|
||||||
math.vectors namespaces assocs fry splitting classes.algebra
|
namespaces assocs fry splitting classes.algebra generalizations
|
||||||
generalizations locals compiler.tree.propagation.info ;
|
locals compiler.tree.propagation.info ;
|
||||||
IN: math.vectors.specialization
|
IN: math.vectors.specialization
|
||||||
|
|
||||||
SYMBOLS: -> +vector+ +scalar+ +nonnegative+ ;
|
SYMBOLS: -> +vector+ +scalar+ +nonnegative+ ;
|
||||||
|
@ -30,7 +30,14 @@ SYMBOLS: -> +vector+ +scalar+ +nonnegative+ ;
|
||||||
{
|
{
|
||||||
{ +vector+ [ drop <class-info> ] }
|
{ +vector+ [ drop <class-info> ] }
|
||||||
{ +scalar+ [ nip <class-info> ] }
|
{ +scalar+ [ nip <class-info> ] }
|
||||||
{ +nonnegative+ [ nip real class-and [0,inf] <class/interval-info> ] }
|
{
|
||||||
|
+nonnegative+
|
||||||
|
[
|
||||||
|
nip
|
||||||
|
dup complex class<= [ drop float ] when
|
||||||
|
[0,inf] <class/interval-info>
|
||||||
|
]
|
||||||
|
}
|
||||||
} case
|
} case
|
||||||
] with with map ;
|
] with with map ;
|
||||||
|
|
||||||
|
@ -77,6 +84,8 @@ H{
|
||||||
{ vbitand { +vector+ +vector+ -> +vector+ } }
|
{ vbitand { +vector+ +vector+ -> +vector+ } }
|
||||||
{ vbitor { +vector+ +vector+ -> +vector+ } }
|
{ vbitor { +vector+ +vector+ -> +vector+ } }
|
||||||
{ vbitxor { +vector+ +vector+ -> +vector+ } }
|
{ vbitxor { +vector+ +vector+ -> +vector+ } }
|
||||||
|
{ vlshift { +vector+ +scalar+ -> +vector+ } }
|
||||||
|
{ vrshift { +vector+ +scalar+ -> +vector+ } }
|
||||||
}
|
}
|
||||||
|
|
||||||
PREDICATE: vector-word < word vector-words key? ;
|
PREDICATE: vector-word < word vector-words key? ;
|
||||||
|
@ -107,15 +116,24 @@ M: vector-word subwords specializations values [ word? ] filter ;
|
||||||
:: input-signature ( word array-type elt-type -- signature )
|
:: input-signature ( word array-type elt-type -- signature )
|
||||||
array-type elt-type word word-schema inputs signature-for-schema ;
|
array-type elt-type word word-schema inputs signature-for-schema ;
|
||||||
|
|
||||||
|
: vector-words-for-type ( elt-type -- alist )
|
||||||
|
{
|
||||||
|
! Can't do shifts on floats
|
||||||
|
{ [ dup float class<= ] [ vector-words keys { vlshift vrshift } diff ] }
|
||||||
|
! Can't divide integers
|
||||||
|
{ [ dup integer class<= ] [ vector-words keys { vsqrt n/v v/n v/ normalize } diff ] }
|
||||||
|
! Can't compute square root of complex numbers (vsqrt uses fsqrt not sqrt)
|
||||||
|
{ [ dup complex class<= ] [ vector-words keys { vsqrt } diff ] }
|
||||||
|
[ { } ]
|
||||||
|
} cond nip ;
|
||||||
|
|
||||||
:: specialize-vector-words ( array-type elt-type simd -- )
|
:: specialize-vector-words ( array-type elt-type simd -- )
|
||||||
elt-type number class<= [
|
elt-type vector-words-for-type [
|
||||||
vector-words keys [
|
[ array-type elt-type simd specialize-vector-word ]
|
||||||
[ array-type elt-type simd specialize-vector-word ]
|
[ array-type elt-type input-signature ]
|
||||||
[ array-type elt-type input-signature ]
|
[ ]
|
||||||
[ ]
|
tri add-specialization
|
||||||
tri add-specialization
|
] each ;
|
||||||
] each
|
|
||||||
] when ;
|
|
||||||
|
|
||||||
: find-specialization ( classes word -- word/f )
|
: find-specialization ( classes word -- word/f )
|
||||||
specializations
|
specializations
|
||||||
|
|
|
@ -38,6 +38,8 @@ $nl
|
||||||
{ $subsection vbitand }
|
{ $subsection vbitand }
|
||||||
{ $subsection vbitor }
|
{ $subsection vbitor }
|
||||||
{ $subsection vbitxor }
|
{ $subsection vbitxor }
|
||||||
|
{ $subsection vlshift }
|
||||||
|
{ $subsection vrshift }
|
||||||
"Inner product and norm:"
|
"Inner product and norm:"
|
||||||
{ $subsection v. }
|
{ $subsection v. }
|
||||||
{ $subsection norm }
|
{ $subsection norm }
|
||||||
|
@ -160,11 +162,7 @@ HELP: vmin
|
||||||
|
|
||||||
HELP: v.
|
HELP: v.
|
||||||
{ $values { "u" "a sequence of real numbers" } { "v" "a sequence of real numbers" } { "x" "a real number" } }
|
{ $values { "u" "a sequence of real numbers" } { "v" "a sequence of real numbers" } { "x" "a real number" } }
|
||||||
{ $description "Computes the real-valued dot product." }
|
{ $description "Computes the dot product of two vectors." } ;
|
||||||
{ $notes
|
|
||||||
"This word can also take complex number sequences as input, however mathematically it will compute the wrong result. The complex-valued dot product is defined differently:"
|
|
||||||
{ $code "0 [ conjugate * + ] 2reduce" }
|
|
||||||
} ;
|
|
||||||
|
|
||||||
HELP: vs+
|
HELP: vs+
|
||||||
{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of numbers" } }
|
{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of numbers" } }
|
||||||
|
@ -209,6 +207,14 @@ HELP: vbitxor
|
||||||
{ $description "Takes the bitwise exclusive or of " { $snippet "u" } " and " { $snippet "v" } " component-wise." }
|
{ $description "Takes the bitwise exclusive or of " { $snippet "u" } " and " { $snippet "v" } " component-wise." }
|
||||||
{ $notes "Unlike " { $link bitxor } ", this word may be used on a specialized array of floats or doubles, in which case the bitwise representation of the floating point numbers is operated upon." } ;
|
{ $notes "Unlike " { $link bitxor } ", this word may be used on a specialized array of floats or doubles, in which case the bitwise representation of the floating point numbers is operated upon." } ;
|
||||||
|
|
||||||
|
HELP: vlshift
|
||||||
|
{ $values { "u" "a sequence of integers" } { "n" "a non-negative integer" } { "w" "a sequence of integers" } }
|
||||||
|
{ $description "Shifts each element of " { $snippet "u" } " to the left by " { $snippet "n" } " bits." } ;
|
||||||
|
|
||||||
|
HELP: vrshift
|
||||||
|
{ $values { "u" "a sequence of integers" } { "n" "a non-negative integer" } { "w" "a sequence of integers" } }
|
||||||
|
{ $description "Shifts each element of " { $snippet "u" } " to the right by " { $snippet "n" } " bits." } ;
|
||||||
|
|
||||||
HELP: norm-sq
|
HELP: norm-sq
|
||||||
{ $values { "v" "a sequence of numbers" } { "x" "a non-negative real number" } }
|
{ $values { "v" "a sequence of numbers" } { "x" "a non-negative real number" } }
|
||||||
{ $description "Computes the squared length of a mathematical vector." } ;
|
{ $description "Computes the squared length of a mathematical vector." } ;
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
IN: math.vectors.tests
|
IN: math.vectors.tests
|
||||||
USING: math.vectors tools.test ;
|
USING: math.vectors tools.test kernel ;
|
||||||
|
|
||||||
[ { 1 2 3 } ] [ 1/2 { 2 4 6 } n*v ] unit-test
|
[ { 1 2 3 } ] [ 1/2 { 2 4 6 } n*v ] unit-test
|
||||||
[ { 1 2 3 } ] [ { 2 4 6 } 1/2 v*n ] unit-test
|
[ { 1 2 3 } ] [ { 2 4 6 } 1/2 v*n ] unit-test
|
||||||
|
@ -19,4 +19,6 @@ USING: math.vectors tools.test ;
|
||||||
|
|
||||||
[ 17 ] [ 0 1 2 3 4 5 6 7 { 1 2 3 } trilerp ] unit-test
|
[ 17 ] [ 0 1 2 3 4 5 6 7 { 1 2 3 } trilerp ] unit-test
|
||||||
|
|
||||||
[ { 0 3 2 5 4 } ] [ { 1 2 3 4 5 } { 1 1 1 1 1 } v+- ] unit-test
|
[ { 0 3 2 5 4 } ] [ { 1 2 3 4 5 } { 1 1 1 1 1 } v+- ] unit-test
|
||||||
|
|
||||||
|
[ 1 ] [ { C{ 0 1 } } dup v. ] unit-test
|
|
@ -61,6 +61,9 @@ PRIVATE>
|
||||||
: vbitor ( u v -- w ) over '[ _ [ bitor ] fp-bitwise-op ] 2map ;
|
: vbitor ( u v -- w ) over '[ _ [ bitor ] fp-bitwise-op ] 2map ;
|
||||||
: vbitxor ( u v -- w ) over '[ _ [ bitxor ] fp-bitwise-op ] 2map ;
|
: vbitxor ( u v -- w ) over '[ _ [ bitxor ] fp-bitwise-op ] 2map ;
|
||||||
|
|
||||||
|
: vlshift ( u n -- w ) '[ _ shift ] map ;
|
||||||
|
: vrshift ( u n -- w ) neg '[ _ shift ] map ;
|
||||||
|
|
||||||
: vfloor ( u -- v ) [ floor ] map ;
|
: vfloor ( u -- v ) [ floor ] map ;
|
||||||
: vceiling ( u -- v ) [ ceiling ] map ;
|
: vceiling ( u -- v ) [ ceiling ] map ;
|
||||||
: vtruncate ( u -- v ) [ truncate ] map ;
|
: vtruncate ( u -- v ) [ truncate ] map ;
|
||||||
|
@ -68,7 +71,7 @@ PRIVATE>
|
||||||
: vsupremum ( seq -- vmax ) [ ] [ vmax ] map-reduce ;
|
: vsupremum ( seq -- vmax ) [ ] [ vmax ] map-reduce ;
|
||||||
: vinfimum ( seq -- vmin ) [ ] [ vmin ] map-reduce ;
|
: vinfimum ( seq -- vmin ) [ ] [ vmin ] map-reduce ;
|
||||||
|
|
||||||
: v. ( u v -- x ) [ * ] [ + ] 2map-reduce ;
|
: v. ( u v -- x ) [ conjugate * ] [ + ] 2map-reduce ;
|
||||||
: norm-sq ( v -- x ) [ absq ] [ + ] map-reduce ;
|
: norm-sq ( v -- x ) [ absq ] [ + ] map-reduce ;
|
||||||
: norm ( v -- x ) norm-sq sqrt ;
|
: norm ( v -- x ) norm-sq sqrt ;
|
||||||
: normalize ( u -- v ) dup norm v/n ;
|
: normalize ( u -- v ) dup norm v/n ;
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2009 Keith Lazuka.
|
! Copyright (C) 2009 Keith Lazuka.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: assocs colors.constants combinators
|
USING: assocs colors colors.constants combinators
|
||||||
combinators.short-circuit hashtables io.styles kernel literals
|
combinators.short-circuit hashtables io.styles kernel literals
|
||||||
namespaces sequences words words.symbol ;
|
namespaces sequences words words.symbol ;
|
||||||
IN: prettyprint.stylesheet
|
IN: prettyprint.stylesheet
|
||||||
|
@ -43,4 +43,5 @@ PRIVATE>
|
||||||
dim-color colored-presentation-style ;
|
dim-color colored-presentation-style ;
|
||||||
|
|
||||||
: effect-style ( effect -- style )
|
: effect-style ( effect -- style )
|
||||||
COLOR: DarkGreen colored-presentation-style ;
|
0 0.2 0 1 <rgba> colored-presentation-style
|
||||||
|
{ { font-style plain } } assoc-union ;
|
||||||
|
|
|
@ -18,20 +18,21 @@ ARTICLE: "regexp.combinators.intro" "Regular expression combinator rationale"
|
||||||
|
|
||||||
ARTICLE: "regexp.combinators" "Regular expression combinators"
|
ARTICLE: "regexp.combinators" "Regular expression combinators"
|
||||||
"The " { $vocab-link "regexp.combinators" } " vocabulary defines combinators which can be used to build up regular expressions to match strings. This complements the traditional syntax defined in the " { $vocab-link "regexp" } " vocabulary."
|
"The " { $vocab-link "regexp.combinators" } " vocabulary defines combinators which can be used to build up regular expressions to match strings. This complements the traditional syntax defined in the " { $vocab-link "regexp" } " vocabulary."
|
||||||
{ $subsection "regexp.combinators.intro" }
|
{ $subsections "regexp.combinators.intro" }
|
||||||
"Basic combinators:"
|
"Basic combinators:"
|
||||||
{ $subsection <literal> }
|
{ $subsections <literal> <nothing> }
|
||||||
{ $subsection <nothing> }
|
|
||||||
"Higher-order combinators for building new regular expressions from existing ones:"
|
"Higher-order combinators for building new regular expressions from existing ones:"
|
||||||
{ $subsection <or> }
|
{ $subsections
|
||||||
{ $subsection <and> }
|
<or>
|
||||||
{ $subsection <not> }
|
<and>
|
||||||
{ $subsection <sequence> }
|
<not>
|
||||||
{ $subsection <zero-or-more> }
|
<sequence>
|
||||||
|
<zero-or-more>
|
||||||
|
}
|
||||||
"Derived combinators implemented in terms of the above:"
|
"Derived combinators implemented in terms of the above:"
|
||||||
{ $subsection <one-or-more> }
|
{ $subsections <one-or-more> }
|
||||||
"Setting options:"
|
"Setting options:"
|
||||||
{ $subsection <option> } ;
|
{ $subsections <option> } ;
|
||||||
|
|
||||||
HELP: <literal>
|
HELP: <literal>
|
||||||
{ $values { "string" string } { "regexp" regexp } }
|
{ $values { "string" string } { "regexp" regexp } }
|
||||||
|
|
|
@ -8,18 +8,22 @@ ABOUT: "regexp"
|
||||||
|
|
||||||
ARTICLE: "regexp" "Regular expressions"
|
ARTICLE: "regexp" "Regular expressions"
|
||||||
"The " { $vocab-link "regexp" } " vocabulary provides word for creating and using regular expressions."
|
"The " { $vocab-link "regexp" } " vocabulary provides word for creating and using regular expressions."
|
||||||
{ $subsection { "regexp" "intro" } }
|
{ $subsections { "regexp" "intro" } }
|
||||||
"The class of regular expressions:"
|
"The class of regular expressions:"
|
||||||
{ $subsection regexp }
|
{ $subsections regexp }
|
||||||
"Basic usage:"
|
"Basic usage:"
|
||||||
{ $subsection { "regexp" "syntax" } }
|
{ $subsections
|
||||||
{ $subsection { "regexp" "options" } }
|
{ "regexp" "syntax" }
|
||||||
{ $subsection { "regexp" "construction" } }
|
{ "regexp" "options" }
|
||||||
{ $subsection { "regexp" "operations" } }
|
{ "regexp" "construction" }
|
||||||
|
{ "regexp" "operations" }
|
||||||
|
}
|
||||||
"Advanced topics:"
|
"Advanced topics:"
|
||||||
{ $vocab-subsection "Regular expression combinators" "regexp.combinators" }
|
{ $vocab-subsection "Regular expression combinators" "regexp.combinators" }
|
||||||
{ $subsection { "regexp" "theory" } }
|
{ $subsections
|
||||||
{ $subsection { "regexp" "deploy" } } ;
|
{ "regexp" "theory" }
|
||||||
|
{ "regexp" "deploy" }
|
||||||
|
} ;
|
||||||
|
|
||||||
ARTICLE: { "regexp" "intro" } "A quick introduction to regular expressions"
|
ARTICLE: { "regexp" "intro" } "A quick introduction to regular expressions"
|
||||||
"Regular expressions are a terse way to do certain simple string processing tasks. For example, to replace all instances of " { $snippet "foo" } " in one string with " { $snippet "bar" } ", the following can be used:"
|
"Regular expressions are a terse way to do certain simple string processing tasks. For example, to replace all instances of " { $snippet "foo" } " in one string with " { $snippet "bar" } ", the following can be used:"
|
||||||
|
@ -36,10 +40,9 @@ ARTICLE: { "regexp" "intro" } "A quick introduction to regular expressions"
|
||||||
|
|
||||||
ARTICLE: { "regexp" "construction" } "Constructing regular expressions"
|
ARTICLE: { "regexp" "construction" } "Constructing regular expressions"
|
||||||
"Most of the time, regular expressions are literals and the parsing word should be used, to construct them at parse time. This ensures that they are only compiled once, and gives parse time syntax checking."
|
"Most of the time, regular expressions are literals and the parsing word should be used, to construct them at parse time. This ensures that they are only compiled once, and gives parse time syntax checking."
|
||||||
{ $subsection POSTPONE: R/ }
|
{ $subsections POSTPONE: R/ }
|
||||||
"Sometimes, regular expressions need to be constructed at run time instead; for example, in a text editor, the user might input a regular expression to search for in a document."
|
"Sometimes, regular expressions need to be constructed at run time instead; for example, in a text editor, the user might input a regular expression to search for in a document."
|
||||||
{ $subsection <regexp> }
|
{ $subsections <regexp> <optioned-regexp> }
|
||||||
{ $subsection <optioned-regexp> }
|
|
||||||
"Another approach is to use " { $vocab-link "regexp.combinators" } "." ;
|
"Another approach is to use " { $vocab-link "regexp.combinators" } "." ;
|
||||||
|
|
||||||
ARTICLE: { "regexp" "syntax" } "Regular expression syntax"
|
ARTICLE: { "regexp" "syntax" } "Regular expression syntax"
|
||||||
|
@ -167,18 +170,19 @@ ARTICLE: { "regexp" "theory" } "The theory of regular expressions"
|
||||||
|
|
||||||
ARTICLE: { "regexp" "operations" } "Matching operations with regular expressions"
|
ARTICLE: { "regexp" "operations" } "Matching operations with regular expressions"
|
||||||
"Testing if a string matches a regular expression:"
|
"Testing if a string matches a regular expression:"
|
||||||
{ $subsection matches? }
|
{ $subsections matches? }
|
||||||
"Finding a match inside a string:"
|
"Finding a match inside a string:"
|
||||||
{ $subsection re-contains? }
|
{ $subsections re-contains? first-match }
|
||||||
{ $subsection first-match }
|
|
||||||
"Finding all matches inside a string:"
|
"Finding all matches inside a string:"
|
||||||
{ $subsection count-matches }
|
{ $subsections
|
||||||
{ $subsection all-matching-slices }
|
count-matches
|
||||||
{ $subsection all-matching-subseqs }
|
all-matching-slices
|
||||||
|
all-matching-subseqs
|
||||||
|
}
|
||||||
"Splitting a string into tokens delimited by a regular expression:"
|
"Splitting a string into tokens delimited by a regular expression:"
|
||||||
{ $subsection re-split }
|
{ $subsections re-split }
|
||||||
"Replacing occurrences of a regular expression with a string:"
|
"Replacing occurrences of a regular expression with a string:"
|
||||||
{ $subsection re-replace } ;
|
{ $subsections re-replace } ;
|
||||||
|
|
||||||
ARTICLE: { "regexp" "deploy" } "Regular expressions and the deploy tool"
|
ARTICLE: { "regexp" "deploy" } "Regular expressions and the deploy tool"
|
||||||
"The " { $link "tools.deploy" } " tool has the option to strip out the optimizing compiler from the resulting image. Since regular expressions compile to Factor code, this creates a minor performance-related caveat."
|
"The " { $link "tools.deploy" } " tool has the option to strip out the optimizing compiler from the resulting image. Since regular expressions compile to Factor code, this creates a minor performance-related caveat."
|
||||||
|
|
|
@ -7,7 +7,7 @@ IN: summary
|
||||||
GENERIC: summary ( object -- string )
|
GENERIC: summary ( object -- string )
|
||||||
|
|
||||||
: object-summary ( object -- string )
|
: object-summary ( object -- string )
|
||||||
class name>> " instance" append ;
|
class name>> ;
|
||||||
|
|
||||||
M: object summary object-summary ;
|
M: object summary object-summary ;
|
||||||
|
|
||||||
|
|
|
@ -105,7 +105,8 @@ M: f smart-usage drop \ f smart-usage ;
|
||||||
synopsis-alist sort-keys definitions. ;
|
synopsis-alist sort-keys definitions. ;
|
||||||
|
|
||||||
: usage. ( word -- )
|
: usage. ( word -- )
|
||||||
smart-usage sorted-definitions. ;
|
smart-usage
|
||||||
|
[ "No usages." print ] [ sorted-definitions. ] if-empty ;
|
||||||
|
|
||||||
: vocab-xref ( vocab quot -- vocabs )
|
: vocab-xref ( vocab quot -- vocabs )
|
||||||
[ [ vocab-name ] [ words [ generic? not ] filter ] bi ] dip map
|
[ [ vocab-name ] [ words [ generic? not ] filter ] bi ] dip map
|
||||||
|
|
|
@ -196,6 +196,10 @@ IN: tools.deploy.shaker
|
||||||
"word-style"
|
"word-style"
|
||||||
} %
|
} %
|
||||||
] when
|
] when
|
||||||
|
|
||||||
|
deploy-c-types? get [
|
||||||
|
{ "c-type" "struct-slots" "struct-size" "struct-align" } %
|
||||||
|
] unless
|
||||||
] { } make ;
|
] { } make ;
|
||||||
|
|
||||||
: strip-words ( props -- )
|
: strip-words ( props -- )
|
||||||
|
@ -345,6 +349,8 @@ IN: tools.deploy.shaker
|
||||||
|
|
||||||
{ } { "math.partial-dispatch" } strip-vocab-globals %
|
{ } { "math.partial-dispatch" } strip-vocab-globals %
|
||||||
|
|
||||||
|
{ } { "math.vectors.simd" } strip-vocab-globals %
|
||||||
|
|
||||||
{ } { "peg" } strip-vocab-globals %
|
{ } { "peg" } strip-vocab-globals %
|
||||||
] when
|
] when
|
||||||
|
|
||||||
|
|
|
@ -59,3 +59,8 @@ words ;
|
||||||
[ ] [ [ [ ] compile-call ] profile ] unit-test
|
[ ] [ [ [ ] compile-call ] profile ] unit-test
|
||||||
|
|
||||||
[ [ gensym execute ] profile ] [ T{ undefined } = ] must-fail-with
|
[ [ gensym execute ] profile ] [ T{ undefined } = ] must-fail-with
|
||||||
|
|
||||||
|
: crash-bug-1 ( -- x ) "hi" "bye" <word> ;
|
||||||
|
: crash-bug-2 ( -- ) 100000 [ crash-bug-1 drop ] times ;
|
||||||
|
|
||||||
|
[ ] [ [ crash-bug-2 ] profile ] unit-test
|
||||||
|
|
|
@ -106,19 +106,6 @@ HELP: define-command
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: command-string
|
|
||||||
{ $values { "gesture" "a gesture" } { "command" "a command" } { "string" string } }
|
|
||||||
{ $description "Outputs a string containing the command name followed by the gesture." }
|
|
||||||
{ $examples
|
|
||||||
{ $unchecked-example
|
|
||||||
"USING: io ui.commands ui.gestures ;"
|
|
||||||
"IN: scratchpad"
|
|
||||||
": com-my-command ;"
|
|
||||||
"T{ key-down f { C+ } \"s\" } \\ com-my-command command-string write"
|
|
||||||
"My Command (C+s)"
|
|
||||||
}
|
|
||||||
} ;
|
|
||||||
|
|
||||||
ARTICLE: "ui-commands" "Commands"
|
ARTICLE: "ui-commands" "Commands"
|
||||||
"Commands are an abstraction layered on top of gestures. Their main advantage is that they are identified by words and can be organized into " { $emphasis "command maps" } ". This allows easy construction of buttons and tool bars for invoking commands."
|
"Commands are an abstraction layered on top of gestures. Their main advantage is that they are identified by words and can be organized into " { $emphasis "command maps" } ". This allows easy construction of buttons and tool bars for invoking commands."
|
||||||
{ $subsection define-command }
|
{ $subsection define-command }
|
||||||
|
|
|
@ -78,10 +78,4 @@ M: word invoke-command ( target command -- )
|
||||||
|
|
||||||
M: word command-word ;
|
M: word command-word ;
|
||||||
|
|
||||||
M: f invoke-command ( target command -- ) 2drop ;
|
M: f invoke-command ( target command -- ) 2drop ;
|
||||||
|
|
||||||
: command-string ( gesture command -- string )
|
|
||||||
[
|
|
||||||
command-name %
|
|
||||||
gesture>string [ " (" % % ")" % ] when*
|
|
||||||
] "" make ;
|
|
|
@ -233,7 +233,7 @@ PRIVATE>
|
||||||
'[ _ _ invoke-command ] ;
|
'[ _ _ invoke-command ] ;
|
||||||
|
|
||||||
: gesture>tooltip ( gesture -- str/f )
|
: gesture>tooltip ( gesture -- str/f )
|
||||||
dup [ gesture>string "Shortcut: " prepend ] when ;
|
gesture>string dup [ "Shortcut: " prepend ] when ;
|
||||||
|
|
||||||
: <command-button> ( target gesture command -- button )
|
: <command-button> ( target gesture command -- button )
|
||||||
swapd [ command-name swap ] keep command-button-quot
|
swapd [ command-name swap ] keep command-button-quot
|
||||||
|
|
|
@ -92,7 +92,7 @@ M: inspector-gadget focusable-child*
|
||||||
|
|
||||||
: slot-editor-window ( close-hook update-hook assoc key key-string -- )
|
: slot-editor-window ( close-hook update-hook assoc key key-string -- )
|
||||||
[ <value-ref> <slot-editor> ] [ "Slot editor: " prepend ] bi*
|
[ <value-ref> <slot-editor> ] [ "Slot editor: " prepend ] bi*
|
||||||
open-window ;
|
open-status-window ;
|
||||||
|
|
||||||
: com-edit-slot ( inspector -- )
|
: com-edit-slot ( inspector -- )
|
||||||
[ close-window ] swap
|
[ close-window ] swap
|
||||||
|
|
|
@ -3,8 +3,18 @@
|
||||||
USING: tools.test ui.tools.listener.completion ;
|
USING: tools.test ui.tools.listener.completion ;
|
||||||
IN: ui.tools.listener.completion.tests
|
IN: ui.tools.listener.completion.tests
|
||||||
|
|
||||||
[ t ] [ { "USING:" "A" "B" "C" } complete-USING:? ] unit-test
|
[ f ] [ { "USE:" "A" "B" "C" } complete-vocab? ] unit-test
|
||||||
|
|
||||||
[ f ] [ { "USING:" "A" "B" "C" ";" } complete-USING:? ] unit-test
|
[ t ] [ { "USE:" "A" } complete-vocab? ] unit-test
|
||||||
|
|
||||||
[ t ] [ { "X" ";" "USING:" "A" "B" "C" } complete-USING:? ] unit-test
|
[ t ] [ { "UNUSE:" "A" } complete-vocab? ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ { "QUALIFIED:" "A" } complete-vocab? ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ { "QUALIFIED-WITH:" "A" } complete-vocab? ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ { "USING:" "A" "B" "C" } complete-vocab-list? ] unit-test
|
||||||
|
|
||||||
|
[ f ] [ { "USING:" "A" "B" "C" ";" } complete-vocab-list? ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ { "X" ";" "USING:" "A" "B" "C" } complete-vocab-list? ] unit-test
|
|
@ -72,13 +72,14 @@ M: word-completion row-color
|
||||||
M: vocab-completion row-color
|
M: vocab-completion row-color
|
||||||
drop vocab? COLOR: black COLOR: dark-gray ? ;
|
drop vocab? COLOR: black COLOR: dark-gray ? ;
|
||||||
|
|
||||||
: complete-IN:/USE:? ( tokens -- ? )
|
: complete-vocab? ( tokens -- ? )
|
||||||
1 short head* 2 short tail* { "IN:" "USE:" } intersects? ;
|
1 short head* 2 short tail*
|
||||||
|
{ "IN:" "USE:" "UNUSE:" "QUALIFIED:" "QUALIFIED-WITH:" } intersects? ;
|
||||||
|
|
||||||
: chop-; ( seq -- seq' )
|
: chop-; ( seq -- seq' )
|
||||||
{ ";" } split1-last [ ] [ ] ?if ;
|
{ ";" } split1-last [ ] [ ] ?if ;
|
||||||
|
|
||||||
: complete-USING:? ( tokens -- ? )
|
: complete-vocab-list? ( tokens -- ? )
|
||||||
chop-; 1 short head* { "USING:" } intersects? ;
|
chop-; 1 short head* { "USING:" } intersects? ;
|
||||||
|
|
||||||
: complete-CHAR:? ( tokens -- ? )
|
: complete-CHAR:? ( tokens -- ? )
|
||||||
|
@ -90,7 +91,7 @@ M: vocab-completion row-color
|
||||||
: completion-mode ( interactor -- symbol )
|
: completion-mode ( interactor -- symbol )
|
||||||
[ manifest>> ] [ editor-caret ] [ model>> ] tri up-to-caret " \r\n" split
|
[ manifest>> ] [ editor-caret ] [ model>> ] tri up-to-caret " \r\n" split
|
||||||
{
|
{
|
||||||
{ [ dup { [ complete-IN:/USE:? ] [ complete-USING:? ] } 1|| ] [ 2drop vocab-completion ] }
|
{ [ dup { [ complete-vocab? ] [ complete-vocab-list? ] } 1|| ] [ 2drop vocab-completion ] }
|
||||||
{ [ dup complete-CHAR:? ] [ 2drop char-completion ] }
|
{ [ dup complete-CHAR:? ] [ 2drop char-completion ] }
|
||||||
[ drop <word-completion> ]
|
[ drop <word-completion> ]
|
||||||
} cond ;
|
} cond ;
|
||||||
|
|
|
@ -16,7 +16,9 @@ ARTICLE: "starting-ui-tools" "Starting the UI tools"
|
||||||
{ $code "USE: threads" "[ \"ui.tools\" run ] in-thread" } ;
|
{ $code "USE: threads" "[ \"ui.tools\" run ] in-thread" } ;
|
||||||
|
|
||||||
ARTICLE: "ui-shortcuts" "UI tool keyboard shortcuts"
|
ARTICLE: "ui-shortcuts" "UI tool keyboard shortcuts"
|
||||||
"Every UI tool has its own set of keyboard shortcuts; press " { $snippet "F1" } " inside a tool to see help. Some common shortcuts are also supported by all tools:"
|
"Every UI tool has its own set of keyboard shortcuts. Mouse-over a toolbar button to see its shortcut, if any, in the status bar, or press " { $snippet "F1" } " to see a list of all shortcuts supported by the tool."
|
||||||
|
$nl
|
||||||
|
"Some common shortcuts are supported by all tools:"
|
||||||
{ $command-map tool "tool-switching" }
|
{ $command-map tool "tool-switching" }
|
||||||
{ $command-map tool "common" } ;
|
{ $command-map tool "common" } ;
|
||||||
|
|
||||||
|
|
|
@ -1,13 +1,13 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: compiler.units fry kernel vocabs vocabs.parser ;
|
USING: compiler.units continuations fry kernel vocabs vocabs.parser ;
|
||||||
IN: vocabs.generated
|
IN: vocabs.generated
|
||||||
|
|
||||||
: generate-vocab ( vocab-name quot -- vocab )
|
: generate-vocab ( vocab-name quot -- vocab )
|
||||||
[ dup vocab [ ] ] dip '[
|
[ dup vocab [ ] ] dip '[
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
_ with-current-vocab
|
[ _ with-current-vocab ] [ ] [ forget-vocab ] cleanup
|
||||||
] with-compilation-unit
|
] with-compilation-unit
|
||||||
] keep
|
] keep
|
||||||
] ?if ; inline
|
] ?if ; inline
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Joe Groff
|
|
@ -0,0 +1,28 @@
|
||||||
|
! (c)2009 Joe Groff bsd license
|
||||||
|
USING: alien.c-types alien.libraries alien.syntax classes.struct windows.types ;
|
||||||
|
IN: windows.dwmapi
|
||||||
|
|
||||||
|
STRUCT: MARGINS
|
||||||
|
{ cxLeftWidth int }
|
||||||
|
{ cxRightWidth int }
|
||||||
|
{ cyTopHeight int }
|
||||||
|
{ cyBottomHeight int } ;
|
||||||
|
|
||||||
|
STRUCT: DWM_BLURBEHIND
|
||||||
|
{ dwFlags DWORD }
|
||||||
|
{ fEnable BOOL }
|
||||||
|
{ hRgnBlur HANDLE }
|
||||||
|
{ fTransitionOnMaximized BOOL } ;
|
||||||
|
|
||||||
|
: <MARGINS> ( l r t b -- MARGINS )
|
||||||
|
MARGINS <struct-boa> ; inline
|
||||||
|
|
||||||
|
: full-window-margins ( -- MARGINS )
|
||||||
|
-1 -1 -1 -1 <MARGINS> ; inline
|
||||||
|
|
||||||
|
<< "dwmapi" "dwmapi.dll" "stdcall" add-library >>
|
||||||
|
|
||||||
|
LIBRARY: dwmapi
|
||||||
|
|
||||||
|
FUNCTION: HRESULT DwmExtendFrameIntoClientArea ( HWND hWnd, MARGINS* pMarInset ) ;
|
||||||
|
FUNCTION: HRESULT DwmEnableBlurBehindWindow ( HWND hWnd, DWM_BLURBEHIND* pBlurBehind ) ;
|
|
@ -0,0 +1 @@
|
||||||
|
Windows Vista Desktop Window Manager API functions
|
|
@ -0,0 +1,2 @@
|
||||||
|
windows
|
||||||
|
unportable
|
|
@ -29,17 +29,12 @@ ARTICLE: "cleave-combinators" "Cleave combinators"
|
||||||
"The cleave combinators apply multiple quotations to a single value."
|
"The cleave combinators apply multiple quotations to a single value."
|
||||||
$nl
|
$nl
|
||||||
"Two quotations:"
|
"Two quotations:"
|
||||||
{ $subsection bi }
|
{ $subsections bi 2bi 3bi }
|
||||||
{ $subsection 2bi }
|
|
||||||
{ $subsection 3bi }
|
|
||||||
"Three quotations:"
|
"Three quotations:"
|
||||||
{ $subsection tri }
|
{ $subsections tri 2tri 3tri }
|
||||||
{ $subsection 2tri }
|
|
||||||
{ $subsection 3tri }
|
|
||||||
"An array of quotations:"
|
"An array of quotations:"
|
||||||
{ $subsection cleave }
|
{ $subsection cleave 2cleave 3cleave }
|
||||||
{ $subsection 2cleave }
|
$nl
|
||||||
{ $subsection 3cleave }
|
|
||||||
"Technically, the cleave combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on the top of the stack can be written in one of two ways:"
|
"Technically, the cleave combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on the top of the stack can be written in one of two ways:"
|
||||||
{ $code
|
{ $code
|
||||||
"! First alternative; uses keep"
|
"! First alternative; uses keep"
|
||||||
|
@ -52,6 +47,7 @@ $nl
|
||||||
"[ 2 * ] tri"
|
"[ 2 * ] tri"
|
||||||
}
|
}
|
||||||
"The latter is more aesthetically pleasing than the former."
|
"The latter is more aesthetically pleasing than the former."
|
||||||
|
$nl
|
||||||
{ $subsection "cleave-shuffle-equivalence" } ;
|
{ $subsection "cleave-shuffle-equivalence" } ;
|
||||||
|
|
||||||
ARTICLE: "spread-shuffle-equivalence" "Expressing shuffle words with spread combinators"
|
ARTICLE: "spread-shuffle-equivalence" "Expressing shuffle words with spread combinators"
|
||||||
|
@ -88,13 +84,11 @@ ARTICLE: "spread-combinators" "Spread combinators"
|
||||||
"The spread combinators apply multiple quotations to multiple values. In this case, " { $snippet "*" } " suffix signify spreading."
|
"The spread combinators apply multiple quotations to multiple values. In this case, " { $snippet "*" } " suffix signify spreading."
|
||||||
$nl
|
$nl
|
||||||
"Two quotations:"
|
"Two quotations:"
|
||||||
{ $subsection bi* }
|
{ $subsections bi* 2bi* }
|
||||||
{ $subsection 2bi* }
|
|
||||||
"Three quotations:"
|
"Three quotations:"
|
||||||
{ $subsection tri* }
|
{ $subsections tri* 2tri* }
|
||||||
{ $subsection 2tri* }
|
|
||||||
"An array of quotations:"
|
"An array of quotations:"
|
||||||
{ $subsection spread }
|
{ $subsections spread }
|
||||||
"Technically, the spread combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on three related values can be written in one of two ways:"
|
"Technically, the spread combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on three related values can be written in one of two ways:"
|
||||||
{ $code
|
{ $code
|
||||||
"! First alternative; uses dip"
|
"! First alternative; uses dip"
|
||||||
|
@ -103,44 +97,34 @@ $nl
|
||||||
"[ 1 + ] [ 1 - ] [ 2 * ] tri*"
|
"[ 1 + ] [ 1 - ] [ 2 * ] tri*"
|
||||||
}
|
}
|
||||||
"A generalization of the above combinators to any number of quotations can be found in " { $link "combinators" } "."
|
"A generalization of the above combinators to any number of quotations can be found in " { $link "combinators" } "."
|
||||||
|
$nl
|
||||||
{ $subsection "spread-shuffle-equivalence" } ;
|
{ $subsection "spread-shuffle-equivalence" } ;
|
||||||
|
|
||||||
ARTICLE: "apply-combinators" "Apply combinators"
|
ARTICLE: "apply-combinators" "Apply combinators"
|
||||||
"The apply combinators apply a single quotation to multiple values. The " { $snippet "@" } " suffix signifies application."
|
"The apply combinators apply a single quotation to multiple values. The " { $snippet "@" } " suffix signifies application."
|
||||||
$nl
|
$nl
|
||||||
"Two quotations:"
|
"Two quotations:"
|
||||||
{ $subsection bi@ }
|
{ $subsections bi@ 2bi@ }
|
||||||
{ $subsection 2bi@ }
|
|
||||||
"Three quotations:"
|
"Three quotations:"
|
||||||
{ $subsection tri@ }
|
{ $subsections tri@ 2tri@ }
|
||||||
{ $subsection 2tri@ }
|
|
||||||
"A pair of utility words built from " { $link bi@ } ":"
|
"A pair of utility words built from " { $link bi@ } ":"
|
||||||
{ $subsection both? }
|
{ $subsections both? either? } ;
|
||||||
{ $subsection either? } ;
|
|
||||||
|
|
||||||
ARTICLE: "retainstack-combinators" "Retain stack combinators"
|
ARTICLE: "retainstack-combinators" "Retain stack combinators"
|
||||||
"Sometimes an additional storage area is needed to hold objects. The " { $emphasis "retain stack" } " is an auxilliary stack for this purpose. Objects can be moved between the data and retain stacks using a set of combinators."
|
"Sometimes an additional storage area is needed to hold objects. The " { $emphasis "retain stack" } " is an auxilliary stack for this purpose. Objects can be moved between the data and retain stacks using a set of combinators."
|
||||||
$nl
|
$nl
|
||||||
"The dip combinators invoke the quotation at the top of the stack, hiding the values underneath:"
|
"The dip combinators invoke the quotation at the top of the stack, hiding the values underneath:"
|
||||||
{ $subsection dip }
|
{ $subsections dip 2dip 3dip 4dip }
|
||||||
{ $subsection 2dip }
|
|
||||||
{ $subsection 3dip }
|
|
||||||
{ $subsection 4dip }
|
|
||||||
"The keep combinators invoke a quotation which takes a number of values off the stack, and then they restore those values:"
|
"The keep combinators invoke a quotation which takes a number of values off the stack, and then they restore those values:"
|
||||||
{ $subsection keep }
|
{ $subsections keep 2keep 3keep } ;
|
||||||
{ $subsection 2keep }
|
|
||||||
{ $subsection 3keep } ;
|
|
||||||
|
|
||||||
ARTICLE: "curried-dataflow" "Curried dataflow combinators"
|
ARTICLE: "curried-dataflow" "Curried dataflow combinators"
|
||||||
"Curried cleave combinators:"
|
"Curried cleave combinators:"
|
||||||
{ $subsection bi-curry }
|
{ $subsections bi-curry tri-curry }
|
||||||
{ $subsection tri-curry }
|
|
||||||
"Curried spread combinators:"
|
"Curried spread combinators:"
|
||||||
{ $subsection bi-curry* }
|
{ $subsections bi-curry* tri-curry* }
|
||||||
{ $subsection tri-curry* }
|
|
||||||
"Curried apply combinators:"
|
"Curried apply combinators:"
|
||||||
{ $subsection bi-curry@ }
|
{ $subsections bi-curry@ tri-curry@ }
|
||||||
{ $subsection tri-curry@ }
|
|
||||||
{ $see-also "dataflow-combinators" } ;
|
{ $see-also "dataflow-combinators" } ;
|
||||||
|
|
||||||
ARTICLE: "compositional-examples" "Examples of compositional combinator usage"
|
ARTICLE: "compositional-examples" "Examples of compositional combinator usage"
|
||||||
|
@ -170,33 +154,30 @@ $nl
|
||||||
|
|
||||||
ARTICLE: "compositional-combinators" "Compositional combinators"
|
ARTICLE: "compositional-combinators" "Compositional combinators"
|
||||||
"Certain combinators transform quotations to produce a new quotation."
|
"Certain combinators transform quotations to produce a new quotation."
|
||||||
{ $subsection "compositional-examples" }
|
{ $subsections "compositional-examples" }
|
||||||
"Fundamental operations:"
|
"Fundamental operations:"
|
||||||
{ $subsection curry }
|
{ $subsections curry compose }
|
||||||
{ $subsection compose }
|
|
||||||
"Derived operations:"
|
"Derived operations:"
|
||||||
{ $subsection 2curry }
|
{ $subsections 2curry 3curry with prepose }
|
||||||
{ $subsection 3curry }
|
|
||||||
{ $subsection with }
|
|
||||||
{ $subsection prepose }
|
|
||||||
"These operations run in constant time, and in many cases are optimized out altogether by the " { $link "compiler" } ". " { $link "fry" } " are an abstraction built on top of these operations, and code that uses this abstraction is often clearer than direct calls to the below words."
|
"These operations run in constant time, and in many cases are optimized out altogether by the " { $link "compiler" } ". " { $link "fry" } " are an abstraction built on top of these operations, and code that uses this abstraction is often clearer than direct calls to the below words."
|
||||||
$nl
|
$nl
|
||||||
"Curried dataflow combinators can be used to build more complex dataflow by combining cleave, spread and apply patterns in various ways."
|
"Curried dataflow combinators can be used to build more complex dataflow by combining cleave, spread and apply patterns in various ways."
|
||||||
{ $subsection "curried-dataflow" }
|
{ $subsections "curried-dataflow" }
|
||||||
"Quotations also implement the sequence protocol, and can be manipulated with sequence words; see " { $link "quotations" } ". However, such runtime quotation manipulation will not be optimized by the optimizing compiler." ;
|
"Quotations also implement the sequence protocol, and can be manipulated with sequence words; see " { $link "quotations" } ". However, such runtime quotation manipulation will not be optimized by the optimizing compiler." ;
|
||||||
|
|
||||||
ARTICLE: "booleans" "Booleans"
|
ARTICLE: "booleans" "Booleans"
|
||||||
"In Factor, any object that is not " { $link f } " has a true value, and " { $link f } " has a false value. The " { $link t } " object is the canonical true value."
|
"In Factor, any object that is not " { $link f } " has a true value, and " { $link f } " has a false value. The " { $link t } " object is the canonical true value."
|
||||||
{ $subsection f }
|
{ $subsections f t }
|
||||||
{ $subsection t }
|
|
||||||
"A union class of the above:"
|
"A union class of the above:"
|
||||||
{ $subsection boolean }
|
{ $subsections boolean }
|
||||||
"There are some logical operations on booleans:"
|
"There are some logical operations on booleans:"
|
||||||
{ $subsection >boolean }
|
{ $subsections
|
||||||
{ $subsection not }
|
>boolean
|
||||||
{ $subsection and }
|
not
|
||||||
{ $subsection or }
|
and
|
||||||
{ $subsection xor }
|
or
|
||||||
|
xor
|
||||||
|
}
|
||||||
"Boolean values are most frequently used for " { $link "conditionals" } "."
|
"Boolean values are most frequently used for " { $link "conditionals" } "."
|
||||||
{ $heading "The f object and f class" }
|
{ $heading "The f object and f class" }
|
||||||
"The " { $link f } " object is the unique instance of the " { $link f } " class; the two are distinct objects. The latter is also a parsing word which adds the " { $link f } " object to the parse tree at parse time. To refer to the class itself you must use " { $link POSTPONE: POSTPONE: } " or " { $link POSTPONE: \ } " to prevent the parsing word from executing."
|
"The " { $link f } " object is the unique instance of the " { $link f } " class; the two are distinct objects. The latter is also a parsing word which adds the " { $link f } " object to the parse tree at parse time. To refer to the class itself you must use " { $link POSTPONE: POSTPONE: } " or " { $link POSTPONE: \ } " to prevent the parsing word from executing."
|
||||||
|
@ -231,41 +212,35 @@ $nl
|
||||||
|
|
||||||
ARTICLE: "conditionals" "Conditional combinators"
|
ARTICLE: "conditionals" "Conditional combinators"
|
||||||
"The basic conditionals:"
|
"The basic conditionals:"
|
||||||
{ $subsection if }
|
{ $subsections if when unless }
|
||||||
{ $subsection when }
|
|
||||||
{ $subsection unless }
|
|
||||||
"Forms abstracting a common stack shuffle pattern:"
|
"Forms abstracting a common stack shuffle pattern:"
|
||||||
{ $subsection if* }
|
{ $subsections if* when* unless* }
|
||||||
{ $subsection when* }
|
|
||||||
{ $subsection unless* }
|
|
||||||
"Another form abstracting a common stack shuffle pattern:"
|
"Another form abstracting a common stack shuffle pattern:"
|
||||||
{ $subsection ?if }
|
{ $subsections ?if }
|
||||||
"Sometimes instead of branching, you just need to pick one of two values:"
|
"Sometimes instead of branching, you just need to pick one of two values:"
|
||||||
{ $subsection ? }
|
{ $subsections ? }
|
||||||
"Two combinators which abstract out nested chains of " { $link if } ":"
|
"Two combinators which abstract out nested chains of " { $link if } ":"
|
||||||
{ $subsection cond }
|
{ $subsections cond case }
|
||||||
{ $subsection case }
|
|
||||||
{ $subsection "conditionals-boolean-equivalence" }
|
{ $subsection "conditionals-boolean-equivalence" }
|
||||||
{ $see-also "booleans" "bitwise-arithmetic" both? either? } ;
|
{ $see-also "booleans" "bitwise-arithmetic" both? either? } ;
|
||||||
|
|
||||||
ARTICLE: "dataflow-combinators" "Data flow combinators"
|
ARTICLE: "dataflow-combinators" "Data flow combinators"
|
||||||
"Data flow combinators pass values between quotations:"
|
"Data flow combinators pass values between quotations:"
|
||||||
{ $subsection "retainstack-combinators" }
|
{ $subsections
|
||||||
{ $subsection "cleave-combinators" }
|
"retainstack-combinators"
|
||||||
{ $subsection "spread-combinators" }
|
"cleave-combinators"
|
||||||
{ $subsection "apply-combinators" }
|
"spread-combinators"
|
||||||
|
"apply-combinators"
|
||||||
|
}
|
||||||
{ $see-also "curried-dataflow" } ;
|
{ $see-also "curried-dataflow" } ;
|
||||||
|
|
||||||
ARTICLE: "combinators-quot" "Quotation construction utilities"
|
ARTICLE: "combinators-quot" "Quotation construction utilities"
|
||||||
"Some words for creating quotations which can be useful for implementing method combinations and compiler transforms:"
|
"Some words for creating quotations which can be useful for implementing method combinations and compiler transforms:"
|
||||||
{ $subsection cond>quot }
|
{ $subsections cond>quot case>quot alist>quot } ;
|
||||||
{ $subsection case>quot }
|
|
||||||
{ $subsection alist>quot } ;
|
|
||||||
|
|
||||||
ARTICLE: "call-unsafe" "Unsafe combinators"
|
ARTICLE: "call-unsafe" "Unsafe combinators"
|
||||||
"Unsafe calls declare an effect statically without any runtime checking:"
|
"Unsafe calls declare an effect statically without any runtime checking:"
|
||||||
{ $subsection call-effect-unsafe }
|
{ $subsections call-effect-unsafe execute-effect-unsafe } ;
|
||||||
{ $subsection execute-effect-unsafe } ;
|
|
||||||
|
|
||||||
ARTICLE: "call" "Fundamental combinators"
|
ARTICLE: "call" "Fundamental combinators"
|
||||||
"The most basic combinators are those that take either a quotation or word, and invoke it immediately."
|
"The most basic combinators are those that take either a quotation or word, and invoke it immediately."
|
||||||
|
@ -273,30 +248,29 @@ $nl
|
||||||
"There are two sets of combinators; they differ in whether or not the stack effect of the expected code is declared."
|
"There are two sets of combinators; they differ in whether or not the stack effect of the expected code is declared."
|
||||||
$nl
|
$nl
|
||||||
"The simplest combinators do not take an effect declaration. The compiler checks the stack effect at compile time, rejecting the program if this cannot be done:"
|
"The simplest combinators do not take an effect declaration. The compiler checks the stack effect at compile time, rejecting the program if this cannot be done:"
|
||||||
{ $subsection call }
|
{ $subsections call execute }
|
||||||
{ $subsection execute }
|
|
||||||
"The second set of combinators takes an effect declaration. Note that the opening parenthesis is actually part of the word name; these are parsing words, and they read a stack effect until the corresponding closing parenthesis. The stack effect of the quotation or word is then checked at runtime:"
|
"The second set of combinators takes an effect declaration. Note that the opening parenthesis is actually part of the word name; these are parsing words, and they read a stack effect until the corresponding closing parenthesis. The stack effect of the quotation or word is then checked at runtime:"
|
||||||
{ $subsection POSTPONE: call( }
|
{ $subsections POSTPONE: call( POSTPONE: execute( }
|
||||||
{ $subsection POSTPONE: execute( }
|
|
||||||
"The above are syntax sugar. The underlying words are a bit more verbose but allow non-constant effects to be passed in:"
|
"The above are syntax sugar. The underlying words are a bit more verbose but allow non-constant effects to be passed in:"
|
||||||
{ $subsection call-effect }
|
{ $subsections call-effect execute-effect }
|
||||||
{ $subsection execute-effect }
|
|
||||||
"The combinator variants that do not take an effect declaration can only be used if the compiler is able to infer the stack effect by other means. See " { $link "inference-combinators" } "."
|
"The combinator variants that do not take an effect declaration can only be used if the compiler is able to infer the stack effect by other means. See " { $link "inference-combinators" } "."
|
||||||
{ $subsection "call-unsafe" }
|
{ $subsection "call-unsafe" }
|
||||||
{ $see-also "effects" "inference" } ;
|
{ $see-also "effects" "inference" } ;
|
||||||
|
|
||||||
ARTICLE: "combinators" "Combinators"
|
ARTICLE: "combinators" "Combinators"
|
||||||
"A central concept in Factor is that of a " { $emphasis "combinator" } ", which is a word taking code as input."
|
"A central concept in Factor is that of a " { $emphasis "combinator" } ", which is a word taking code as input."
|
||||||
{ $subsection "call" }
|
{ $subsections
|
||||||
{ $subsection "dataflow-combinators" }
|
"call"
|
||||||
{ $subsection "conditionals" }
|
"dataflow-combinators"
|
||||||
{ $subsection "looping-combinators" }
|
"conditionals"
|
||||||
{ $subsection "compositional-combinators" }
|
"looping-combinators"
|
||||||
{ $subsection "combinators.short-circuit" }
|
"compositional-combinators"
|
||||||
{ $subsection "combinators.smart" }
|
"combinators.short-circuit"
|
||||||
|
"combinators.smart"
|
||||||
|
"combinators-quot"
|
||||||
|
"generalizations"
|
||||||
|
}
|
||||||
"More combinators are defined for working on data structures, such as " { $link "sequences-combinators" } " and " { $link "assocs-combinators" } "."
|
"More combinators are defined for working on data structures, such as " { $link "sequences-combinators" } " and " { $link "assocs-combinators" } "."
|
||||||
{ $subsection "combinators-quot" }
|
|
||||||
{ $subsection "generalizations" }
|
|
||||||
{ $see-also "quotations" } ;
|
{ $see-also "quotations" } ;
|
||||||
|
|
||||||
ABOUT: "combinators"
|
ABOUT: "combinators"
|
||||||
|
|
|
@ -103,7 +103,7 @@ TUPLE: check-method class generic ;
|
||||||
[ drop remake-generic drop ]
|
[ drop remake-generic drop ]
|
||||||
3tri ; inline
|
3tri ; inline
|
||||||
|
|
||||||
: method-word-name ( class word -- string )
|
: method-word-name ( class generic -- string )
|
||||||
[ name>> ] bi@ "=>" glue ;
|
[ name>> ] bi@ "=>" glue ;
|
||||||
|
|
||||||
PREDICATE: method-body < word
|
PREDICATE: method-body < word
|
||||||
|
@ -123,9 +123,8 @@ M: method-body crossref?
|
||||||
|
|
||||||
: <method> ( class generic -- method )
|
: <method> ( class generic -- method )
|
||||||
check-method
|
check-method
|
||||||
[ method-word-props ] 2keep
|
[ method-word-name f <word> ] [ method-word-props ] 2bi
|
||||||
method-word-name f <word>
|
>>props ;
|
||||||
swap >>props ;
|
|
||||||
|
|
||||||
: with-implementors ( class generic quot -- )
|
: with-implementors ( class generic quot -- )
|
||||||
[ swap implementors-map get at ] dip call ; inline
|
[ swap implementors-map get at ] dip call ; inline
|
||||||
|
|
|
@ -8,17 +8,21 @@ $nl
|
||||||
"Integers can be converted to and from arbitrary bases. Floating point numbers can only be converted to and from base 10 and 16."
|
"Integers can be converted to and from arbitrary bases. Floating point numbers can only be converted to and from base 10 and 16."
|
||||||
$nl
|
$nl
|
||||||
"Converting numbers to strings:"
|
"Converting numbers to strings:"
|
||||||
{ $subsection number>string }
|
{ $subsections
|
||||||
{ $subsection >bin }
|
number>string
|
||||||
{ $subsection >oct }
|
>bin
|
||||||
{ $subsection >hex }
|
>oct
|
||||||
{ $subsection >base }
|
>hex
|
||||||
|
>base
|
||||||
|
}
|
||||||
"Converting strings to numbers:"
|
"Converting strings to numbers:"
|
||||||
{ $subsection string>number }
|
{ $subsections
|
||||||
{ $subsection bin> }
|
string>number
|
||||||
{ $subsection oct> }
|
bin>
|
||||||
{ $subsection hex> }
|
oct>
|
||||||
{ $subsection base> }
|
hex>
|
||||||
|
base>
|
||||||
|
}
|
||||||
"You can also input literal numbers in a different base (" { $link "syntax-integers" } ")."
|
"You can also input literal numbers in a different base (" { $link "syntax-integers" } ")."
|
||||||
{ $see-also "prettyprint-numbers" } ;
|
{ $see-also "prettyprint-numbers" } ;
|
||||||
|
|
||||||
|
|
|
@ -1336,49 +1336,39 @@ $nl
|
||||||
|
|
||||||
ARTICLE: "sequence-protocol" "Sequence protocol"
|
ARTICLE: "sequence-protocol" "Sequence protocol"
|
||||||
"All sequences must be instances of a mixin class:"
|
"All sequences must be instances of a mixin class:"
|
||||||
{ $subsection sequence }
|
{ $subsections sequence sequence? }
|
||||||
{ $subsection sequence? }
|
|
||||||
"All sequences must know their length:"
|
"All sequences must know their length:"
|
||||||
{ $subsection length }
|
{ $subsections length }
|
||||||
"At least one of the following two generic words must have a method for accessing elements; the " { $link sequence } " mixin has default definitions which are mutually recursive:"
|
"At least one of the following two generic words must have a method for accessing elements; the " { $link sequence } " mixin has default definitions which are mutually recursive:"
|
||||||
{ $subsection nth }
|
{ $subsections nth nth-unsafe }
|
||||||
{ $subsection nth-unsafe }
|
|
||||||
"Note that sequences are always indexed starting from zero."
|
"Note that sequences are always indexed starting from zero."
|
||||||
$nl
|
$nl
|
||||||
"At least one of the following two generic words must have a method for storing elements; the " { $link sequence } " mixin has default definitions which are mutually recursive:"
|
"At least one of the following two generic words must have a method for storing elements; the " { $link sequence } " mixin has default definitions which are mutually recursive:"
|
||||||
{ $subsection set-nth }
|
{ $subsections set-nth set-nth-unsafe }
|
||||||
{ $subsection set-nth-unsafe }
|
"If your sequence is immutable, then you must implement either " { $link set-nth } " or " { $link set-nth-unsafe } " to simply call " { $link immutable } " to signal an error."
|
||||||
"Note that even if the sequence is immutable, at least one of the generic words must be specialized, otherwise calling them will result in an infinite recursion. There is a standard word which throws an error indicating a sequence is immutable:"
|
$nl
|
||||||
{ $subsection immutable }
|
|
||||||
"The following two generic words are optional, as not all sequences are resizable:"
|
"The following two generic words are optional, as not all sequences are resizable:"
|
||||||
{ $subsection set-length }
|
{ $subsections set-length lengthen }
|
||||||
{ $subsection lengthen }
|
|
||||||
"An optional generic word for creating sequences of the same class as a given sequence:"
|
"An optional generic word for creating sequences of the same class as a given sequence:"
|
||||||
{ $subsection like }
|
{ $subsections like }
|
||||||
"Optional generic words for optimization purposes:"
|
"Optional generic words for optimization purposes:"
|
||||||
{ $subsection new-sequence }
|
{ $subsections new-sequence new-resizable }
|
||||||
{ $subsection new-resizable }
|
|
||||||
{ $see-also "sequences-unsafe" } ;
|
{ $see-also "sequences-unsafe" } ;
|
||||||
|
|
||||||
ARTICLE: "virtual-sequences-protocol" "Virtual sequence protocol"
|
ARTICLE: "virtual-sequences-protocol" "Virtual sequence protocol"
|
||||||
"Virtual sequences must know their length:"
|
"Virtual sequences must know their length:"
|
||||||
{ $subsection length }
|
{ $subsections length }
|
||||||
"The underlying sequence to look up a value in:"
|
"The underlying sequence to look up a value in:"
|
||||||
{ $subsection virtual-seq }
|
{ $subsections virtual-seq }
|
||||||
"The index of the value in the underlying sequence:"
|
"The index of the value in the underlying sequence:"
|
||||||
{ $subsection virtual@ } ;
|
{ $subsections virtual@ } ;
|
||||||
|
|
||||||
ARTICLE: "virtual-sequences" "Virtual sequences"
|
ARTICLE: "virtual-sequences" "Virtual sequences"
|
||||||
"A virtual sequence is an implementation of the " { $link "sequence-protocol" } " which does not store its own elements, and instead computes them, either from scratch or by retrieving them from another sequence."
|
"A virtual sequence is an implementation of the " { $link "sequence-protocol" } " which does not store its own elements, and instead computes them, either from scratch or by retrieving them from another sequence."
|
||||||
$nl
|
$nl
|
||||||
"Implementations include the following:"
|
"Implementations include the following:"
|
||||||
{ $list
|
{ $subsections reversed slice iota }
|
||||||
{ $link reversed }
|
"Virtual sequences can be implemented with the " { $link "virtual-sequences-protocol" } ", by translating an index in the virtual sequence into an index in another sequence." ;
|
||||||
{ $link slice }
|
|
||||||
{ $link iota }
|
|
||||||
}
|
|
||||||
"Virtual sequences can be implemented with the " { $link "virtual-sequences-protocol" } ", by translating an index in the virtual sequence into an index in another sequence:"
|
|
||||||
{ $subsection "virtual-sequences-protocol" } ;
|
|
||||||
|
|
||||||
ARTICLE: "sequences-integers" "Counted loops"
|
ARTICLE: "sequences-integers" "Counted loops"
|
||||||
"Integers support the sequence protocol in a trivial fashion; a non-negative integer presents its non-negative predecessors as elements. For example, the integer 3, when viewed as a sequence, contains the elements 0, 1, and 2. This is very useful for performing counted loops."
|
"Integers support the sequence protocol in a trivial fashion; a non-negative integer presents its non-negative predecessors as elements. For example, the integer 3, when viewed as a sequence, contains the elements 0, 1, and 2. This is very useful for performing counted loops."
|
||||||
|
@ -1395,59 +1385,50 @@ ARTICLE: "sequences-if" "Control flow with sequences"
|
||||||
"To reduce the boilerplate of checking if a sequence is empty, several combinators are provided."
|
"To reduce the boilerplate of checking if a sequence is empty, several combinators are provided."
|
||||||
$nl
|
$nl
|
||||||
"Checking if a sequence is empty:"
|
"Checking if a sequence is empty:"
|
||||||
{ $subsection if-empty }
|
{ $subsections if-empty when-empty unless-empty } ;
|
||||||
{ $subsection when-empty }
|
|
||||||
{ $subsection unless-empty } ;
|
|
||||||
|
|
||||||
ARTICLE: "sequences-access" "Accessing sequence elements"
|
ARTICLE: "sequences-access" "Accessing sequence elements"
|
||||||
{ $subsection ?nth }
|
"Element access by index, without raising exceptions:"
|
||||||
|
{ $subsections ?nth }
|
||||||
"Concise way of extracting one of the first four elements:"
|
"Concise way of extracting one of the first four elements:"
|
||||||
{ $subsection first }
|
{ $subsections first second third fourth }
|
||||||
{ $subsection second }
|
|
||||||
{ $subsection third }
|
|
||||||
{ $subsection fourth }
|
|
||||||
"Extracting the last element:"
|
"Extracting the last element:"
|
||||||
{ $subsection last }
|
{ $subsections last }
|
||||||
"Unpacking sequences:"
|
"Unpacking sequences:"
|
||||||
{ $subsection first2 }
|
{ $subsections first2 first3 first4 }
|
||||||
{ $subsection first3 }
|
|
||||||
{ $subsection first4 }
|
|
||||||
{ $see-also nth } ;
|
{ $see-also nth } ;
|
||||||
|
|
||||||
ARTICLE: "sequences-add-remove" "Adding and removing sequence elements"
|
ARTICLE: "sequences-add-remove" "Adding and removing sequence elements"
|
||||||
"Adding elements:"
|
"Adding elements:"
|
||||||
{ $subsection prefix }
|
{ $subsections prefix suffix }
|
||||||
{ $subsection suffix }
|
|
||||||
"Removing elements:"
|
"Removing elements:"
|
||||||
{ $subsection remove }
|
{ $subsections remove remq remove-nth } ;
|
||||||
{ $subsection remq }
|
|
||||||
{ $subsection remove-nth } ;
|
|
||||||
|
|
||||||
ARTICLE: "sequences-reshape" "Reshaping sequences"
|
ARTICLE: "sequences-reshape" "Reshaping sequences"
|
||||||
"A " { $emphasis "repetition" } " is a virtual sequence consisting of a single element repeated multiple times:"
|
"A " { $emphasis "repetition" } " is a virtual sequence consisting of a single element repeated multiple times:"
|
||||||
{ $subsection repetition }
|
{ $subsections repetition <repetition> }
|
||||||
{ $subsection <repetition> }
|
|
||||||
"Reversing a sequence:"
|
"Reversing a sequence:"
|
||||||
{ $subsection reverse }
|
{ $subsections reverse }
|
||||||
"A " { $emphasis "reversal" } " presents a reversed view of an underlying sequence:"
|
"A " { $emphasis "reversal" } " presents a reversed view of an underlying sequence:"
|
||||||
{ $subsection reversed }
|
{ $subsections reversed <reversed> }
|
||||||
{ $subsection <reversed> }
|
|
||||||
"Transposing a matrix:"
|
"Transposing a matrix:"
|
||||||
{ $subsection flip } ;
|
{ $subsections flip } ;
|
||||||
|
|
||||||
ARTICLE: "sequences-appending" "Appending sequences"
|
ARTICLE: "sequences-appending" "Appending sequences"
|
||||||
{ $subsection append }
|
"Basic append operations:"
|
||||||
{ $subsection append-as }
|
{ $subsections
|
||||||
{ $subsection prepend }
|
append
|
||||||
{ $subsection 3append }
|
append-as
|
||||||
{ $subsection 3append-as }
|
prepend
|
||||||
{ $subsection surround }
|
3append
|
||||||
{ $subsection glue }
|
3append-as
|
||||||
{ $subsection concat }
|
surround
|
||||||
{ $subsection join }
|
glue
|
||||||
|
}
|
||||||
|
"Collapse a sequence unto itself:"
|
||||||
|
{ $subsections concat join }
|
||||||
"A pair of words useful for aligning strings:"
|
"A pair of words useful for aligning strings:"
|
||||||
{ $subsection pad-head }
|
{ $subsections pad-head pad-tail } ;
|
||||||
{ $subsection pad-tail } ;
|
|
||||||
|
|
||||||
ARTICLE: "sequences-slices" "Subsequences and slices"
|
ARTICLE: "sequences-slices" "Subsequences and slices"
|
||||||
"There are two ways to extract a subrange of elements from a sequence. The first approach creates a new sequence of the same type as the input, which does not share storage with the underlying sequence. This takes time proportional to the number of elements being extracted. The second approach creates a " { $emphasis "slice" } ", which is a virtual sequence (see " { $link "virtual-sequences" } ") sharing storage with the original sequence. Slices are constructed in constant time."
|
"There are two ways to extract a subrange of elements from a sequence. The first approach creates a new sequence of the same type as the input, which does not share storage with the underlying sequence. This takes time proportional to the number of elements being extracted. The second approach creates a " { $emphasis "slice" } ", which is a virtual sequence (see " { $link "virtual-sequences" } ") sharing storage with the original sequence. Slices are constructed in constant time."
|
||||||
|
@ -1461,119 +1442,125 @@ $nl
|
||||||
}
|
}
|
||||||
{ $heading "Subsequence operations" }
|
{ $heading "Subsequence operations" }
|
||||||
"Extracting a subsequence:"
|
"Extracting a subsequence:"
|
||||||
{ $subsection subseq }
|
{ $subsections
|
||||||
{ $subsection head }
|
subseq
|
||||||
{ $subsection tail }
|
head
|
||||||
{ $subsection head* }
|
tail
|
||||||
{ $subsection tail* }
|
head*
|
||||||
|
tail*
|
||||||
|
}
|
||||||
"Removing the first or last element:"
|
"Removing the first or last element:"
|
||||||
{ $subsection rest }
|
{ $subsections rest but-last }
|
||||||
{ $subsection but-last }
|
|
||||||
"Taking a sequence apart into a head and a tail:"
|
"Taking a sequence apart into a head and a tail:"
|
||||||
{ $subsection unclip }
|
{ $subsections
|
||||||
{ $subsection unclip-last }
|
unclip
|
||||||
{ $subsection cut }
|
unclip-last
|
||||||
{ $subsection cut* }
|
cut
|
||||||
|
cut*
|
||||||
|
}
|
||||||
{ $heading "Slice operations" }
|
{ $heading "Slice operations" }
|
||||||
"The slice data type:"
|
"The slice data type:"
|
||||||
{ $subsection slice }
|
{ $subsections slice slice? }
|
||||||
{ $subsection slice? }
|
|
||||||
"Extracting a slice:"
|
"Extracting a slice:"
|
||||||
{ $subsection <slice> }
|
{ $subsections
|
||||||
{ $subsection head-slice }
|
<slice>
|
||||||
{ $subsection tail-slice }
|
head-slice
|
||||||
{ $subsection head-slice* }
|
tail-slice
|
||||||
{ $subsection tail-slice* }
|
head-slice*
|
||||||
|
tail-slice*
|
||||||
|
}
|
||||||
"Removing the first or last element:"
|
"Removing the first or last element:"
|
||||||
{ $subsection rest-slice }
|
{ $subsections rest-slice but-last-slice }
|
||||||
{ $subsection but-last-slice }
|
|
||||||
"Taking a sequence apart into a head and a tail:"
|
"Taking a sequence apart into a head and a tail:"
|
||||||
{ $subsection unclip-slice }
|
{ $subsections unclip-slice unclip-last-slice cut-slice }
|
||||||
{ $subsection unclip-last-slice }
|
|
||||||
{ $subsection cut-slice }
|
|
||||||
"A utility for words which use slices as iterators:"
|
"A utility for words which use slices as iterators:"
|
||||||
{ $subsection <flat-slice> }
|
{ $subsections <flat-slice> }
|
||||||
"Replacing slices with new elements:"
|
"Replacing slices with new elements:"
|
||||||
{ $subsection replace-slice } ;
|
{ $subsections replace-slice } ;
|
||||||
|
|
||||||
ARTICLE: "sequences-combinators" "Sequence combinators"
|
ARTICLE: "sequences-combinators" "Sequence combinators"
|
||||||
"Iteration:"
|
"Iteration:"
|
||||||
{ $subsection each }
|
{ $subsections
|
||||||
{ $subsection each-index }
|
each
|
||||||
{ $subsection reduce }
|
each-index
|
||||||
{ $subsection interleave }
|
reduce
|
||||||
{ $subsection replicate }
|
interleave
|
||||||
{ $subsection replicate-as }
|
replicate
|
||||||
|
replicate-as
|
||||||
|
}
|
||||||
"Mapping:"
|
"Mapping:"
|
||||||
{ $subsection map }
|
{ $subsections
|
||||||
{ $subsection map-as }
|
map
|
||||||
{ $subsection map-index }
|
map-as
|
||||||
{ $subsection map-reduce }
|
map-index
|
||||||
{ $subsection accumulate }
|
map-reduce
|
||||||
{ $subsection produce }
|
accumulate
|
||||||
{ $subsection produce-as }
|
produce
|
||||||
|
produce-as
|
||||||
|
}
|
||||||
"Filtering:"
|
"Filtering:"
|
||||||
{ $subsection filter }
|
{ $subsections
|
||||||
{ $subsection partition }
|
filter
|
||||||
|
partition
|
||||||
|
}
|
||||||
"Testing if a sequence contains elements satisfying a predicate:"
|
"Testing if a sequence contains elements satisfying a predicate:"
|
||||||
{ $subsection any? }
|
{ $subsections
|
||||||
{ $subsection all? }
|
any?
|
||||||
|
all?
|
||||||
|
}
|
||||||
|
{ $heading "Related Articles" }
|
||||||
{ $subsection "sequence-2combinators" }
|
{ $subsection "sequence-2combinators" }
|
||||||
{ $subsection "sequence-3combinators" } ;
|
{ $subsection "sequence-3combinators" } ;
|
||||||
|
|
||||||
ARTICLE: "sequence-2combinators" "Pair-wise sequence combinators"
|
ARTICLE: "sequence-2combinators" "Pair-wise sequence combinators"
|
||||||
"There is a set of combinators which traverse two sequences pairwise. If one sequence is shorter than the other, then only the prefix having the length of the minimum of the two is examined."
|
"There is a set of combinators which traverse two sequences pairwise. If one sequence is shorter than the other, then only the prefix having the length of the minimum of the two is examined."
|
||||||
{ $subsection 2each }
|
{ $subsections
|
||||||
{ $subsection 2reduce }
|
2each
|
||||||
{ $subsection 2map }
|
2reduce
|
||||||
{ $subsection 2map-as }
|
2map
|
||||||
{ $subsection 2map-reduce }
|
2map-as
|
||||||
{ $subsection 2all? } ;
|
2map-reduce
|
||||||
|
2all?
|
||||||
|
} ;
|
||||||
|
|
||||||
ARTICLE: "sequence-3combinators" "Triple-wise sequence combinators"
|
ARTICLE: "sequence-3combinators" "Triple-wise sequence combinators"
|
||||||
"There is a set of combinators which traverse three sequences triple-wise. If one sequence is shorter than the others, then only the prefix having the length of the minimum of the three is examined."
|
"There is a set of combinators which traverse three sequences triple-wise. If one sequence is shorter than the others, then only the prefix having the length of the minimum of the three is examined."
|
||||||
{ $subsection 3each }
|
{ $subsections 3each 3map 3map-as } ;
|
||||||
{ $subsection 3map }
|
|
||||||
{ $subsection 3map-as } ;
|
|
||||||
|
|
||||||
ARTICLE: "sequences-tests" "Testing sequences"
|
ARTICLE: "sequences-tests" "Testing sequences"
|
||||||
"Testing for an empty sequence:"
|
"Testing for an empty sequence:"
|
||||||
{ $subsection empty? }
|
{ $subsections empty? }
|
||||||
"Testing indices:"
|
"Testing indices:"
|
||||||
{ $subsection bounds-check? }
|
{ $subsections bounds-check? }
|
||||||
"Testing if a sequence contains an object:"
|
"Testing if a sequence contains an object:"
|
||||||
{ $subsection member? }
|
{ $subsections member? memq? }
|
||||||
{ $subsection memq? }
|
|
||||||
"Testing if a sequence contains a subsequence:"
|
"Testing if a sequence contains a subsequence:"
|
||||||
{ $subsection head? }
|
{ $subsections head? tail? subseq? } ;
|
||||||
{ $subsection tail? }
|
|
||||||
{ $subsection subseq? } ;
|
|
||||||
|
|
||||||
ARTICLE: "sequences-search" "Searching sequences"
|
ARTICLE: "sequences-search" "Searching sequences"
|
||||||
"Finding the index of an element:"
|
"Finding the index of an element:"
|
||||||
{ $subsection index }
|
{ $subsections
|
||||||
{ $subsection index-from }
|
index
|
||||||
{ $subsection last-index }
|
index-from
|
||||||
{ $subsection last-index-from }
|
last-index
|
||||||
|
last-index-from
|
||||||
|
}
|
||||||
"Finding the start of a subsequence:"
|
"Finding the start of a subsequence:"
|
||||||
{ $subsection start }
|
{ $subsections start start* }
|
||||||
{ $subsection start* }
|
|
||||||
"Finding the index of an element satisfying a predicate:"
|
"Finding the index of an element satisfying a predicate:"
|
||||||
{ $subsection find }
|
{ $subsections
|
||||||
{ $subsection find-from }
|
find
|
||||||
{ $subsection find-last }
|
find-from
|
||||||
{ $subsection find-last-from }
|
find-last
|
||||||
{ $subsection map-find } ;
|
find-last-from
|
||||||
|
map-find
|
||||||
|
} ;
|
||||||
|
|
||||||
ARTICLE: "sequences-trimming" "Trimming sequences"
|
ARTICLE: "sequences-trimming" "Trimming sequences"
|
||||||
"Trimming words:"
|
"Trimming words:"
|
||||||
{ $subsection trim }
|
{ $subsections trim trim-head trim-tail }
|
||||||
{ $subsection trim-head }
|
|
||||||
{ $subsection trim-tail }
|
|
||||||
"Potentially more efficient trim:"
|
"Potentially more efficient trim:"
|
||||||
{ $subsection trim-slice }
|
{ $subsections trim-slice trim-head-slice trim-tail-slice } ;
|
||||||
{ $subsection trim-head-slice }
|
|
||||||
{ $subsection trim-tail-slice } ;
|
|
||||||
|
|
||||||
ARTICLE: "sequences-destructive-discussion" "When to use destructive operations"
|
ARTICLE: "sequences-destructive-discussion" "When to use destructive operations"
|
||||||
"Constructive (non-destructive) operations should be preferred where possible because code without side-effects is usually more re-usable and easier to reason about. There are two main reasons to use destructive operations:"
|
"Constructive (non-destructive) operations should be preferred where possible because code without side-effects is usually more re-usable and easier to reason about. There are two main reasons to use destructive operations:"
|
||||||
|
@ -1584,24 +1571,25 @@ ARTICLE: "sequences-destructive-discussion" "When to use destructive operations"
|
||||||
"The second reason is much weaker than the first one. In particular, many combinators (see " { $link map } ", " { $link produce } " and " { $link "namespaces-make" } ") as well as more advanced data structures (such as " { $vocab-link "persistent.vectors" } ") alleviate the need for explicit use of side effects." ;
|
"The second reason is much weaker than the first one. In particular, many combinators (see " { $link map } ", " { $link produce } " and " { $link "namespaces-make" } ") as well as more advanced data structures (such as " { $vocab-link "persistent.vectors" } ") alleviate the need for explicit use of side effects." ;
|
||||||
|
|
||||||
ARTICLE: "sequences-destructive" "Destructive operations"
|
ARTICLE: "sequences-destructive" "Destructive operations"
|
||||||
"These words modify their input, instead of creating a new sequence."
|
|
||||||
{ $subsection "sequences-destructive-discussion" }
|
|
||||||
"Changing elements:"
|
"Changing elements:"
|
||||||
{ $subsection change-each }
|
{ $subsections change-each change-nth }
|
||||||
{ $subsection change-nth }
|
|
||||||
"Deleting elements:"
|
"Deleting elements:"
|
||||||
{ $subsection delete }
|
{ $subsections
|
||||||
{ $subsection delq }
|
delete
|
||||||
{ $subsection delete-nth }
|
delq
|
||||||
{ $subsection delete-slice }
|
delete-nth
|
||||||
{ $subsection delete-all }
|
delete-slice
|
||||||
{ $subsection filter-here }
|
delete-all
|
||||||
|
filter-here
|
||||||
|
}
|
||||||
"Other destructive words:"
|
"Other destructive words:"
|
||||||
{ $subsection reverse-here }
|
{ $subsections
|
||||||
{ $subsection push-all }
|
reverse-here
|
||||||
{ $subsection move }
|
push-all
|
||||||
{ $subsection exchange }
|
move
|
||||||
{ $subsection copy }
|
exchange
|
||||||
|
copy
|
||||||
|
}
|
||||||
"Many operations have constructive and destructive variants:"
|
"Many operations have constructive and destructive variants:"
|
||||||
{ $table
|
{ $table
|
||||||
{ "Constructive" "Destructive" }
|
{ "Constructive" "Destructive" }
|
||||||
|
@ -1616,21 +1604,24 @@ ARTICLE: "sequences-destructive" "Destructive operations"
|
||||||
{ { $link map } { $link change-each } }
|
{ { $link map } { $link change-each } }
|
||||||
{ { $link filter } { $link filter-here } }
|
{ { $link filter } { $link filter-here } }
|
||||||
}
|
}
|
||||||
{ $see-also set-nth push pop "sequences-stacks" } ;
|
{ $heading "Related Articles" }
|
||||||
|
{ $subsection "sequences-destructive-discussion" }
|
||||||
|
{ $subsection "sequences-stacks" }
|
||||||
|
{ $see-also set-nth push pop } ;
|
||||||
|
|
||||||
ARTICLE: "sequences-stacks" "Treating sequences as stacks"
|
ARTICLE: "sequences-stacks" "Treating sequences as stacks"
|
||||||
"The classical stack operations, modifying a sequence in place:"
|
"The classical stack operations, modifying a sequence in place:"
|
||||||
{ $subsection push }
|
{ $subsections push pop pop* }
|
||||||
{ $subsection pop }
|
|
||||||
{ $subsection pop* }
|
|
||||||
{ $see-also empty? } ;
|
{ $see-also empty? } ;
|
||||||
|
|
||||||
ARTICLE: "sequences-comparing" "Comparing sequences"
|
ARTICLE: "sequences-comparing" "Comparing sequences"
|
||||||
"Element equality testing:"
|
"Element equality testing:"
|
||||||
{ $subsection sequence= }
|
{ $subsections
|
||||||
{ $subsection mismatch }
|
sequence=
|
||||||
{ $subsection drop-prefix }
|
mismatch
|
||||||
{ $subsection assert-sequence= }
|
drop-prefix
|
||||||
|
assert-sequence=
|
||||||
|
}
|
||||||
"The " { $link <=> } " generic word performs lexicographic comparison when applied to sequences." ;
|
"The " { $link <=> } " generic word performs lexicographic comparison when applied to sequences." ;
|
||||||
|
|
||||||
ARTICLE: "sequences-f" "The f object as a sequence"
|
ARTICLE: "sequences-f" "The f object as a sequence"
|
||||||
|
@ -1640,33 +1631,39 @@ ARTICLE: "sequences" "Sequence operations"
|
||||||
"A " { $emphasis "sequence" } " is a finite, linearly-ordered collection of elements. Words for working with sequences are in the " { $vocab-link "sequences" } " vocabulary."
|
"A " { $emphasis "sequence" } " is a finite, linearly-ordered collection of elements. Words for working with sequences are in the " { $vocab-link "sequences" } " vocabulary."
|
||||||
$nl
|
$nl
|
||||||
"Sequences implement a protocol:"
|
"Sequences implement a protocol:"
|
||||||
{ $subsection "sequence-protocol" }
|
{ $subsections
|
||||||
{ $subsection "sequences-f" }
|
"sequence-protocol"
|
||||||
|
"sequences-f"
|
||||||
|
}
|
||||||
"Sequence utility words can operate on any object whose class implements the sequence protocol. Most implementations are backed by storage. Some implementations obtain their elements from an underlying sequence, or compute them on the fly. These are known as " { $link "virtual-sequences" } "."
|
"Sequence utility words can operate on any object whose class implements the sequence protocol. Most implementations are backed by storage. Some implementations obtain their elements from an underlying sequence, or compute them on the fly. These are known as " { $link "virtual-sequences" } "."
|
||||||
{ $subsection "sequences-access" }
|
{ $subsections
|
||||||
{ $subsection "sequences-combinators" }
|
"sequences-access"
|
||||||
{ $subsection "sequences-add-remove" }
|
"sequences-combinators"
|
||||||
{ $subsection "sequences-appending" }
|
"sequences-add-remove"
|
||||||
{ $subsection "sequences-slices" }
|
"sequences-appending"
|
||||||
{ $subsection "sequences-reshape" }
|
"sequences-slices"
|
||||||
{ $subsection "sequences-tests" }
|
"sequences-reshape"
|
||||||
{ $subsection "sequences-search" }
|
"sequences-tests"
|
||||||
{ $subsection "sequences-comparing" }
|
"sequences-search"
|
||||||
{ $subsection "sequences-split" }
|
"sequences-comparing"
|
||||||
{ $subsection "grouping" }
|
"sequences-split"
|
||||||
{ $subsection "sequences-destructive" }
|
"grouping"
|
||||||
{ $subsection "sequences-stacks" }
|
"sequences-destructive"
|
||||||
{ $subsection "sequences-sorting" }
|
"sequences-stacks"
|
||||||
{ $subsection "binary-search" }
|
"sequences-sorting"
|
||||||
{ $subsection "sets" }
|
"binary-search"
|
||||||
{ $subsection "sequences-trimming" }
|
"sets"
|
||||||
{ $subsection "sequences.deep" }
|
"sequences-trimming"
|
||||||
|
"sequences.deep"
|
||||||
|
}
|
||||||
"Using sequences for looping:"
|
"Using sequences for looping:"
|
||||||
{ $subsection "sequences-integers" }
|
{ $subsections
|
||||||
{ $subsection "math.ranges" }
|
"sequences-integers"
|
||||||
|
"math.ranges"
|
||||||
|
}
|
||||||
"Using sequences for control flow:"
|
"Using sequences for control flow:"
|
||||||
{ $subsection "sequences-if" }
|
{ $subsections "sequences-if" }
|
||||||
"For inner loops:"
|
"For inner loops:"
|
||||||
{ $subsection "sequences-unsafe" } ;
|
{ $subsections "sequences-unsafe" } ;
|
||||||
|
|
||||||
ABOUT: "sequences"
|
ABOUT: "sequences"
|
||||||
|
|
|
@ -10,13 +10,15 @@ $nl
|
||||||
"Sorting combinators all take comparator quotations with stack effect " { $snippet "( elt1 elt2 -- <=> )" } ", where the output value is one of the three " { $link "order-specifiers" } "."
|
"Sorting combinators all take comparator quotations with stack effect " { $snippet "( elt1 elt2 -- <=> )" } ", where the output value is one of the three " { $link "order-specifiers" } "."
|
||||||
$nl
|
$nl
|
||||||
"Sorting a sequence with a custom comparator:"
|
"Sorting a sequence with a custom comparator:"
|
||||||
{ $subsection sort }
|
{ $subsections sort }
|
||||||
"Sorting a sequence with common comparators:"
|
"Sorting a sequence with common comparators:"
|
||||||
{ $subsection sort-with }
|
{ $subsections
|
||||||
{ $subsection inv-sort-with }
|
sort-with
|
||||||
{ $subsection natural-sort }
|
inv-sort-with
|
||||||
{ $subsection sort-keys }
|
natural-sort
|
||||||
{ $subsection sort-values } ;
|
sort-keys
|
||||||
|
sort-values
|
||||||
|
} ;
|
||||||
|
|
||||||
ABOUT: "sequences-sorting"
|
ABOUT: "sequences-sorting"
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
USING: math math.order kernel arrays byte-arrays sequences
|
USING: math math.order kernel arrays byte-arrays sequences
|
||||||
colors.hsv benchmark.mandel.params accessors colors ;
|
colors.hsv accessors colors fry benchmark.mandel.params ;
|
||||||
IN: benchmark.mandel.colors
|
IN: benchmark.mandel.colors
|
||||||
|
|
||||||
: scale ( x -- y ) 255 * >fixnum ; inline
|
: scale ( x -- y ) 255 * >fixnum ; inline
|
||||||
|
@ -11,10 +11,10 @@ CONSTANT: sat 0.85
|
||||||
CONSTANT: val 0.85
|
CONSTANT: val 0.85
|
||||||
|
|
||||||
: <color-map> ( nb-cols -- map )
|
: <color-map> ( nb-cols -- map )
|
||||||
dup [
|
[ iota ] keep '[
|
||||||
360 * swap 1 + / sat val
|
360 * _ 1 + / sat val
|
||||||
1 <hsva> >rgba scale-rgb
|
1 <hsva> >rgba scale-rgb
|
||||||
] with map ;
|
] map ;
|
||||||
|
|
||||||
: color-map ( -- map )
|
: color-map ( -- map )
|
||||||
max-iterations max-color min <color-map> ; foldable
|
max-iterations max-color min <color-map> ; foldable
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
! Copyright (C) 2005, 2008 Slava Pestov.
|
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: io kernel math math.functions sequences prettyprint
|
USING: io kernel math math.functions sequences prettyprint
|
||||||
io.files io.files.temp io.encodings io.encodings.ascii
|
io.files io.files.temp io.encodings io.encodings.ascii
|
||||||
|
@ -6,13 +6,12 @@ io.encodings.binary fry benchmark.mandel.params
|
||||||
benchmark.mandel.colors ;
|
benchmark.mandel.colors ;
|
||||||
IN: benchmark.mandel
|
IN: benchmark.mandel
|
||||||
|
|
||||||
: x-inc ( -- x ) width 200000 zoom-fact * / ; inline
|
: x-scale ( -- x ) width 200000 zoom-fact * / ; inline
|
||||||
: y-inc ( -- y ) height 150000 zoom-fact * / ; inline
|
: y-scale ( -- y ) height 150000 zoom-fact * / ; inline
|
||||||
|
|
||||||
: c ( i j -- c )
|
: scale ( x y -- z ) [ x-scale * ] [ y-scale * ] bi* rect> ; inline
|
||||||
[ x-inc * center real-part x-inc width 2 / * - + >float ]
|
|
||||||
[ y-inc * center imaginary-part y-inc height 2 / * - + >float ] bi*
|
: c ( i j -- c ) scale center width height scale 2 / - + ; inline
|
||||||
rect> ; inline
|
|
||||||
|
|
||||||
: count-iterations ( z max-iterations step-quot test-quot -- #iters )
|
: count-iterations ( z max-iterations step-quot test-quot -- #iters )
|
||||||
'[ drop @ dup @ ] find-last-integer nip ; inline
|
'[ drop @ dup @ ] find-last-integer nip ; inline
|
||||||
|
@ -25,7 +24,7 @@ IN: benchmark.mandel
|
||||||
[ color-map [ length mod ] keep nth ] [ B{ 0 0 0 } ] if* ; inline
|
[ color-map [ length mod ] keep nth ] [ B{ 0 0 0 } ] if* ; inline
|
||||||
|
|
||||||
: render ( -- )
|
: render ( -- )
|
||||||
height [ width swap '[ _ c pixel color write ] each ] each ; inline
|
height iota [ width iota swap '[ _ c pixel color write ] each ] each ; inline
|
||||||
|
|
||||||
: ppm-header ( -- )
|
: ppm-header ( -- )
|
||||||
ascii encode-output
|
ascii encode-output
|
||||||
|
|
|
@ -4,7 +4,7 @@ USING: accessors fry kernel locals math math.constants
|
||||||
math.functions math.vectors math.vectors.simd prettyprint
|
math.functions math.vectors math.vectors.simd prettyprint
|
||||||
combinators.smart sequences hints classes.struct
|
combinators.smart sequences hints classes.struct
|
||||||
specialized-arrays ;
|
specialized-arrays ;
|
||||||
SIMD: double-4
|
SIMD: double
|
||||||
IN: benchmark.nbody-simd
|
IN: benchmark.nbody-simd
|
||||||
|
|
||||||
: solar-mass ( -- x ) 4 pi sq * ; inline
|
: solar-mass ( -- x ) 4 pi sq * ; inline
|
||||||
|
|
|
@ -5,7 +5,7 @@ USING: arrays accessors io io.files io.files.temp
|
||||||
io.encodings.binary kernel math math.constants math.functions
|
io.encodings.binary kernel math math.constants math.functions
|
||||||
math.vectors math.vectors.simd math.parser make sequences
|
math.vectors math.vectors.simd math.parser make sequences
|
||||||
sequences.private words hints classes.struct ;
|
sequences.private words hints classes.struct ;
|
||||||
SIMD: double-4
|
SIMD: double
|
||||||
IN: benchmark.raytracer-simd
|
IN: benchmark.raytracer-simd
|
||||||
|
|
||||||
! parameters
|
! parameters
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel io math math.functions math.parser math.vectors
|
USING: kernel io math math.functions math.parser math.vectors
|
||||||
math.vectors.simd sequences specialized-arrays ;
|
math.vectors.simd sequences specialized-arrays ;
|
||||||
SIMD: float-4
|
SIMD: float
|
||||||
SPECIALIZED-ARRAY: float-4
|
SPECIALIZED-ARRAY: float-4
|
||||||
IN: benchmark.simd-1
|
IN: benchmark.simd-1
|
||||||
|
|
||||||
|
|
|
@ -23,7 +23,6 @@ CONSTANT: number-of-requests 1000
|
||||||
] [
|
] [
|
||||||
number-of-requests
|
number-of-requests
|
||||||
[ read1 write1 flush ] times
|
[ read1 write1 flush ] times
|
||||||
counter get count-down
|
|
||||||
] if
|
] if
|
||||||
] with-stream
|
] with-stream
|
||||||
] curry "Client handler" spawn drop server-loop ;
|
] curry "Client handler" spawn drop server-loop ;
|
||||||
|
@ -55,7 +54,7 @@ CONSTANT: number-of-requests 1000
|
||||||
: clients ( n -- )
|
: clients ( n -- )
|
||||||
dup pprint " clients: " write [
|
dup pprint " clients: " write [
|
||||||
<promise> port-promise set
|
<promise> port-promise set
|
||||||
dup 2 * <count-down> counter set
|
dup <count-down> counter set
|
||||||
[ simple-server ] "Simple server" spawn drop
|
[ simple-server ] "Simple server" spawn drop
|
||||||
yield yield
|
yield yield
|
||||||
[ [ simple-client ] "Simple client" spawn drop ] times
|
[ [ simple-client ] "Simple client" spawn drop ] times
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: alien.syntax io io.encodings.utf16n io.encodings.utf8 io.files
|
USING: alien.syntax io io.encodings.utf16n io.encodings.utf8 io.files
|
||||||
kernel namespaces sequences system threads unix.utilities ;
|
kernel namespaces sequences system threads unix.utilities ;
|
||||||
IN: mttest
|
IN: native-thread-test
|
||||||
|
|
||||||
FUNCTION: void* start_standalone_factor_in_new_thread ( int argc, char** argv ) ;
|
FUNCTION: void* start_standalone_factor_in_new_thread ( int argc, char** argv ) ;
|
||||||
|
|
||||||
|
@ -17,7 +17,7 @@ M: unix native-string-encoding utf8 ;
|
||||||
{ "-run=tetris" } start-vm-in-os-thread drop ;
|
{ "-run=tetris" } start-vm-in-os-thread drop ;
|
||||||
|
|
||||||
: start-testthread-in-os-thread ( -- )
|
: start-testthread-in-os-thread ( -- )
|
||||||
{ "-run=mttest" } start-vm-in-os-thread drop ;
|
{ "-run=native-thread-test" } start-vm-in-os-thread drop ;
|
||||||
|
|
||||||
: testthread ( -- )
|
: testthread ( -- )
|
||||||
"/tmp/hello" utf8 [ "hello!\n" write ] with-file-appender 5000000 sleep ;
|
"/tmp/hello" utf8 [ "hello!\n" write ] with-file-appender 5000000 sleep ;
|
|
@ -38,6 +38,7 @@ M: result link-href href>> ;
|
||||||
help-webapp new-dispatcher
|
help-webapp new-dispatcher
|
||||||
<main-action> "" add-responder
|
<main-action> "" add-responder
|
||||||
over <search-action> "search" add-responder
|
over <search-action> "search" add-responder
|
||||||
swap <static> "content" add-responder ;
|
swap <static> "content" add-responder
|
||||||
|
"resource:basis/definitions/icons/" <static> "icons" add-responder ;
|
||||||
|
|
||||||
|
|
||||||
|
|
62
vm/alien.cpp
62
vm/alien.cpp
|
@ -5,7 +5,7 @@ namespace factor
|
||||||
|
|
||||||
/* gets the address of an object representing a C pointer, with the
|
/* gets the address of an object representing a C pointer, with the
|
||||||
intention of storing the pointer across code which may potentially GC. */
|
intention of storing the pointer across code which may potentially GC. */
|
||||||
char *factorvm::pinned_alien_offset(cell obj)
|
char *factor_vm::pinned_alien_offset(cell obj)
|
||||||
{
|
{
|
||||||
switch(tagged<object>(obj).type())
|
switch(tagged<object>(obj).type())
|
||||||
{
|
{
|
||||||
|
@ -25,7 +25,7 @@ char *factorvm::pinned_alien_offset(cell obj)
|
||||||
}
|
}
|
||||||
|
|
||||||
/* make an alien */
|
/* make an alien */
|
||||||
cell factorvm::allot_alien(cell delegate_, cell displacement)
|
cell factor_vm::allot_alien(cell delegate_, cell displacement)
|
||||||
{
|
{
|
||||||
gc_root<object> delegate(delegate_,this);
|
gc_root<object> delegate(delegate_,this);
|
||||||
gc_root<alien> new_alien(allot<alien>(sizeof(alien)),this);
|
gc_root<alien> new_alien(allot<alien>(sizeof(alien)),this);
|
||||||
|
@ -46,7 +46,7 @@ cell factorvm::allot_alien(cell delegate_, cell displacement)
|
||||||
}
|
}
|
||||||
|
|
||||||
/* make an alien pointing at an offset of another alien */
|
/* make an alien pointing at an offset of another alien */
|
||||||
inline void factorvm::vmprim_displaced_alien()
|
inline void factor_vm::primitive_displaced_alien()
|
||||||
{
|
{
|
||||||
cell alien = dpop();
|
cell alien = dpop();
|
||||||
cell displacement = to_cell(dpop());
|
cell displacement = to_cell(dpop());
|
||||||
|
@ -71,23 +71,23 @@ inline void factorvm::vmprim_displaced_alien()
|
||||||
|
|
||||||
PRIMITIVE(displaced_alien)
|
PRIMITIVE(displaced_alien)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_displaced_alien();
|
PRIMITIVE_GETVM()->primitive_displaced_alien();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* address of an object representing a C pointer. Explicitly throw an error
|
/* address of an object representing a C pointer. Explicitly throw an error
|
||||||
if the object is a byte array, as a sanity check. */
|
if the object is a byte array, as a sanity check. */
|
||||||
inline void factorvm::vmprim_alien_address()
|
inline void factor_vm::primitive_alien_address()
|
||||||
{
|
{
|
||||||
box_unsigned_cell((cell)pinned_alien_offset(dpop()));
|
box_unsigned_cell((cell)pinned_alien_offset(dpop()));
|
||||||
}
|
}
|
||||||
|
|
||||||
PRIMITIVE(alien_address)
|
PRIMITIVE(alien_address)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_alien_address();
|
PRIMITIVE_GETVM()->primitive_alien_address();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* pop ( alien n ) from datastack, return alien's address plus n */
|
/* pop ( alien n ) from datastack, return alien's address plus n */
|
||||||
void *factorvm::alien_pointer()
|
void *factor_vm::alien_pointer()
|
||||||
{
|
{
|
||||||
fixnum offset = to_fixnum(dpop());
|
fixnum offset = to_fixnum(dpop());
|
||||||
return unbox_alien() + offset;
|
return unbox_alien() + offset;
|
||||||
|
@ -121,7 +121,7 @@ DEFINE_ALIEN_ACCESSOR(double,double,box_double,to_double)
|
||||||
DEFINE_ALIEN_ACCESSOR(cell,void *,box_alien,pinned_alien_offset)
|
DEFINE_ALIEN_ACCESSOR(cell,void *,box_alien,pinned_alien_offset)
|
||||||
|
|
||||||
/* open a native library and push a handle */
|
/* open a native library and push a handle */
|
||||||
inline void factorvm::vmprim_dlopen()
|
inline void factor_vm::primitive_dlopen()
|
||||||
{
|
{
|
||||||
gc_root<byte_array> path(dpop(),this);
|
gc_root<byte_array> path(dpop(),this);
|
||||||
path.untag_check(this);
|
path.untag_check(this);
|
||||||
|
@ -133,11 +133,11 @@ inline void factorvm::vmprim_dlopen()
|
||||||
|
|
||||||
PRIMITIVE(dlopen)
|
PRIMITIVE(dlopen)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_dlopen();
|
PRIMITIVE_GETVM()->primitive_dlopen();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* look up a symbol in a native library */
|
/* look up a symbol in a native library */
|
||||||
inline void factorvm::vmprim_dlsym()
|
inline void factor_vm::primitive_dlsym()
|
||||||
{
|
{
|
||||||
gc_root<object> library(dpop(),this);
|
gc_root<object> library(dpop(),this);
|
||||||
gc_root<byte_array> name(dpop(),this);
|
gc_root<byte_array> name(dpop(),this);
|
||||||
|
@ -160,11 +160,11 @@ inline void factorvm::vmprim_dlsym()
|
||||||
|
|
||||||
PRIMITIVE(dlsym)
|
PRIMITIVE(dlsym)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_dlsym();
|
PRIMITIVE_GETVM()->primitive_dlsym();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* close a native library handle */
|
/* close a native library handle */
|
||||||
inline void factorvm::vmprim_dlclose()
|
inline void factor_vm::primitive_dlclose()
|
||||||
{
|
{
|
||||||
dll *d = untag_check<dll>(dpop());
|
dll *d = untag_check<dll>(dpop());
|
||||||
if(d->dll != NULL)
|
if(d->dll != NULL)
|
||||||
|
@ -173,10 +173,10 @@ inline void factorvm::vmprim_dlclose()
|
||||||
|
|
||||||
PRIMITIVE(dlclose)
|
PRIMITIVE(dlclose)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_dlclose();
|
PRIMITIVE_GETVM()->primitive_dlclose();
|
||||||
}
|
}
|
||||||
|
|
||||||
inline void factorvm::vmprim_dll_validp()
|
inline void factor_vm::primitive_dll_validp()
|
||||||
{
|
{
|
||||||
cell library = dpop();
|
cell library = dpop();
|
||||||
if(library == F)
|
if(library == F)
|
||||||
|
@ -187,11 +187,11 @@ inline void factorvm::vmprim_dll_validp()
|
||||||
|
|
||||||
PRIMITIVE(dll_validp)
|
PRIMITIVE(dll_validp)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_dll_validp();
|
PRIMITIVE_GETVM()->primitive_dll_validp();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* gets the address of an object representing a C pointer */
|
/* gets the address of an object representing a C pointer */
|
||||||
char *factorvm::alien_offset(cell obj)
|
char *factor_vm::alien_offset(cell obj)
|
||||||
{
|
{
|
||||||
switch(tagged<object>(obj).type())
|
switch(tagged<object>(obj).type())
|
||||||
{
|
{
|
||||||
|
@ -212,26 +212,26 @@ char *factorvm::alien_offset(cell obj)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_C_API char *alien_offset(cell obj, factorvm *myvm)
|
VM_C_API char *alien_offset(cell obj, factor_vm *myvm)
|
||||||
{
|
{
|
||||||
ASSERTVM();
|
ASSERTVM();
|
||||||
return VM_PTR->alien_offset(obj);
|
return VM_PTR->alien_offset(obj);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* pop an object representing a C pointer */
|
/* pop an object representing a C pointer */
|
||||||
char *factorvm::unbox_alien()
|
char *factor_vm::unbox_alien()
|
||||||
{
|
{
|
||||||
return alien_offset(dpop());
|
return alien_offset(dpop());
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_C_API char *unbox_alien(factorvm *myvm)
|
VM_C_API char *unbox_alien(factor_vm *myvm)
|
||||||
{
|
{
|
||||||
ASSERTVM();
|
ASSERTVM();
|
||||||
return VM_PTR->unbox_alien();
|
return VM_PTR->unbox_alien();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* make an alien and push */
|
/* make an alien and push */
|
||||||
void factorvm::box_alien(void *ptr)
|
void factor_vm::box_alien(void *ptr)
|
||||||
{
|
{
|
||||||
if(ptr == NULL)
|
if(ptr == NULL)
|
||||||
dpush(F);
|
dpush(F);
|
||||||
|
@ -239,40 +239,40 @@ void factorvm::box_alien(void *ptr)
|
||||||
dpush(allot_alien(F,(cell)ptr));
|
dpush(allot_alien(F,(cell)ptr));
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_C_API void box_alien(void *ptr, factorvm *myvm)
|
VM_C_API void box_alien(void *ptr, factor_vm *myvm)
|
||||||
{
|
{
|
||||||
ASSERTVM();
|
ASSERTVM();
|
||||||
return VM_PTR->box_alien(ptr);
|
return VM_PTR->box_alien(ptr);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* for FFI calls passing structs by value */
|
/* for FFI calls passing structs by value */
|
||||||
void factorvm::to_value_struct(cell src, void *dest, cell size)
|
void factor_vm::to_value_struct(cell src, void *dest, cell size)
|
||||||
{
|
{
|
||||||
memcpy(dest,alien_offset(src),size);
|
memcpy(dest,alien_offset(src),size);
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_C_API void to_value_struct(cell src, void *dest, cell size, factorvm *myvm)
|
VM_C_API void to_value_struct(cell src, void *dest, cell size, factor_vm *myvm)
|
||||||
{
|
{
|
||||||
ASSERTVM();
|
ASSERTVM();
|
||||||
return VM_PTR->to_value_struct(src,dest,size);
|
return VM_PTR->to_value_struct(src,dest,size);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* for FFI callbacks receiving structs by value */
|
/* for FFI callbacks receiving structs by value */
|
||||||
void factorvm::box_value_struct(void *src, cell size)
|
void factor_vm::box_value_struct(void *src, cell size)
|
||||||
{
|
{
|
||||||
byte_array *bytes = allot_byte_array(size);
|
byte_array *bytes = allot_byte_array(size);
|
||||||
memcpy(bytes->data<void>(),src,size);
|
memcpy(bytes->data<void>(),src,size);
|
||||||
dpush(tag<byte_array>(bytes));
|
dpush(tag<byte_array>(bytes));
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_C_API void box_value_struct(void *src, cell size,factorvm *myvm)
|
VM_C_API void box_value_struct(void *src, cell size,factor_vm *myvm)
|
||||||
{
|
{
|
||||||
ASSERTVM();
|
ASSERTVM();
|
||||||
return VM_PTR->box_value_struct(src,size);
|
return VM_PTR->box_value_struct(src,size);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* On some x86 OSes, structs <= 8 bytes are returned in registers. */
|
/* On some x86 OSes, structs <= 8 bytes are returned in registers. */
|
||||||
void factorvm::box_small_struct(cell x, cell y, cell size)
|
void factor_vm::box_small_struct(cell x, cell y, cell size)
|
||||||
{
|
{
|
||||||
cell data[2];
|
cell data[2];
|
||||||
data[0] = x;
|
data[0] = x;
|
||||||
|
@ -280,14 +280,14 @@ void factorvm::box_small_struct(cell x, cell y, cell size)
|
||||||
box_value_struct(data,size);
|
box_value_struct(data,size);
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_C_API void box_small_struct(cell x, cell y, cell size, factorvm *myvm)
|
VM_C_API void box_small_struct(cell x, cell y, cell size, factor_vm *myvm)
|
||||||
{
|
{
|
||||||
ASSERTVM();
|
ASSERTVM();
|
||||||
return VM_PTR->box_small_struct(x,y,size);
|
return VM_PTR->box_small_struct(x,y,size);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* On OS X/PPC, complex numbers are returned in registers. */
|
/* On OS X/PPC, complex numbers are returned in registers. */
|
||||||
void factorvm::box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
|
void factor_vm::box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
|
||||||
{
|
{
|
||||||
cell data[4];
|
cell data[4];
|
||||||
data[0] = x1;
|
data[0] = x1;
|
||||||
|
@ -297,20 +297,20 @@ void factorvm::box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
|
||||||
box_value_struct(data,size);
|
box_value_struct(data,size);
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, factorvm *myvm)
|
VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, factor_vm *myvm)
|
||||||
{
|
{
|
||||||
ASSERTVM();
|
ASSERTVM();
|
||||||
return VM_PTR->box_medium_struct(x1, x2, x3, x4, size);
|
return VM_PTR->box_medium_struct(x1, x2, x3, x4, size);
|
||||||
}
|
}
|
||||||
|
|
||||||
inline void factorvm::vmprim_vm_ptr()
|
inline void factor_vm::primitive_vm_ptr()
|
||||||
{
|
{
|
||||||
box_alien(this);
|
box_alien(this);
|
||||||
}
|
}
|
||||||
|
|
||||||
PRIMITIVE(vm_ptr)
|
PRIMITIVE(vm_ptr)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_vm_ptr();
|
PRIMITIVE_GETVM()->primitive_vm_ptr();
|
||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
14
vm/alien.hpp
14
vm/alien.hpp
|
@ -38,12 +38,12 @@ PRIMITIVE(dll_validp);
|
||||||
|
|
||||||
PRIMITIVE(vm_ptr);
|
PRIMITIVE(vm_ptr);
|
||||||
|
|
||||||
VM_C_API char *alien_offset(cell object, factorvm *vm);
|
VM_C_API char *alien_offset(cell object, factor_vm *vm);
|
||||||
VM_C_API char *unbox_alien(factorvm *vm);
|
VM_C_API char *unbox_alien(factor_vm *vm);
|
||||||
VM_C_API void box_alien(void *ptr, factorvm *vm);
|
VM_C_API void box_alien(void *ptr, factor_vm *vm);
|
||||||
VM_C_API void to_value_struct(cell src, void *dest, cell size, factorvm *vm);
|
VM_C_API void to_value_struct(cell src, void *dest, cell size, factor_vm *vm);
|
||||||
VM_C_API void box_value_struct(void *src, cell size,factorvm *vm);
|
VM_C_API void box_value_struct(void *src, cell size,factor_vm *vm);
|
||||||
VM_C_API void box_small_struct(cell x, cell y, cell size,factorvm *vm);
|
VM_C_API void box_small_struct(cell x, cell y, cell size,factor_vm *vm);
|
||||||
VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size,factorvm *vm);
|
VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size,factor_vm *vm);
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -4,7 +4,7 @@ namespace factor
|
||||||
{
|
{
|
||||||
|
|
||||||
/* make a new array with an initial element */
|
/* make a new array with an initial element */
|
||||||
array *factorvm::allot_array(cell capacity, cell fill_)
|
array *factor_vm::allot_array(cell capacity, cell fill_)
|
||||||
{
|
{
|
||||||
gc_root<object> fill(fill_,this);
|
gc_root<object> fill(fill_,this);
|
||||||
gc_root<array> new_array(allot_array_internal<array>(capacity),this);
|
gc_root<array> new_array(allot_array_internal<array>(capacity),this);
|
||||||
|
@ -23,9 +23,8 @@ array *factorvm::allot_array(cell capacity, cell fill_)
|
||||||
return new_array.untagged();
|
return new_array.untagged();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* push a new array on the stack */
|
/* push a new array on the stack */
|
||||||
inline void factorvm::vmprim_array()
|
inline void factor_vm::primitive_array()
|
||||||
{
|
{
|
||||||
cell initial = dpop();
|
cell initial = dpop();
|
||||||
cell size = unbox_array_size();
|
cell size = unbox_array_size();
|
||||||
|
@ -34,10 +33,10 @@ inline void factorvm::vmprim_array()
|
||||||
|
|
||||||
PRIMITIVE(array)
|
PRIMITIVE(array)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_array();
|
PRIMITIVE_GETVM()->primitive_array();
|
||||||
}
|
}
|
||||||
|
|
||||||
cell factorvm::allot_array_1(cell obj_)
|
cell factor_vm::allot_array_1(cell obj_)
|
||||||
{
|
{
|
||||||
gc_root<object> obj(obj_,this);
|
gc_root<object> obj(obj_,this);
|
||||||
gc_root<array> a(allot_array_internal<array>(1),this);
|
gc_root<array> a(allot_array_internal<array>(1),this);
|
||||||
|
@ -45,8 +44,7 @@ cell factorvm::allot_array_1(cell obj_)
|
||||||
return a.value();
|
return a.value();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
cell factor_vm::allot_array_2(cell v1_, cell v2_)
|
||||||
cell factorvm::allot_array_2(cell v1_, cell v2_)
|
|
||||||
{
|
{
|
||||||
gc_root<object> v1(v1_,this);
|
gc_root<object> v1(v1_,this);
|
||||||
gc_root<object> v2(v2_,this);
|
gc_root<object> v2(v2_,this);
|
||||||
|
@ -56,8 +54,7 @@ cell factorvm::allot_array_2(cell v1_, cell v2_)
|
||||||
return a.value();
|
return a.value();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
cell factor_vm::allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
|
||||||
cell factorvm::allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
|
|
||||||
{
|
{
|
||||||
gc_root<object> v1(v1_,this);
|
gc_root<object> v1(v1_,this);
|
||||||
gc_root<object> v2(v2_,this);
|
gc_root<object> v2(v2_,this);
|
||||||
|
@ -71,8 +68,7 @@ cell factorvm::allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
|
||||||
return a.value();
|
return a.value();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
inline void factor_vm::primitive_resize_array()
|
||||||
inline void factorvm::vmprim_resize_array()
|
|
||||||
{
|
{
|
||||||
array* a = untag_check<array>(dpop());
|
array* a = untag_check<array>(dpop());
|
||||||
cell capacity = unbox_array_size();
|
cell capacity = unbox_array_size();
|
||||||
|
@ -81,23 +77,23 @@ inline void factorvm::vmprim_resize_array()
|
||||||
|
|
||||||
PRIMITIVE(resize_array)
|
PRIMITIVE(resize_array)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_resize_array();
|
PRIMITIVE_GETVM()->primitive_resize_array();
|
||||||
}
|
}
|
||||||
|
|
||||||
void growable_array::add(cell elt_)
|
void growable_array::add(cell elt_)
|
||||||
{
|
{
|
||||||
factorvm* myvm = elements.myvm;
|
factor_vm* parent_vm = elements.parent_vm;
|
||||||
gc_root<object> elt(elt_,myvm);
|
gc_root<object> elt(elt_,parent_vm);
|
||||||
if(count == array_capacity(elements.untagged()))
|
if(count == array_capacity(elements.untagged()))
|
||||||
elements = myvm->reallot_array(elements.untagged(),count * 2);
|
elements = parent_vm->reallot_array(elements.untagged(),count * 2);
|
||||||
|
|
||||||
myvm->set_array_nth(elements.untagged(),count++,elt.value());
|
parent_vm->set_array_nth(elements.untagged(),count++,elt.value());
|
||||||
}
|
}
|
||||||
|
|
||||||
void growable_array::trim()
|
void growable_array::trim()
|
||||||
{
|
{
|
||||||
factorvm *myvm = elements.myvm;
|
factor_vm *parent_vm = elements.parent_vm;
|
||||||
elements = myvm->reallot_array(elements.untagged(),count);
|
elements = parent_vm->reallot_array(elements.untagged(),count);
|
||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -13,5 +13,4 @@ inline cell array_nth(array *array, cell slot)
|
||||||
PRIMITIVE(array);
|
PRIMITIVE(array);
|
||||||
PRIMITIVE(resize_array);
|
PRIMITIVE(resize_array);
|
||||||
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
1266
vm/bignum.cpp
1266
vm/bignum.cpp
File diff suppressed because it is too large
Load Diff
|
@ -1,7 +1,7 @@
|
||||||
namespace factor
|
namespace factor
|
||||||
{
|
{
|
||||||
|
|
||||||
/* :tabSize=2:indentSize=2:noTabs=true:
|
/*
|
||||||
|
|
||||||
Copyright (C) 1989-1992 Massachusetts Institute of Technology
|
Copyright (C) 1989-1992 Massachusetts Institute of Technology
|
||||||
Portions copyright (C) 2004-2009 Slava Pestov
|
Portions copyright (C) 2004-2009 Slava Pestov
|
||||||
|
@ -44,10 +44,7 @@ enum bignum_comparison
|
||||||
bignum_comparison_greater = 1
|
bignum_comparison_greater = 1
|
||||||
};
|
};
|
||||||
|
|
||||||
struct factorvm;
|
struct factor_vm;
|
||||||
bignum * digit_stream_to_bignum(unsigned int n_digits,
|
bignum * digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int,factor_vm*), unsigned int radix, int negative_p);
|
||||||
unsigned int (*producer)(unsigned int,factorvm*),
|
|
||||||
unsigned int radix,
|
|
||||||
int negative_p);
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -54,7 +54,6 @@ typedef fixnum bignum_length_type;
|
||||||
/* BIGNUM_EXCEPTION is invoked to handle assertion violations. */
|
/* BIGNUM_EXCEPTION is invoked to handle assertion violations. */
|
||||||
#define BIGNUM_EXCEPTION abort
|
#define BIGNUM_EXCEPTION abort
|
||||||
|
|
||||||
|
|
||||||
#define BIGNUM_DIGIT_LENGTH (((sizeof (bignum_digit_type)) * CHAR_BIT) - 2)
|
#define BIGNUM_DIGIT_LENGTH (((sizeof (bignum_digit_type)) * CHAR_BIT) - 2)
|
||||||
#define BIGNUM_HALF_DIGIT_LENGTH (BIGNUM_DIGIT_LENGTH / 2)
|
#define BIGNUM_HALF_DIGIT_LENGTH (BIGNUM_DIGIT_LENGTH / 2)
|
||||||
#define BIGNUM_RADIX (bignum_digit_type)(((cell) 1) << BIGNUM_DIGIT_LENGTH)
|
#define BIGNUM_RADIX (bignum_digit_type)(((cell) 1) << BIGNUM_DIGIT_LENGTH)
|
||||||
|
|
|
@ -3,23 +3,23 @@
|
||||||
namespace factor
|
namespace factor
|
||||||
{
|
{
|
||||||
|
|
||||||
void factorvm::box_boolean(bool value)
|
void factor_vm::box_boolean(bool value)
|
||||||
{
|
{
|
||||||
dpush(value ? T : F);
|
dpush(value ? T : F);
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_C_API void box_boolean(bool value, factorvm *myvm)
|
VM_C_API void box_boolean(bool value, factor_vm *myvm)
|
||||||
{
|
{
|
||||||
ASSERTVM();
|
ASSERTVM();
|
||||||
return VM_PTR->box_boolean(value);
|
return VM_PTR->box_boolean(value);
|
||||||
}
|
}
|
||||||
|
|
||||||
bool factorvm::to_boolean(cell value)
|
bool factor_vm::to_boolean(cell value)
|
||||||
{
|
{
|
||||||
return value != F;
|
return value != F;
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_C_API bool to_boolean(cell value, factorvm *myvm)
|
VM_C_API bool to_boolean(cell value, factor_vm *myvm)
|
||||||
{
|
{
|
||||||
ASSERTVM();
|
ASSERTVM();
|
||||||
return VM_PTR->to_boolean(value);
|
return VM_PTR->to_boolean(value);
|
||||||
|
|
|
@ -1,8 +1,7 @@
|
||||||
namespace factor
|
namespace factor
|
||||||
{
|
{
|
||||||
|
|
||||||
|
VM_C_API void box_boolean(bool value, factor_vm *vm);
|
||||||
VM_C_API void box_boolean(bool value, factorvm *vm);
|
VM_C_API bool to_boolean(cell value, factor_vm *vm);
|
||||||
VM_C_API bool to_boolean(cell value, factorvm *vm);
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -3,15 +3,14 @@
|
||||||
namespace factor
|
namespace factor
|
||||||
{
|
{
|
||||||
|
|
||||||
byte_array *factorvm::allot_byte_array(cell size)
|
byte_array *factor_vm::allot_byte_array(cell size)
|
||||||
{
|
{
|
||||||
byte_array *array = allot_array_internal<byte_array>(size);
|
byte_array *array = allot_array_internal<byte_array>(size);
|
||||||
memset(array + 1,0,size);
|
memset(array + 1,0,size);
|
||||||
return array;
|
return array;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
inline void factor_vm::primitive_byte_array()
|
||||||
inline void factorvm::vmprim_byte_array()
|
|
||||||
{
|
{
|
||||||
cell size = unbox_array_size();
|
cell size = unbox_array_size();
|
||||||
dpush(tag<byte_array>(allot_byte_array(size)));
|
dpush(tag<byte_array>(allot_byte_array(size)));
|
||||||
|
@ -19,10 +18,10 @@ inline void factorvm::vmprim_byte_array()
|
||||||
|
|
||||||
PRIMITIVE(byte_array)
|
PRIMITIVE(byte_array)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_byte_array();
|
PRIMITIVE_GETVM()->primitive_byte_array();
|
||||||
}
|
}
|
||||||
|
|
||||||
inline void factorvm::vmprim_uninitialized_byte_array()
|
inline void factor_vm::primitive_uninitialized_byte_array()
|
||||||
{
|
{
|
||||||
cell size = unbox_array_size();
|
cell size = unbox_array_size();
|
||||||
dpush(tag<byte_array>(allot_array_internal<byte_array>(size)));
|
dpush(tag<byte_array>(allot_array_internal<byte_array>(size)));
|
||||||
|
@ -30,10 +29,10 @@ inline void factorvm::vmprim_uninitialized_byte_array()
|
||||||
|
|
||||||
PRIMITIVE(uninitialized_byte_array)
|
PRIMITIVE(uninitialized_byte_array)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_uninitialized_byte_array();
|
PRIMITIVE_GETVM()->primitive_uninitialized_byte_array();
|
||||||
}
|
}
|
||||||
|
|
||||||
inline void factorvm::vmprim_resize_byte_array()
|
inline void factor_vm::primitive_resize_byte_array()
|
||||||
{
|
{
|
||||||
byte_array *array = untag_check<byte_array>(dpop());
|
byte_array *array = untag_check<byte_array>(dpop());
|
||||||
cell capacity = unbox_array_size();
|
cell capacity = unbox_array_size();
|
||||||
|
@ -42,15 +41,15 @@ inline void factorvm::vmprim_resize_byte_array()
|
||||||
|
|
||||||
PRIMITIVE(resize_byte_array)
|
PRIMITIVE(resize_byte_array)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_resize_byte_array();
|
PRIMITIVE_GETVM()->primitive_resize_byte_array();
|
||||||
}
|
}
|
||||||
|
|
||||||
void growable_byte_array::append_bytes(void *elts, cell len)
|
void growable_byte_array::append_bytes(void *elts, cell len)
|
||||||
{
|
{
|
||||||
cell new_size = count + len;
|
cell new_size = count + len;
|
||||||
factorvm *myvm = elements.myvm;
|
factor_vm *parent_vm = elements.parent_vm;
|
||||||
if(new_size >= array_capacity(elements.untagged()))
|
if(new_size >= array_capacity(elements.untagged()))
|
||||||
elements = myvm->reallot_array(elements.untagged(),new_size * 2);
|
elements = parent_vm->reallot_array(elements.untagged(),new_size * 2);
|
||||||
|
|
||||||
memcpy(&elements->data<u8>()[count],elts,len);
|
memcpy(&elements->data<u8>()[count],elts,len);
|
||||||
|
|
||||||
|
@ -59,13 +58,13 @@ void growable_byte_array::append_bytes(void *elts, cell len)
|
||||||
|
|
||||||
void growable_byte_array::append_byte_array(cell byte_array_)
|
void growable_byte_array::append_byte_array(cell byte_array_)
|
||||||
{
|
{
|
||||||
gc_root<byte_array> byte_array(byte_array_,elements.myvm);
|
gc_root<byte_array> byte_array(byte_array_,elements.parent_vm);
|
||||||
|
|
||||||
cell len = array_capacity(byte_array.untagged());
|
cell len = array_capacity(byte_array.untagged());
|
||||||
cell new_size = count + len;
|
cell new_size = count + len;
|
||||||
factorvm *myvm = elements.myvm;
|
factor_vm *parent_vm = elements.parent_vm;
|
||||||
if(new_size >= array_capacity(elements.untagged()))
|
if(new_size >= array_capacity(elements.untagged()))
|
||||||
elements = myvm->reallot_array(elements.untagged(),new_size * 2);
|
elements = parent_vm->reallot_array(elements.untagged(),new_size * 2);
|
||||||
|
|
||||||
memcpy(&elements->data<u8>()[count],byte_array->data<u8>(),len);
|
memcpy(&elements->data<u8>()[count],byte_array->data<u8>(),len);
|
||||||
|
|
||||||
|
@ -74,8 +73,8 @@ void growable_byte_array::append_byte_array(cell byte_array_)
|
||||||
|
|
||||||
void growable_byte_array::trim()
|
void growable_byte_array::trim()
|
||||||
{
|
{
|
||||||
factorvm *myvm = elements.myvm;
|
factor_vm *parent_vm = elements.parent_vm;
|
||||||
elements = myvm->reallot_array(elements.untagged(),count);
|
elements = parent_vm->reallot_array(elements.untagged(),count);
|
||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -5,5 +5,4 @@ PRIMITIVE(byte_array);
|
||||||
PRIMITIVE(uninitialized_byte_array);
|
PRIMITIVE(uninitialized_byte_array);
|
||||||
PRIMITIVE(resize_byte_array);
|
PRIMITIVE(resize_byte_array);
|
||||||
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
namespace factor
|
namespace factor
|
||||||
{
|
{
|
||||||
|
|
||||||
void factorvm::check_frame(stack_frame *frame)
|
void factor_vm::check_frame(stack_frame *frame)
|
||||||
{
|
{
|
||||||
#ifdef FACTOR_DEBUG
|
#ifdef FACTOR_DEBUG
|
||||||
check_code_pointer((cell)frame->xt);
|
check_code_pointer((cell)frame->xt);
|
||||||
|
@ -11,14 +11,14 @@ void factorvm::check_frame(stack_frame *frame)
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
callstack *factorvm::allot_callstack(cell size)
|
callstack *factor_vm::allot_callstack(cell size)
|
||||||
{
|
{
|
||||||
callstack *stack = allot<callstack>(callstack_size(size));
|
callstack *stack = allot<callstack>(callstack_size(size));
|
||||||
stack->length = tag_fixnum(size);
|
stack->length = tag_fixnum(size);
|
||||||
return stack;
|
return stack;
|
||||||
}
|
}
|
||||||
|
|
||||||
stack_frame *factorvm::fix_callstack_top(stack_frame *top, stack_frame *bottom)
|
stack_frame *factor_vm::fix_callstack_top(stack_frame *top, stack_frame *bottom)
|
||||||
{
|
{
|
||||||
stack_frame *frame = bottom - 1;
|
stack_frame *frame = bottom - 1;
|
||||||
|
|
||||||
|
@ -35,7 +35,7 @@ This means that if 'callstack' is called in tail position, we
|
||||||
will have popped a necessary frame... however this word is only
|
will have popped a necessary frame... however this word is only
|
||||||
called by continuation implementation, and user code shouldn't
|
called by continuation implementation, and user code shouldn't
|
||||||
be calling it at all, so we leave it as it is for now. */
|
be calling it at all, so we leave it as it is for now. */
|
||||||
stack_frame *factorvm::capture_start()
|
stack_frame *factor_vm::capture_start()
|
||||||
{
|
{
|
||||||
stack_frame *frame = stack_chain->callstack_bottom - 1;
|
stack_frame *frame = stack_chain->callstack_bottom - 1;
|
||||||
while(frame >= stack_chain->callstack_top
|
while(frame >= stack_chain->callstack_top
|
||||||
|
@ -46,7 +46,7 @@ stack_frame *factorvm::capture_start()
|
||||||
return frame + 1;
|
return frame + 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
inline void factorvm::vmprim_callstack()
|
inline void factor_vm::primitive_callstack()
|
||||||
{
|
{
|
||||||
stack_frame *top = capture_start();
|
stack_frame *top = capture_start();
|
||||||
stack_frame *bottom = stack_chain->callstack_bottom;
|
stack_frame *bottom = stack_chain->callstack_bottom;
|
||||||
|
@ -62,10 +62,10 @@ inline void factorvm::vmprim_callstack()
|
||||||
|
|
||||||
PRIMITIVE(callstack)
|
PRIMITIVE(callstack)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_callstack();
|
PRIMITIVE_GETVM()->primitive_callstack();
|
||||||
}
|
}
|
||||||
|
|
||||||
inline void factorvm::vmprim_set_callstack()
|
inline void factor_vm::primitive_set_callstack()
|
||||||
{
|
{
|
||||||
callstack *stack = untag_check<callstack>(dpop());
|
callstack *stack = untag_check<callstack>(dpop());
|
||||||
|
|
||||||
|
@ -80,22 +80,21 @@ inline void factorvm::vmprim_set_callstack()
|
||||||
|
|
||||||
PRIMITIVE(set_callstack)
|
PRIMITIVE(set_callstack)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_set_callstack();
|
PRIMITIVE_GETVM()->primitive_set_callstack();
|
||||||
}
|
}
|
||||||
|
|
||||||
code_block *factorvm::frame_code(stack_frame *frame)
|
code_block *factor_vm::frame_code(stack_frame *frame)
|
||||||
{
|
{
|
||||||
check_frame(frame);
|
check_frame(frame);
|
||||||
return (code_block *)frame->xt - 1;
|
return (code_block *)frame->xt - 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
cell factor_vm::frame_type(stack_frame *frame)
|
||||||
cell factorvm::frame_type(stack_frame *frame)
|
|
||||||
{
|
{
|
||||||
return frame_code(frame)->type;
|
return frame_code(frame)->type;
|
||||||
}
|
}
|
||||||
|
|
||||||
cell factorvm::frame_executing(stack_frame *frame)
|
cell factor_vm::frame_executing(stack_frame *frame)
|
||||||
{
|
{
|
||||||
code_block *compiled = frame_code(frame);
|
code_block *compiled = frame_code(frame);
|
||||||
if(compiled->literals == F || !stack_traces_p())
|
if(compiled->literals == F || !stack_traces_p())
|
||||||
|
@ -109,14 +108,14 @@ cell factorvm::frame_executing(stack_frame *frame)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
stack_frame *factorvm::frame_successor(stack_frame *frame)
|
stack_frame *factor_vm::frame_successor(stack_frame *frame)
|
||||||
{
|
{
|
||||||
check_frame(frame);
|
check_frame(frame);
|
||||||
return (stack_frame *)((cell)frame - frame->size);
|
return (stack_frame *)((cell)frame - frame->size);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Allocates memory */
|
/* Allocates memory */
|
||||||
cell factorvm::frame_scan(stack_frame *frame)
|
cell factor_vm::frame_scan(stack_frame *frame)
|
||||||
{
|
{
|
||||||
switch(frame_type(frame))
|
switch(frame_type(frame))
|
||||||
{
|
{
|
||||||
|
@ -148,9 +147,9 @@ namespace
|
||||||
struct stack_frame_accumulator {
|
struct stack_frame_accumulator {
|
||||||
growable_array frames;
|
growable_array frames;
|
||||||
|
|
||||||
stack_frame_accumulator(factorvm *vm) : frames(vm) {}
|
stack_frame_accumulator(factor_vm *vm) : frames(vm) {}
|
||||||
|
|
||||||
void operator()(stack_frame *frame, factorvm *myvm)
|
void operator()(stack_frame *frame, factor_vm *myvm)
|
||||||
{
|
{
|
||||||
gc_root<object> executing(myvm->frame_executing(frame),myvm);
|
gc_root<object> executing(myvm->frame_executing(frame),myvm);
|
||||||
gc_root<object> scan(myvm->frame_scan(frame),myvm);
|
gc_root<object> scan(myvm->frame_scan(frame),myvm);
|
||||||
|
@ -162,7 +161,7 @@ struct stack_frame_accumulator {
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
inline void factorvm::vmprim_callstack_to_array()
|
inline void factor_vm::primitive_callstack_to_array()
|
||||||
{
|
{
|
||||||
gc_root<callstack> callstack(dpop(),this);
|
gc_root<callstack> callstack(dpop(),this);
|
||||||
|
|
||||||
|
@ -175,10 +174,10 @@ inline void factorvm::vmprim_callstack_to_array()
|
||||||
|
|
||||||
PRIMITIVE(callstack_to_array)
|
PRIMITIVE(callstack_to_array)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_callstack_to_array();
|
PRIMITIVE_GETVM()->primitive_callstack_to_array();
|
||||||
}
|
}
|
||||||
|
|
||||||
stack_frame *factorvm::innermost_stack_frame(callstack *stack)
|
stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
|
||||||
{
|
{
|
||||||
stack_frame *top = stack->top();
|
stack_frame *top = stack->top();
|
||||||
stack_frame *bottom = stack->bottom();
|
stack_frame *bottom = stack->bottom();
|
||||||
|
@ -190,7 +189,7 @@ stack_frame *factorvm::innermost_stack_frame(callstack *stack)
|
||||||
return frame;
|
return frame;
|
||||||
}
|
}
|
||||||
|
|
||||||
stack_frame *factorvm::innermost_stack_frame_quot(callstack *callstack)
|
stack_frame *factor_vm::innermost_stack_frame_quot(callstack *callstack)
|
||||||
{
|
{
|
||||||
stack_frame *inner = innermost_stack_frame(callstack);
|
stack_frame *inner = innermost_stack_frame(callstack);
|
||||||
tagged<quotation>(frame_executing(inner)).untag_check(this);
|
tagged<quotation>(frame_executing(inner)).untag_check(this);
|
||||||
|
@ -199,27 +198,27 @@ stack_frame *factorvm::innermost_stack_frame_quot(callstack *callstack)
|
||||||
|
|
||||||
/* Some primitives implementing a limited form of callstack mutation.
|
/* Some primitives implementing a limited form of callstack mutation.
|
||||||
Used by the single stepper. */
|
Used by the single stepper. */
|
||||||
inline void factorvm::vmprim_innermost_stack_frame_executing()
|
inline void factor_vm::primitive_innermost_stack_frame_executing()
|
||||||
{
|
{
|
||||||
dpush(frame_executing(innermost_stack_frame(untag_check<callstack>(dpop()))));
|
dpush(frame_executing(innermost_stack_frame(untag_check<callstack>(dpop()))));
|
||||||
}
|
}
|
||||||
|
|
||||||
PRIMITIVE(innermost_stack_frame_executing)
|
PRIMITIVE(innermost_stack_frame_executing)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_innermost_stack_frame_executing();
|
PRIMITIVE_GETVM()->primitive_innermost_stack_frame_executing();
|
||||||
}
|
}
|
||||||
|
|
||||||
inline void factorvm::vmprim_innermost_stack_frame_scan()
|
inline void factor_vm::primitive_innermost_stack_frame_scan()
|
||||||
{
|
{
|
||||||
dpush(frame_scan(innermost_stack_frame_quot(untag_check<callstack>(dpop()))));
|
dpush(frame_scan(innermost_stack_frame_quot(untag_check<callstack>(dpop()))));
|
||||||
}
|
}
|
||||||
|
|
||||||
PRIMITIVE(innermost_stack_frame_scan)
|
PRIMITIVE(innermost_stack_frame_scan)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_innermost_stack_frame_scan();
|
PRIMITIVE_GETVM()->primitive_innermost_stack_frame_scan();
|
||||||
}
|
}
|
||||||
|
|
||||||
inline void factorvm::vmprim_set_innermost_stack_frame_quot()
|
inline void factor_vm::primitive_set_innermost_stack_frame_quot()
|
||||||
{
|
{
|
||||||
gc_root<callstack> callstack(dpop(),this);
|
gc_root<callstack> callstack(dpop(),this);
|
||||||
gc_root<quotation> quot(dpop(),this);
|
gc_root<quotation> quot(dpop(),this);
|
||||||
|
@ -237,16 +236,16 @@ inline void factorvm::vmprim_set_innermost_stack_frame_quot()
|
||||||
|
|
||||||
PRIMITIVE(set_innermost_stack_frame_quot)
|
PRIMITIVE(set_innermost_stack_frame_quot)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_set_innermost_stack_frame_quot();
|
PRIMITIVE_GETVM()->primitive_set_innermost_stack_frame_quot();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* called before entry into Factor code. */
|
/* called before entry into Factor code. */
|
||||||
void factorvm::save_callstack_bottom(stack_frame *callstack_bottom)
|
void factor_vm::save_callstack_bottom(stack_frame *callstack_bottom)
|
||||||
{
|
{
|
||||||
stack_chain->callstack_bottom = callstack_bottom;
|
stack_chain->callstack_bottom = callstack_bottom;
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factorvm *myvm)
|
VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *myvm)
|
||||||
{
|
{
|
||||||
ASSERTVM();
|
ASSERTVM();
|
||||||
return VM_PTR->save_callstack_bottom(callstack_bottom);
|
return VM_PTR->save_callstack_bottom(callstack_bottom);
|
||||||
|
|
|
@ -13,8 +13,7 @@ PRIMITIVE(innermost_stack_frame_executing);
|
||||||
PRIMITIVE(innermost_stack_frame_scan);
|
PRIMITIVE(innermost_stack_frame_scan);
|
||||||
PRIMITIVE(set_innermost_stack_frame_quot);
|
PRIMITIVE(set_innermost_stack_frame_quot);
|
||||||
|
|
||||||
VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom,factorvm *vm);
|
VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom,factor_vm *vm);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -3,31 +3,27 @@
|
||||||
namespace factor
|
namespace factor
|
||||||
{
|
{
|
||||||
|
|
||||||
relocation_type factorvm::relocation_type_of(relocation_entry r)
|
relocation_type factor_vm::relocation_type_of(relocation_entry r)
|
||||||
{
|
{
|
||||||
return (relocation_type)((r & 0xf0000000) >> 28);
|
return (relocation_type)((r & 0xf0000000) >> 28);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
relocation_class factor_vm::relocation_class_of(relocation_entry r)
|
||||||
relocation_class factorvm::relocation_class_of(relocation_entry r)
|
|
||||||
{
|
{
|
||||||
return (relocation_class)((r & 0x0f000000) >> 24);
|
return (relocation_class)((r & 0x0f000000) >> 24);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
cell factor_vm::relocation_offset_of(relocation_entry r)
|
||||||
cell factorvm::relocation_offset_of(relocation_entry r)
|
|
||||||
{
|
{
|
||||||
return (r & 0x00ffffff);
|
return (r & 0x00ffffff);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void factor_vm::flush_icache_for(code_block *block)
|
||||||
void factorvm::flush_icache_for(code_block *block)
|
|
||||||
{
|
{
|
||||||
flush_icache((cell)block,block->size);
|
flush_icache((cell)block,block->size);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
int factor_vm::number_of_parameters(relocation_type type)
|
||||||
int factorvm::number_of_parameters(relocation_type type)
|
|
||||||
{
|
{
|
||||||
switch(type)
|
switch(type)
|
||||||
{
|
{
|
||||||
|
@ -52,8 +48,7 @@ int factorvm::number_of_parameters(relocation_type type)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void *factor_vm::object_xt(cell obj)
|
||||||
void *factorvm::object_xt(cell obj)
|
|
||||||
{
|
{
|
||||||
switch(tagged<object>(obj).type())
|
switch(tagged<object>(obj).type())
|
||||||
{
|
{
|
||||||
|
@ -67,8 +62,7 @@ void *factorvm::object_xt(cell obj)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void *factor_vm::xt_pic(word *w, cell tagged_quot)
|
||||||
void *factorvm::xt_pic(word *w, cell tagged_quot)
|
|
||||||
{
|
{
|
||||||
if(tagged_quot == F || max_pic_size == 0)
|
if(tagged_quot == F || max_pic_size == 0)
|
||||||
return w->xt;
|
return w->xt;
|
||||||
|
@ -82,33 +76,30 @@ void *factorvm::xt_pic(word *w, cell tagged_quot)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void *factor_vm::word_xt_pic(word *w)
|
||||||
void *factorvm::word_xt_pic(word *w)
|
|
||||||
{
|
{
|
||||||
return xt_pic(w,w->pic_def);
|
return xt_pic(w,w->pic_def);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void *factor_vm::word_xt_pic_tail(word *w)
|
||||||
void *factorvm::word_xt_pic_tail(word *w)
|
|
||||||
{
|
{
|
||||||
return xt_pic(w,w->pic_tail_def);
|
return xt_pic(w,w->pic_tail_def);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* References to undefined symbols are patched up to call this function on
|
/* References to undefined symbols are patched up to call this function on
|
||||||
image load */
|
image load */
|
||||||
void factorvm::undefined_symbol()
|
void factor_vm::undefined_symbol()
|
||||||
{
|
{
|
||||||
general_error(ERROR_UNDEFINED_SYMBOL,F,F,NULL);
|
general_error(ERROR_UNDEFINED_SYMBOL,F,F,NULL);
|
||||||
}
|
}
|
||||||
|
|
||||||
void undefined_symbol(factorvm *myvm)
|
void undefined_symbol(factor_vm *myvm)
|
||||||
{
|
{
|
||||||
return myvm->undefined_symbol();
|
return myvm->undefined_symbol();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Look up an external library symbol referenced by a compiled code block */
|
/* Look up an external library symbol referenced by a compiled code block */
|
||||||
void *factorvm::get_rel_symbol(array *literals, cell index)
|
void *factor_vm::get_rel_symbol(array *literals, cell index)
|
||||||
{
|
{
|
||||||
cell symbol = array_nth(literals,index);
|
cell symbol = array_nth(literals,index);
|
||||||
cell library = array_nth(literals,index + 1);
|
cell library = array_nth(literals,index + 1);
|
||||||
|
@ -152,8 +143,7 @@ void *factorvm::get_rel_symbol(array *literals, cell index)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
cell factor_vm::compute_relocation(relocation_entry rel, cell index, code_block *compiled)
|
||||||
cell factorvm::compute_relocation(relocation_entry rel, cell index, code_block *compiled)
|
|
||||||
{
|
{
|
||||||
array *literals = untag<array>(compiled->literals);
|
array *literals = untag<array>(compiled->literals);
|
||||||
cell offset = relocation_offset_of(rel) + (cell)compiled->xt();
|
cell offset = relocation_offset_of(rel) + (cell)compiled->xt();
|
||||||
|
@ -197,8 +187,7 @@ cell factorvm::compute_relocation(relocation_entry rel, cell index, code_block *
|
||||||
#undef ARG
|
#undef ARG
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void factor_vm::iterate_relocations(code_block *compiled, relocation_iterator iter)
|
||||||
void factorvm::iterate_relocations(code_block *compiled, relocation_iterator iter)
|
|
||||||
{
|
{
|
||||||
if(compiled->relocation != F)
|
if(compiled->relocation != F)
|
||||||
{
|
{
|
||||||
|
@ -216,17 +205,15 @@ void factorvm::iterate_relocations(code_block *compiled, relocation_iterator ite
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Store a 32-bit value into a PowerPC LIS/ORI sequence */
|
/* Store a 32-bit value into a PowerPC LIS/ORI sequence */
|
||||||
void factorvm::store_address_2_2(cell *ptr, cell value)
|
void factor_vm::store_address_2_2(cell *ptr, cell value)
|
||||||
{
|
{
|
||||||
ptr[-1] = ((ptr[-1] & ~0xffff) | ((value >> 16) & 0xffff));
|
ptr[-1] = ((ptr[-1] & ~0xffff) | ((value >> 16) & 0xffff));
|
||||||
ptr[ 0] = ((ptr[ 0] & ~0xffff) | (value & 0xffff));
|
ptr[ 0] = ((ptr[ 0] & ~0xffff) | (value & 0xffff));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Store a value into a bitfield of a PowerPC instruction */
|
/* Store a value into a bitfield of a PowerPC instruction */
|
||||||
void factorvm::store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift)
|
void factor_vm::store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift)
|
||||||
{
|
{
|
||||||
/* This is unaccurate but good enough */
|
/* This is unaccurate but good enough */
|
||||||
fixnum test = (fixnum)mask >> 1;
|
fixnum test = (fixnum)mask >> 1;
|
||||||
|
@ -236,9 +223,8 @@ void factorvm::store_address_masked(cell *ptr, fixnum value, cell mask, fixnum s
|
||||||
*ptr = ((*ptr & ~mask) | ((value >> shift) & mask));
|
*ptr = ((*ptr & ~mask) | ((value >> shift) & mask));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Perform a fixup on a code block */
|
/* Perform a fixup on a code block */
|
||||||
void factorvm::store_address_in_code_block(cell klass, cell offset, fixnum absolute_value)
|
void factor_vm::store_address_in_code_block(cell klass, cell offset, fixnum absolute_value)
|
||||||
{
|
{
|
||||||
fixnum relative_value = absolute_value - offset;
|
fixnum relative_value = absolute_value - offset;
|
||||||
|
|
||||||
|
@ -283,8 +269,7 @@ void factorvm::store_address_in_code_block(cell klass, cell offset, fixnum absol
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void factor_vm::update_literal_references_step(relocation_entry rel, cell index, code_block *compiled)
|
||||||
void factorvm::update_literal_references_step(relocation_entry rel, cell index, code_block *compiled)
|
|
||||||
{
|
{
|
||||||
if(relocation_type_of(rel) == RT_IMMEDIATE)
|
if(relocation_type_of(rel) == RT_IMMEDIATE)
|
||||||
{
|
{
|
||||||
|
@ -295,13 +280,13 @@ void factorvm::update_literal_references_step(relocation_entry rel, cell index,
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void update_literal_references_step(relocation_entry rel, cell index, code_block *compiled, factorvm *myvm)
|
void update_literal_references_step(relocation_entry rel, cell index, code_block *compiled, factor_vm *myvm)
|
||||||
{
|
{
|
||||||
return myvm->update_literal_references_step(rel,index,compiled);
|
return myvm->update_literal_references_step(rel,index,compiled);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Update pointers to literals from compiled code. */
|
/* Update pointers to literals from compiled code. */
|
||||||
void factorvm::update_literal_references(code_block *compiled)
|
void factor_vm::update_literal_references(code_block *compiled)
|
||||||
{
|
{
|
||||||
if(!compiled->needs_fixup)
|
if(!compiled->needs_fixup)
|
||||||
{
|
{
|
||||||
|
@ -310,10 +295,9 @@ void factorvm::update_literal_references(code_block *compiled)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Copy all literals referenced from a code block to newspace. Only for
|
/* Copy all literals referenced from a code block to newspace. Only for
|
||||||
aging and nursery collections */
|
aging and nursery collections */
|
||||||
void factorvm::copy_literal_references(code_block *compiled)
|
void factor_vm::copy_literal_references(code_block *compiled)
|
||||||
{
|
{
|
||||||
if(collecting_gen >= compiled->last_scan)
|
if(collecting_gen >= compiled->last_scan)
|
||||||
{
|
{
|
||||||
|
@ -336,13 +320,13 @@ void factorvm::copy_literal_references(code_block *compiled)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void copy_literal_references(code_block *compiled, factorvm *myvm)
|
void copy_literal_references(code_block *compiled, factor_vm *myvm)
|
||||||
{
|
{
|
||||||
return myvm->copy_literal_references(compiled);
|
return myvm->copy_literal_references(compiled);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Compute an address to store at a relocation */
|
/* Compute an address to store at a relocation */
|
||||||
void factorvm::relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled)
|
void factor_vm::relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled)
|
||||||
{
|
{
|
||||||
#ifdef FACTOR_DEBUG
|
#ifdef FACTOR_DEBUG
|
||||||
tagged<array>(compiled->literals).untag_check(this);
|
tagged<array>(compiled->literals).untag_check(this);
|
||||||
|
@ -354,19 +338,19 @@ void factorvm::relocate_code_block_step(relocation_entry rel, cell index, code_b
|
||||||
compute_relocation(rel,index,compiled));
|
compute_relocation(rel,index,compiled));
|
||||||
}
|
}
|
||||||
|
|
||||||
void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled, factorvm *myvm)
|
void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled, factor_vm *myvm)
|
||||||
{
|
{
|
||||||
return myvm->relocate_code_block_step(rel,index,compiled);
|
return myvm->relocate_code_block_step(rel,index,compiled);
|
||||||
}
|
}
|
||||||
|
|
||||||
void factorvm::update_word_references_step(relocation_entry rel, cell index, code_block *compiled)
|
void factor_vm::update_word_references_step(relocation_entry rel, cell index, code_block *compiled)
|
||||||
{
|
{
|
||||||
relocation_type type = relocation_type_of(rel);
|
relocation_type type = relocation_type_of(rel);
|
||||||
if(type == RT_XT || type == RT_XT_PIC || type == RT_XT_PIC_TAIL)
|
if(type == RT_XT || type == RT_XT_PIC || type == RT_XT_PIC_TAIL)
|
||||||
relocate_code_block_step(rel,index,compiled);
|
relocate_code_block_step(rel,index,compiled);
|
||||||
}
|
}
|
||||||
|
|
||||||
void update_word_references_step(relocation_entry rel, cell index, code_block *compiled, factorvm *myvm)
|
void update_word_references_step(relocation_entry rel, cell index, code_block *compiled, factor_vm *myvm)
|
||||||
{
|
{
|
||||||
return myvm->update_word_references_step(rel,index,compiled);
|
return myvm->update_word_references_step(rel,index,compiled);
|
||||||
}
|
}
|
||||||
|
@ -375,7 +359,7 @@ void update_word_references_step(relocation_entry rel, cell index, code_block *c
|
||||||
dlsyms, and words. For all other words in the code heap, we only need
|
dlsyms, and words. For all other words in the code heap, we only need
|
||||||
to update references to other words, without worrying about literals
|
to update references to other words, without worrying about literals
|
||||||
or dlsyms. */
|
or dlsyms. */
|
||||||
void factorvm::update_word_references(code_block *compiled)
|
void factor_vm::update_word_references(code_block *compiled)
|
||||||
{
|
{
|
||||||
if(compiled->needs_fixup)
|
if(compiled->needs_fixup)
|
||||||
relocate_code_block(compiled);
|
relocate_code_block(compiled);
|
||||||
|
@ -395,36 +379,35 @@ void factorvm::update_word_references(code_block *compiled)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void update_word_references(code_block *compiled, factorvm *myvm)
|
void update_word_references(code_block *compiled, factor_vm *myvm)
|
||||||
{
|
{
|
||||||
return myvm->update_word_references(compiled);
|
return myvm->update_word_references(compiled);
|
||||||
}
|
}
|
||||||
|
|
||||||
void factorvm::update_literal_and_word_references(code_block *compiled)
|
void factor_vm::update_literal_and_word_references(code_block *compiled)
|
||||||
{
|
{
|
||||||
update_literal_references(compiled);
|
update_literal_references(compiled);
|
||||||
update_word_references(compiled);
|
update_word_references(compiled);
|
||||||
}
|
}
|
||||||
|
|
||||||
void update_literal_and_word_references(code_block *compiled, factorvm *myvm)
|
void update_literal_and_word_references(code_block *compiled, factor_vm *myvm)
|
||||||
{
|
{
|
||||||
return myvm->update_literal_and_word_references(compiled);
|
return myvm->update_literal_and_word_references(compiled);
|
||||||
}
|
}
|
||||||
|
|
||||||
void factorvm::check_code_address(cell address)
|
void factor_vm::check_code_address(cell address)
|
||||||
{
|
{
|
||||||
#ifdef FACTOR_DEBUG
|
#ifdef FACTOR_DEBUG
|
||||||
assert(address >= code.seg->start && address < code.seg->end);
|
assert(address >= code.seg->start && address < code.seg->end);
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Update references to words. This is done after a new code block
|
/* Update references to words. This is done after a new code block
|
||||||
is added to the heap. */
|
is added to the heap. */
|
||||||
|
|
||||||
/* Mark all literals referenced from a word XT. Only for tenured
|
/* Mark all literals referenced from a word XT. Only for tenured
|
||||||
collections */
|
collections */
|
||||||
void factorvm::mark_code_block(code_block *compiled)
|
void factor_vm::mark_code_block(code_block *compiled)
|
||||||
{
|
{
|
||||||
check_code_address((cell)compiled);
|
check_code_address((cell)compiled);
|
||||||
|
|
||||||
|
@ -434,19 +417,18 @@ void factorvm::mark_code_block(code_block *compiled)
|
||||||
copy_handle(&compiled->relocation);
|
copy_handle(&compiled->relocation);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void factor_vm::mark_stack_frame_step(stack_frame *frame)
|
||||||
void factorvm::mark_stack_frame_step(stack_frame *frame)
|
|
||||||
{
|
{
|
||||||
mark_code_block(frame_code(frame));
|
mark_code_block(frame_code(frame));
|
||||||
}
|
}
|
||||||
|
|
||||||
void mark_stack_frame_step(stack_frame *frame, factorvm *myvm)
|
void mark_stack_frame_step(stack_frame *frame, factor_vm *myvm)
|
||||||
{
|
{
|
||||||
return myvm->mark_stack_frame_step(frame);
|
return myvm->mark_stack_frame_step(frame);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Mark code blocks executing in currently active stack frames. */
|
/* Mark code blocks executing in currently active stack frames. */
|
||||||
void factorvm::mark_active_blocks(context *stacks)
|
void factor_vm::mark_active_blocks(context *stacks)
|
||||||
{
|
{
|
||||||
if(collecting_gen == data->tenured())
|
if(collecting_gen == data->tenured())
|
||||||
{
|
{
|
||||||
|
@ -457,8 +439,7 @@ void factorvm::mark_active_blocks(context *stacks)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void factor_vm::mark_object_code_block(object *object)
|
||||||
void factorvm::mark_object_code_block(object *object)
|
|
||||||
{
|
{
|
||||||
switch(object->h.hi_tag())
|
switch(object->h.hi_tag())
|
||||||
{
|
{
|
||||||
|
@ -487,9 +468,8 @@ void factorvm::mark_object_code_block(object *object)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Perform all fixups on a code block */
|
/* Perform all fixups on a code block */
|
||||||
void factorvm::relocate_code_block(code_block *compiled)
|
void factor_vm::relocate_code_block(code_block *compiled)
|
||||||
{
|
{
|
||||||
compiled->last_scan = data->nursery();
|
compiled->last_scan = data->nursery();
|
||||||
compiled->needs_fixup = false;
|
compiled->needs_fixup = false;
|
||||||
|
@ -497,13 +477,13 @@ void factorvm::relocate_code_block(code_block *compiled)
|
||||||
flush_icache_for(compiled);
|
flush_icache_for(compiled);
|
||||||
}
|
}
|
||||||
|
|
||||||
void relocate_code_block(code_block *compiled, factorvm *myvm)
|
void relocate_code_block(code_block *compiled, factor_vm *myvm)
|
||||||
{
|
{
|
||||||
return myvm->relocate_code_block(compiled);
|
return myvm->relocate_code_block(compiled);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Fixup labels. This is done at compile time, not image load time */
|
/* Fixup labels. This is done at compile time, not image load time */
|
||||||
void factorvm::fixup_labels(array *labels, code_block *compiled)
|
void factor_vm::fixup_labels(array *labels, code_block *compiled)
|
||||||
{
|
{
|
||||||
cell i;
|
cell i;
|
||||||
cell size = array_capacity(labels);
|
cell size = array_capacity(labels);
|
||||||
|
@ -520,9 +500,8 @@ void factorvm::fixup_labels(array *labels, code_block *compiled)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Might GC */
|
/* Might GC */
|
||||||
code_block *factorvm::allot_code_block(cell size)
|
code_block *factor_vm::allot_code_block(cell size)
|
||||||
{
|
{
|
||||||
heap_block *block = heap_allot(&code,size + sizeof(code_block));
|
heap_block *block = heap_allot(&code,size + sizeof(code_block));
|
||||||
|
|
||||||
|
@ -549,9 +528,8 @@ code_block *factorvm::allot_code_block(cell size)
|
||||||
return (code_block *)block;
|
return (code_block *)block;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Might GC */
|
/* Might GC */
|
||||||
code_block *factorvm::add_code_block(cell type,cell code_,cell labels_,cell relocation_,cell literals_)
|
code_block *factor_vm::add_code_block(cell type, cell code_, cell labels_, cell relocation_, cell literals_)
|
||||||
{
|
{
|
||||||
gc_root<byte_array> code(code_,this);
|
gc_root<byte_array> code(code_,this);
|
||||||
gc_root<object> labels(labels_,this);
|
gc_root<object> labels(labels_,this);
|
||||||
|
@ -587,5 +565,4 @@ code_block *factorvm::add_code_block(cell type,cell code_,cell labels_,cell relo
|
||||||
return compiled;
|
return compiled;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -26,7 +26,7 @@ enum relocation_type {
|
||||||
RT_UNTAGGED,
|
RT_UNTAGGED,
|
||||||
/* address of megamorphic_cache_hits var */
|
/* address of megamorphic_cache_hits var */
|
||||||
RT_MEGAMORPHIC_CACHE_HITS,
|
RT_MEGAMORPHIC_CACHE_HITS,
|
||||||
/* address of vm object*/
|
/* address of vm object */
|
||||||
RT_VM,
|
RT_VM,
|
||||||
};
|
};
|
||||||
|
|
||||||
|
@ -62,14 +62,14 @@ static const cell rel_relative_arm_3_mask = 0xffffff;
|
||||||
/* code relocation table consists of a table of entries for each fixup */
|
/* code relocation table consists of a table of entries for each fixup */
|
||||||
typedef u32 relocation_entry;
|
typedef u32 relocation_entry;
|
||||||
|
|
||||||
struct factorvm;
|
struct factor_vm;
|
||||||
|
|
||||||
typedef void (*relocation_iterator)(relocation_entry rel, cell index, code_block *compiled, factorvm *vm);
|
typedef void (*relocation_iterator)(relocation_entry rel, cell index, code_block *compiled, factor_vm *vm);
|
||||||
|
|
||||||
// callback functions
|
// callback functions
|
||||||
void relocate_code_block(code_block *compiled, factorvm *myvm);
|
void relocate_code_block(code_block *compiled, factor_vm *myvm);
|
||||||
void copy_literal_references(code_block *compiled, factorvm *myvm);
|
void copy_literal_references(code_block *compiled, factor_vm *myvm);
|
||||||
void update_word_references(code_block *compiled, factorvm *myvm);
|
void update_word_references(code_block *compiled, factor_vm *myvm);
|
||||||
void update_literal_and_word_references(code_block *compiled, factorvm *myvm);
|
void update_literal_and_word_references(code_block *compiled, factor_vm *myvm);
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -3,16 +3,15 @@
|
||||||
namespace factor
|
namespace factor
|
||||||
{
|
{
|
||||||
|
|
||||||
void factorvm::clear_free_list(heap *heap)
|
void factor_vm::clear_free_list(heap *heap)
|
||||||
{
|
{
|
||||||
memset(&heap->free,0,sizeof(heap_free_list));
|
memset(&heap->free,0,sizeof(heap_free_list));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* This malloc-style heap code is reasonably generic. Maybe in the future, it
|
/* This malloc-style heap code is reasonably generic. Maybe in the future, it
|
||||||
will be used for the data heap too, if we ever get incremental
|
will be used for the data heap too, if we ever get incremental
|
||||||
mark/sweep/compact GC. */
|
mark/sweep/compact GC. */
|
||||||
void factorvm::new_heap(heap *heap, cell size)
|
void factor_vm::new_heap(heap *heap, cell size)
|
||||||
{
|
{
|
||||||
heap->seg = alloc_segment(align_page(size));
|
heap->seg = alloc_segment(align_page(size));
|
||||||
if(!heap->seg)
|
if(!heap->seg)
|
||||||
|
@ -21,8 +20,7 @@ void factorvm::new_heap(heap *heap, cell size)
|
||||||
clear_free_list(heap);
|
clear_free_list(heap);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void factor_vm::add_to_free_list(heap *heap, free_heap_block *block)
|
||||||
void factorvm::add_to_free_list(heap *heap, free_heap_block *block)
|
|
||||||
{
|
{
|
||||||
if(block->size < free_list_count * block_size_increment)
|
if(block->size < free_list_count * block_size_increment)
|
||||||
{
|
{
|
||||||
|
@ -37,12 +35,11 @@ void factorvm::add_to_free_list(heap *heap, free_heap_block *block)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Called after reading the code heap from the image file, and after code GC.
|
/* Called after reading the code heap from the image file, and after code GC.
|
||||||
|
|
||||||
In the former case, we must add a large free block from compiling.base + size to
|
In the former case, we must add a large free block from compiling.base + size to
|
||||||
compiling.limit. */
|
compiling.limit. */
|
||||||
void factorvm::build_free_list(heap *heap, cell size)
|
void factor_vm::build_free_list(heap *heap, cell size)
|
||||||
{
|
{
|
||||||
heap_block *prev = NULL;
|
heap_block *prev = NULL;
|
||||||
|
|
||||||
|
@ -94,15 +91,14 @@ void factorvm::build_free_list(heap *heap, cell size)
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void factor_vm::assert_free_block(free_heap_block *block)
|
||||||
void factorvm::assert_free_block(free_heap_block *block)
|
|
||||||
{
|
{
|
||||||
if(block->status != B_FREE)
|
if(block->status != B_FREE)
|
||||||
critical_error("Invalid block in free list",(cell)block);
|
critical_error("Invalid block in free list",(cell)block);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
free_heap_block *factorvm::find_free_block(heap *heap, cell size)
|
free_heap_block *factor_vm::find_free_block(heap *heap, cell size)
|
||||||
{
|
{
|
||||||
cell attempt = size;
|
cell attempt = size;
|
||||||
|
|
||||||
|
@ -142,8 +138,7 @@ free_heap_block *factorvm::find_free_block(heap *heap, cell size)
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
free_heap_block *factor_vm::split_free_block(heap *heap, free_heap_block *block, cell size)
|
||||||
free_heap_block *factorvm::split_free_block(heap *heap, free_heap_block *block, cell size)
|
|
||||||
{
|
{
|
||||||
if(block->size != size )
|
if(block->size != size )
|
||||||
{
|
{
|
||||||
|
@ -159,9 +154,8 @@ free_heap_block *factorvm::split_free_block(heap *heap, free_heap_block *block,
|
||||||
return block;
|
return block;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Allocate a block of memory from the mark and sweep GC heap */
|
/* Allocate a block of memory from the mark and sweep GC heap */
|
||||||
heap_block *factorvm::heap_allot(heap *heap, cell size)
|
heap_block *factor_vm::heap_allot(heap *heap, cell size)
|
||||||
{
|
{
|
||||||
size = (size + block_size_increment - 1) & ~(block_size_increment - 1);
|
size = (size + block_size_increment - 1) & ~(block_size_increment - 1);
|
||||||
|
|
||||||
|
@ -177,16 +171,14 @@ heap_block *factorvm::heap_allot(heap *heap, cell size)
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Deallocates a block manually */
|
/* Deallocates a block manually */
|
||||||
void factorvm::heap_free(heap *heap, heap_block *block)
|
void factor_vm::heap_free(heap *heap, heap_block *block)
|
||||||
{
|
{
|
||||||
block->status = B_FREE;
|
block->status = B_FREE;
|
||||||
add_to_free_list(heap,(free_heap_block *)block);
|
add_to_free_list(heap,(free_heap_block *)block);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void factor_vm::mark_block(heap_block *block)
|
||||||
void factorvm::mark_block(heap_block *block)
|
|
||||||
{
|
{
|
||||||
/* If already marked, do nothing */
|
/* If already marked, do nothing */
|
||||||
switch(block->status)
|
switch(block->status)
|
||||||
|
@ -202,10 +194,9 @@ void factorvm::mark_block(heap_block *block)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* If in the middle of code GC, we have to grow the heap, data GC restarts from
|
/* If in the middle of code GC, we have to grow the heap, data GC restarts from
|
||||||
scratch, so we have to unmark any marked blocks. */
|
scratch, so we have to unmark any marked blocks. */
|
||||||
void factorvm::unmark_marked(heap *heap)
|
void factor_vm::unmark_marked(heap *heap)
|
||||||
{
|
{
|
||||||
heap_block *scan = first_block(heap);
|
heap_block *scan = first_block(heap);
|
||||||
|
|
||||||
|
@ -218,10 +209,9 @@ void factorvm::unmark_marked(heap *heap)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* After code GC, all referenced code blocks have status set to B_MARKED, so any
|
/* After code GC, all referenced code blocks have status set to B_MARKED, so any
|
||||||
which are allocated and not marked can be reclaimed. */
|
which are allocated and not marked can be reclaimed. */
|
||||||
void factorvm::free_unmarked(heap *heap, heap_iterator iter)
|
void factor_vm::free_unmarked(heap *heap, heap_iterator iter)
|
||||||
{
|
{
|
||||||
clear_free_list(heap);
|
clear_free_list(heap);
|
||||||
|
|
||||||
|
@ -268,9 +258,8 @@ void factorvm::free_unmarked(heap *heap, heap_iterator iter)
|
||||||
add_to_free_list(heap,(free_heap_block *)prev);
|
add_to_free_list(heap,(free_heap_block *)prev);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Compute total sum of sizes of free blocks, and size of largest free block */
|
/* Compute total sum of sizes of free blocks, and size of largest free block */
|
||||||
void factorvm::heap_usage(heap *heap, cell *used, cell *total_free, cell *max_free)
|
void factor_vm::heap_usage(heap *heap, cell *used, cell *total_free, cell *max_free)
|
||||||
{
|
{
|
||||||
*used = 0;
|
*used = 0;
|
||||||
*total_free = 0;
|
*total_free = 0;
|
||||||
|
@ -298,9 +287,8 @@ void factorvm::heap_usage(heap *heap, cell *used, cell *total_free, cell *max_fr
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* The size of the heap, not including the last block if it's free */
|
/* The size of the heap, not including the last block if it's free */
|
||||||
cell factorvm::heap_size(heap *heap)
|
cell factor_vm::heap_size(heap *heap)
|
||||||
{
|
{
|
||||||
heap_block *scan = first_block(heap);
|
heap_block *scan = first_block(heap);
|
||||||
|
|
||||||
|
@ -315,9 +303,8 @@ cell factorvm::heap_size(heap *heap)
|
||||||
return heap->seg->size;
|
return heap->seg->size;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Compute where each block is going to go, after compaction */
|
/* Compute where each block is going to go, after compaction */
|
||||||
cell factorvm::compute_heap_forwarding(heap *heap, unordered_map<heap_block *,char *> &forwarding)
|
cell factor_vm::compute_heap_forwarding(heap *heap, unordered_map<heap_block *,char *> &forwarding)
|
||||||
{
|
{
|
||||||
heap_block *scan = first_block(heap);
|
heap_block *scan = first_block(heap);
|
||||||
char *address = (char *)first_block(heap);
|
char *address = (char *)first_block(heap);
|
||||||
|
@ -338,8 +325,7 @@ cell factorvm::compute_heap_forwarding(heap *heap, unordered_map<heap_block *,ch
|
||||||
return (cell)address - heap->seg->start;
|
return (cell)address - heap->seg->start;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void factor_vm::compact_heap(heap *heap, unordered_map<heap_block *,char *> &forwarding)
|
||||||
void factorvm::compact_heap(heap *heap, unordered_map<heap_block *,char *> &forwarding)
|
|
||||||
{
|
{
|
||||||
heap_block *scan = first_block(heap);
|
heap_block *scan = first_block(heap);
|
||||||
|
|
||||||
|
|
|
@ -14,7 +14,7 @@ struct heap {
|
||||||
heap_free_list free;
|
heap_free_list free;
|
||||||
};
|
};
|
||||||
|
|
||||||
typedef void (*heap_iterator)(heap_block *compiled,factorvm *vm);
|
typedef void (*heap_iterator)(heap_block *compiled,factor_vm *vm);
|
||||||
|
|
||||||
inline static heap_block *next_block(heap *h, heap_block *block)
|
inline static heap_block *next_block(heap *h, heap_block *block)
|
||||||
{
|
{
|
||||||
|
|
|
@ -4,18 +4,18 @@ namespace factor
|
||||||
{
|
{
|
||||||
|
|
||||||
/* Allocate a code heap during startup */
|
/* Allocate a code heap during startup */
|
||||||
void factorvm::init_code_heap(cell size)
|
void factor_vm::init_code_heap(cell size)
|
||||||
{
|
{
|
||||||
new_heap(&code,size);
|
new_heap(&code,size);
|
||||||
}
|
}
|
||||||
|
|
||||||
bool factorvm::in_code_heap_p(cell ptr)
|
bool factor_vm::in_code_heap_p(cell ptr)
|
||||||
{
|
{
|
||||||
return (ptr >= code.seg->start && ptr <= code.seg->end);
|
return (ptr >= code.seg->start && ptr <= code.seg->end);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Compile a word definition with the non-optimizing compiler. Allocates memory */
|
/* Compile a word definition with the non-optimizing compiler. Allocates memory */
|
||||||
void factorvm::jit_compile_word(cell word_, cell def_, bool relocate)
|
void factor_vm::jit_compile_word(cell word_, cell def_, bool relocate)
|
||||||
{
|
{
|
||||||
gc_root<word> word(word_,this);
|
gc_root<word> word(word_,this);
|
||||||
gc_root<quotation> def(def_,this);
|
gc_root<quotation> def(def_,this);
|
||||||
|
@ -28,9 +28,8 @@ void factorvm::jit_compile_word(cell word_, cell def_, bool relocate)
|
||||||
if(word->pic_tail_def != F) jit_compile(word->pic_tail_def,relocate);
|
if(word->pic_tail_def != F) jit_compile(word->pic_tail_def,relocate);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Apply a function to every code block */
|
/* Apply a function to every code block */
|
||||||
void factorvm::iterate_code_heap(code_heap_iterator iter)
|
void factor_vm::iterate_code_heap(code_heap_iterator iter)
|
||||||
{
|
{
|
||||||
heap_block *scan = first_block(&code);
|
heap_block *scan = first_block(&code);
|
||||||
|
|
||||||
|
@ -42,24 +41,21 @@ void factorvm::iterate_code_heap(code_heap_iterator iter)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Copy literals referenced from all code blocks to newspace. Only for
|
/* Copy literals referenced from all code blocks to newspace. Only for
|
||||||
aging and nursery collections */
|
aging and nursery collections */
|
||||||
void factorvm::copy_code_heap_roots()
|
void factor_vm::copy_code_heap_roots()
|
||||||
{
|
{
|
||||||
iterate_code_heap(factor::copy_literal_references);
|
iterate_code_heap(factor::copy_literal_references);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Update pointers to words referenced from all code blocks. Only after
|
/* Update pointers to words referenced from all code blocks. Only after
|
||||||
defining a new word. */
|
defining a new word. */
|
||||||
void factorvm::update_code_heap_words()
|
void factor_vm::update_code_heap_words()
|
||||||
{
|
{
|
||||||
iterate_code_heap(factor::update_word_references);
|
iterate_code_heap(factor::update_word_references);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
inline void factor_vm::primitive_modify_code_heap()
|
||||||
inline void factorvm::vmprim_modify_code_heap()
|
|
||||||
{
|
{
|
||||||
gc_root<array> alist(dpop(),this);
|
gc_root<array> alist(dpop(),this);
|
||||||
|
|
||||||
|
@ -112,11 +108,11 @@ inline void factorvm::vmprim_modify_code_heap()
|
||||||
|
|
||||||
PRIMITIVE(modify_code_heap)
|
PRIMITIVE(modify_code_heap)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_modify_code_heap();
|
PRIMITIVE_GETVM()->primitive_modify_code_heap();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Push the free space and total size of the code heap */
|
/* Push the free space and total size of the code heap */
|
||||||
inline void factorvm::vmprim_code_room()
|
inline void factor_vm::primitive_code_room()
|
||||||
{
|
{
|
||||||
cell used, total_free, max_free;
|
cell used, total_free, max_free;
|
||||||
heap_usage(&code,&used,&total_free,&max_free);
|
heap_usage(&code,&used,&total_free,&max_free);
|
||||||
|
@ -128,17 +124,15 @@ inline void factorvm::vmprim_code_room()
|
||||||
|
|
||||||
PRIMITIVE(code_room)
|
PRIMITIVE(code_room)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_code_room();
|
PRIMITIVE_GETVM()->primitive_code_room();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
code_block *factor_vm::forward_xt(code_block *compiled)
|
||||||
code_block *factorvm::forward_xt(code_block *compiled)
|
|
||||||
{
|
{
|
||||||
return (code_block *)forwarding[compiled];
|
return (code_block *)forwarding[compiled];
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void factor_vm::forward_frame_xt(stack_frame *frame)
|
||||||
void factorvm::forward_frame_xt(stack_frame *frame)
|
|
||||||
{
|
{
|
||||||
cell offset = (cell)FRAME_RETURN_ADDRESS(frame) - (cell)frame_code(frame);
|
cell offset = (cell)FRAME_RETURN_ADDRESS(frame) - (cell)frame_code(frame);
|
||||||
code_block *forwarded = forward_xt(frame_code(frame));
|
code_block *forwarded = forward_xt(frame_code(frame));
|
||||||
|
@ -146,12 +140,12 @@ void factorvm::forward_frame_xt(stack_frame *frame)
|
||||||
FRAME_RETURN_ADDRESS(frame) = (void *)((cell)forwarded + offset);
|
FRAME_RETURN_ADDRESS(frame) = (void *)((cell)forwarded + offset);
|
||||||
}
|
}
|
||||||
|
|
||||||
void forward_frame_xt(stack_frame *frame,factorvm *myvm)
|
void forward_frame_xt(stack_frame *frame,factor_vm *myvm)
|
||||||
{
|
{
|
||||||
return myvm->forward_frame_xt(frame);
|
return myvm->forward_frame_xt(frame);
|
||||||
}
|
}
|
||||||
|
|
||||||
void factorvm::forward_object_xts()
|
void factor_vm::forward_object_xts()
|
||||||
{
|
{
|
||||||
begin_scan();
|
begin_scan();
|
||||||
|
|
||||||
|
@ -193,9 +187,8 @@ void factorvm::forward_object_xts()
|
||||||
end_scan();
|
end_scan();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Set the XT fields now that the heap has been compacted */
|
/* Set the XT fields now that the heap has been compacted */
|
||||||
void factorvm::fixup_object_xts()
|
void factor_vm::fixup_object_xts()
|
||||||
{
|
{
|
||||||
begin_scan();
|
begin_scan();
|
||||||
|
|
||||||
|
@ -223,12 +216,11 @@ void factorvm::fixup_object_xts()
|
||||||
end_scan();
|
end_scan();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Move all free space to the end of the code heap. This is not very efficient,
|
/* Move all free space to the end of the code heap. This is not very efficient,
|
||||||
since it makes several passes over the code and data heaps, but we only ever
|
since it makes several passes over the code and data heaps, but we only ever
|
||||||
do this before saving a deployed image and exiting, so performaance is not
|
do this before saving a deployed image and exiting, so performaance is not
|
||||||
critical here */
|
critical here */
|
||||||
void factorvm::compact_code_heap()
|
void factor_vm::compact_code_heap()
|
||||||
{
|
{
|
||||||
/* Free all unreachable code blocks */
|
/* Free all unreachable code blocks */
|
||||||
gc();
|
gc();
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
namespace factor
|
namespace factor
|
||||||
{
|
{
|
||||||
struct factorvm;
|
struct factor_vm;
|
||||||
typedef void (*code_heap_iterator)(code_block *compiled,factorvm *myvm);
|
typedef void (*code_heap_iterator)(code_block *compiled,factor_vm *myvm);
|
||||||
|
|
||||||
PRIMITIVE(modify_code_heap);
|
PRIMITIVE(modify_code_heap);
|
||||||
PRIMITIVE(code_room);
|
PRIMITIVE(code_room);
|
||||||
|
|
|
@ -3,20 +3,19 @@
|
||||||
namespace factor
|
namespace factor
|
||||||
{
|
{
|
||||||
|
|
||||||
|
void factor_vm::reset_datastack()
|
||||||
void factorvm::reset_datastack()
|
|
||||||
{
|
{
|
||||||
ds = ds_bot - sizeof(cell);
|
ds = ds_bot - sizeof(cell);
|
||||||
}
|
}
|
||||||
|
|
||||||
void factorvm::reset_retainstack()
|
void factor_vm::reset_retainstack()
|
||||||
{
|
{
|
||||||
rs = rs_bot - sizeof(cell);
|
rs = rs_bot - sizeof(cell);
|
||||||
}
|
}
|
||||||
|
|
||||||
static const cell stack_reserved = (64 * sizeof(cell));
|
static const cell stack_reserved = (64 * sizeof(cell));
|
||||||
|
|
||||||
void factorvm::fix_stacks()
|
void factor_vm::fix_stacks()
|
||||||
{
|
{
|
||||||
if(ds + sizeof(cell) < ds_bot || ds + stack_reserved >= ds_top) reset_datastack();
|
if(ds + sizeof(cell) < ds_bot || ds + stack_reserved >= ds_top) reset_datastack();
|
||||||
if(rs + sizeof(cell) < rs_bot || rs + stack_reserved >= rs_top) reset_retainstack();
|
if(rs + sizeof(cell) < rs_bot || rs + stack_reserved >= rs_top) reset_retainstack();
|
||||||
|
@ -24,7 +23,7 @@ void factorvm::fix_stacks()
|
||||||
|
|
||||||
/* called before entry into foreign C code. Note that ds and rs might
|
/* called before entry into foreign C code. Note that ds and rs might
|
||||||
be stored in registers, so callbacks must save and restore the correct values */
|
be stored in registers, so callbacks must save and restore the correct values */
|
||||||
void factorvm::save_stacks()
|
void factor_vm::save_stacks()
|
||||||
{
|
{
|
||||||
if(stack_chain)
|
if(stack_chain)
|
||||||
{
|
{
|
||||||
|
@ -33,7 +32,7 @@ void factorvm::save_stacks()
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
context *factorvm::alloc_context()
|
context *factor_vm::alloc_context()
|
||||||
{
|
{
|
||||||
context *new_context;
|
context *new_context;
|
||||||
|
|
||||||
|
@ -52,14 +51,14 @@ context *factorvm::alloc_context()
|
||||||
return new_context;
|
return new_context;
|
||||||
}
|
}
|
||||||
|
|
||||||
void factorvm::dealloc_context(context *old_context)
|
void factor_vm::dealloc_context(context *old_context)
|
||||||
{
|
{
|
||||||
old_context->next = unused_contexts;
|
old_context->next = unused_contexts;
|
||||||
unused_contexts = old_context;
|
unused_contexts = old_context;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* called on entry into a compiled callback */
|
/* called on entry into a compiled callback */
|
||||||
void factorvm::nest_stacks()
|
void factor_vm::nest_stacks()
|
||||||
{
|
{
|
||||||
context *new_context = alloc_context();
|
context *new_context = alloc_context();
|
||||||
|
|
||||||
|
@ -90,14 +89,14 @@ void factorvm::nest_stacks()
|
||||||
reset_retainstack();
|
reset_retainstack();
|
||||||
}
|
}
|
||||||
|
|
||||||
void nest_stacks(factorvm *myvm)
|
void nest_stacks(factor_vm *myvm)
|
||||||
{
|
{
|
||||||
ASSERTVM();
|
ASSERTVM();
|
||||||
return VM_PTR->nest_stacks();
|
return VM_PTR->nest_stacks();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* called when leaving a compiled callback */
|
/* called when leaving a compiled callback */
|
||||||
void factorvm::unnest_stacks()
|
void factor_vm::unnest_stacks()
|
||||||
{
|
{
|
||||||
ds = stack_chain->datastack_save;
|
ds = stack_chain->datastack_save;
|
||||||
rs = stack_chain->retainstack_save;
|
rs = stack_chain->retainstack_save;
|
||||||
|
@ -111,14 +110,14 @@ void factorvm::unnest_stacks()
|
||||||
dealloc_context(old_stacks);
|
dealloc_context(old_stacks);
|
||||||
}
|
}
|
||||||
|
|
||||||
void unnest_stacks(factorvm *myvm)
|
void unnest_stacks(factor_vm *myvm)
|
||||||
{
|
{
|
||||||
ASSERTVM();
|
ASSERTVM();
|
||||||
return VM_PTR->unnest_stacks();
|
return VM_PTR->unnest_stacks();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* called on startup */
|
/* called on startup */
|
||||||
void factorvm::init_stacks(cell ds_size_, cell rs_size_)
|
void factor_vm::init_stacks(cell ds_size_, cell rs_size_)
|
||||||
{
|
{
|
||||||
ds_size = ds_size_;
|
ds_size = ds_size_;
|
||||||
rs_size = rs_size_;
|
rs_size = rs_size_;
|
||||||
|
@ -126,7 +125,7 @@ void factorvm::init_stacks(cell ds_size_, cell rs_size_)
|
||||||
unused_contexts = NULL;
|
unused_contexts = NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
bool factorvm::stack_to_array(cell bottom, cell top)
|
bool factor_vm::stack_to_array(cell bottom, cell top)
|
||||||
{
|
{
|
||||||
fixnum depth = (fixnum)(top - bottom + sizeof(cell));
|
fixnum depth = (fixnum)(top - bottom + sizeof(cell));
|
||||||
|
|
||||||
|
@ -141,7 +140,7 @@ bool factorvm::stack_to_array(cell bottom, cell top)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
inline void factorvm::vmprim_datastack()
|
inline void factor_vm::primitive_datastack()
|
||||||
{
|
{
|
||||||
if(!stack_to_array(ds_bot,ds))
|
if(!stack_to_array(ds_bot,ds))
|
||||||
general_error(ERROR_DS_UNDERFLOW,F,F,NULL);
|
general_error(ERROR_DS_UNDERFLOW,F,F,NULL);
|
||||||
|
@ -149,10 +148,10 @@ inline void factorvm::vmprim_datastack()
|
||||||
|
|
||||||
PRIMITIVE(datastack)
|
PRIMITIVE(datastack)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_datastack();
|
PRIMITIVE_GETVM()->primitive_datastack();
|
||||||
}
|
}
|
||||||
|
|
||||||
inline void factorvm::vmprim_retainstack()
|
inline void factor_vm::primitive_retainstack()
|
||||||
{
|
{
|
||||||
if(!stack_to_array(rs_bot,rs))
|
if(!stack_to_array(rs_bot,rs))
|
||||||
general_error(ERROR_RS_UNDERFLOW,F,F,NULL);
|
general_error(ERROR_RS_UNDERFLOW,F,F,NULL);
|
||||||
|
@ -160,39 +159,39 @@ inline void factorvm::vmprim_retainstack()
|
||||||
|
|
||||||
PRIMITIVE(retainstack)
|
PRIMITIVE(retainstack)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_retainstack();
|
PRIMITIVE_GETVM()->primitive_retainstack();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* returns pointer to top of stack */
|
/* returns pointer to top of stack */
|
||||||
cell factorvm::array_to_stack(array *array, cell bottom)
|
cell factor_vm::array_to_stack(array *array, cell bottom)
|
||||||
{
|
{
|
||||||
cell depth = array_capacity(array) * sizeof(cell);
|
cell depth = array_capacity(array) * sizeof(cell);
|
||||||
memcpy((void*)bottom,array + 1,depth);
|
memcpy((void*)bottom,array + 1,depth);
|
||||||
return bottom + depth - sizeof(cell);
|
return bottom + depth - sizeof(cell);
|
||||||
}
|
}
|
||||||
|
|
||||||
inline void factorvm::vmprim_set_datastack()
|
inline void factor_vm::primitive_set_datastack()
|
||||||
{
|
{
|
||||||
ds = array_to_stack(untag_check<array>(dpop()),ds_bot);
|
ds = array_to_stack(untag_check<array>(dpop()),ds_bot);
|
||||||
}
|
}
|
||||||
|
|
||||||
PRIMITIVE(set_datastack)
|
PRIMITIVE(set_datastack)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_set_datastack();
|
PRIMITIVE_GETVM()->primitive_set_datastack();
|
||||||
}
|
}
|
||||||
|
|
||||||
inline void factorvm::vmprim_set_retainstack()
|
inline void factor_vm::primitive_set_retainstack()
|
||||||
{
|
{
|
||||||
rs = array_to_stack(untag_check<array>(dpop()),rs_bot);
|
rs = array_to_stack(untag_check<array>(dpop()),rs_bot);
|
||||||
}
|
}
|
||||||
|
|
||||||
PRIMITIVE(set_retainstack)
|
PRIMITIVE(set_retainstack)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_set_retainstack();
|
PRIMITIVE_GETVM()->primitive_set_retainstack();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Used to implement call( */
|
/* Used to implement call( */
|
||||||
inline void factorvm::vmprim_check_datastack()
|
inline void factor_vm::primitive_check_datastack()
|
||||||
{
|
{
|
||||||
fixnum out = to_fixnum(dpop());
|
fixnum out = to_fixnum(dpop());
|
||||||
fixnum in = to_fixnum(dpop());
|
fixnum in = to_fixnum(dpop());
|
||||||
|
@ -219,7 +218,7 @@ inline void factorvm::vmprim_check_datastack()
|
||||||
|
|
||||||
PRIMITIVE(check_datastack)
|
PRIMITIVE(check_datastack)
|
||||||
{
|
{
|
||||||
PRIMITIVE_GETVM()->vmprim_check_datastack();
|
PRIMITIVE_GETVM()->primitive_check_datastack();
|
||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -50,9 +50,9 @@ PRIMITIVE(set_datastack);
|
||||||
PRIMITIVE(set_retainstack);
|
PRIMITIVE(set_retainstack);
|
||||||
PRIMITIVE(check_datastack);
|
PRIMITIVE(check_datastack);
|
||||||
|
|
||||||
struct factorvm;
|
struct factor_vm;
|
||||||
VM_C_API void nest_stacks(factorvm *vm);
|
VM_C_API void nest_stacks(factor_vm *vm);
|
||||||
VM_C_API void unnest_stacks(factorvm *vm);
|
VM_C_API void unnest_stacks(factor_vm *vm);
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -93,7 +93,6 @@ DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)):
|
||||||
mov NV_TEMP_REG,ARG1
|
mov NV_TEMP_REG,ARG1
|
||||||
jmp *QUOT_XT_OFFSET(ARG0)
|
jmp *QUOT_XT_OFFSET(ARG0)
|
||||||
|
|
||||||
|
|
||||||
DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
|
DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
|
||||||
mov ARG1,NV_TEMP_REG /* stash vm ptr */
|
mov ARG1,NV_TEMP_REG /* stash vm ptr */
|
||||||
mov STACK_REG,ARG1 /* Save stack pointer */
|
mov STACK_REG,ARG1 /* Save stack pointer */
|
||||||
|
@ -103,7 +102,7 @@ DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
|
||||||
pop NV_TEMP_REG
|
pop NV_TEMP_REG
|
||||||
mov RETURN_REG,ARG0 /* No-op on 32-bit */
|
mov RETURN_REG,ARG0 /* No-op on 32-bit */
|
||||||
add $STACK_PADDING,STACK_REG
|
add $STACK_PADDING,STACK_REG
|
||||||
jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
|
jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
|
||||||
|
|
||||||
|
|
||||||
#include "cpu-x86.S"
|
#include "cpu-x86.S"
|
||||||
|
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue