! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.data alien.strings parser
-threads words kernel.private kernel io.encodings.utf8 eval ;
+USING: accessors alien alien.c-types alien.data alien.strings
+parser threads words kernel.private kernel io.encodings.utf8
+eval ;
IN: alien.remote-control
: eval-callback ( -- callback )
- "void*" { "char*" } "cdecl"
+ void* { char* } "cdecl"
[ eval>string utf8 malloc-string ] alien-callback ;
: yield-callback ( -- callback )
- "void" { } "cdecl" [ yield ] alien-callback ;
+ void { } "cdecl" [ yield ] alien-callback ;
: sleep-callback ( -- callback )
- "void" { "long" } "cdecl" [ sleep ] alien-callback ;
+ void { long } "cdecl" [ sleep ] alien-callback ;
: ?callback ( word -- alien )
dup optimized? [ execute ] [ drop f ] if ; inline
: alien-parameters ( params -- seq )
dup parameters>>
- swap return>> large-struct? [ "void*" prefix ] when ;
+ swap return>> large-struct? [ void* prefix ] when ;
: alien-return ( params -- ctype )
- return>> dup large-struct? [ drop "void" ] when ;
+ return>> dup large-struct? [ drop void ] when ;
: c-type-stack-align ( type -- align )
dup c-type-stack-align? [ c-type-align ] [ drop cell ] if ;
: parameter-align ( n type -- n delta )
[ c-type-stack-align align dup ] [ drop ] 2bi - ;
-: parameter-sizes ( types -- total offsets )
- #! Compute stack frame locations.
+: parameter-offsets ( types -- total offsets )
[
0 [
[ parameter-align drop dup , ] keep stack-size +
M: ##gc compute-stack-frame*
frame-required? on
- stack-frame new swap tagged-values>> length cells >>gc-root-size
+ stack-frame new
+ swap tagged-values>> length cells >>gc-root-size
+ t >>calls-vm?
request-stack-frame ;
M: _spill-area-size compute-stack-frame*
stack-frame new
swap
[ return>> return-size >>return ]
- [ alien-parameters parameter-sizes drop >>params ] bi ;
+ [ alien-parameters parameter-offsets drop >>params ] bi
+ t >>calls-vm? ;
: alien-node-height ( params -- )
[ out-d>> length ] [ in-d>> length ] bi - adjust-d ;
{ return integer }
{ total-size integer }
{ gc-root-size integer }
-{ spill-area-size integer } ;
+{ spill-area-size integer }
+{ calls-vm? boolean } ;
! Stack frame utilities
: param-base ( -- n )
: max-stack-frame ( frame1 frame2 -- frame3 )
[ stack-frame new ] 2dip
+ {
[ [ params>> ] bi@ max >>params ]
[ [ return>> ] bi@ max >>return ]
[ [ gc-root-size>> ] bi@ max >>gc-root-size ]
- 2tri ;
\ No newline at end of file
+ [ [ calls-vm?>> ] bi@ or >>calls-vm? ]
+ } 2cleave ;
\ No newline at end of file
[ alloc-stack-param ] [ alloc-fastcall-param ] if
[ param-reg ] dip ;
-: (flatten-int-type) ( size -- seq )
- cell /i "void*" c-type <repetition> ;
+: (flatten-int-type) ( type -- seq )
+ stack-size cell align cell /i void* c-type <repetition> ;
GENERIC: flatten-value-type ( type -- types )
M: object flatten-value-type 1array ;
-
-M: struct-c-type flatten-value-type ( type -- types )
- stack-size cell align (flatten-int-type) ;
-
-M: long-long-type flatten-value-type ( type -- types )
- stack-size cell align (flatten-int-type) ;
+M: struct-c-type flatten-value-type (flatten-int-type) ;
+M: long-long-type flatten-value-type (flatten-int-type) ;
+M: c-type-name flatten-value-type c-type flatten-value-type ;
: flatten-value-types ( params -- params )
#! Convert value type structs to consecutive void*s.
[
0 [
c-type
- [ parameter-align (flatten-int-type) % ] keep
+ [ parameter-align cell /i void* c-type <repetition> % ] keep
[ stack-size cell align + ] keep
flatten-value-type %
] reduce drop
] { } make ;
: each-parameter ( parameters quot -- )
- [ [ parameter-sizes nip ] keep ] dip 2each ; inline
-
-: reverse-each-parameter ( parameters quot -- )
- [ [ parameter-sizes nip ] keep ] dip 2reverse-each ; inline
+ [ [ parameter-offsets nip ] keep ] dip 2each ; inline
: reset-fastcall-counts ( -- )
{ int-regs float-regs stack-params } [ 0 swap set ] each ;
[ '[ alloc-parameter _ execute ] ]
bi* each-parameter ; inline
+: reverse-each-parameter ( parameters quot -- )
+ [ [ parameter-offsets nip ] keep ] dip 2reverse-each ; inline
+
+: prepare-unbox-parameters ( parameters -- offsets types indices )
+ [ parameter-offsets nip ] [ ] [ length iota reverse ] tri ;
+
: unbox-parameters ( offset node -- )
- parameters>> [
- %prepare-unbox [ over + ] dip unbox-parameter
- ] reverse-each-parameter drop ;
+ parameters>> swap
+ '[ prepare-unbox-parameters [ %prepare-unbox [ _ + ] dip unbox-parameter ] 3each ]
+ [ length neg %inc-d ]
+ bi ;
: prepare-box-struct ( node -- offset )
#! Return offset on C stack where to store unboxed
] if ;
: stdcall-mangle ( symbol params -- symbol )
- parameters>> parameter-sizes drop number>string "@" glue ;
+ parameters>> parameter-offsets drop number>string "@" glue ;
: alien-invoke-dlsym ( params -- symbols dll )
[ [ function>> dup ] keep stdcall-mangle 2array ]
! If t, all int parameters are shadowed by dummy FP parameters
HOOK: dummy-fp-params? cpu ( -- ? )
-HOOK: %prepare-unbox cpu ( -- )
+HOOK: %prepare-unbox cpu ( n -- )
HOOK: %unbox cpu ( n rep func -- )
M:: ppc %load-param-reg ( stack reg rep -- )
reg stack local@ rep load-from-frame ;
-M: ppc %prepare-unbox ( -- )
- ! First parameter is top of stack
- 3 ds-reg 0 LWZ
- ds-reg dup cell SUBI ;
+M: ppc %prepare-unbox ( n -- )
+ [ 3 ] dip <ds-loc> loc>operand LWZ ;
M: ppc %unbox ( n rep func -- )
! Value must be in r3
M: x86.32 stack-reg ESP ;
M: x86.32 temp-reg ECX ;
+: local@ ( n -- op )
+ stack-frame get extra-stack-space dup 16 assert= + stack@ ;
+
+M: x86.32 extra-stack-space calls-vm?>> 16 0 ? ;
+
M: x86.32 %mark-card
drop HEX: ffffffff [+] card-mark <byte> MOV
building get pop
M: x86.32 pic-tail-reg EBX ;
-M: x86.32 reserved-area-size 0 ;
+M: x86.32 reserved-stack-space 4 cells ;
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
-: push-vm-ptr ( -- )
- 0 PUSH 0 rc-absolute-cell rel-vm ; ! push the vm ptr as an argument
+: save-vm-ptr ( n -- )
+ stack@ 0 MOV 0 rc-absolute-cell rel-vm ;
M: x86.32 return-struct-in-registers? ( c-type -- ? )
c-type
and or ;
: struct-return@ ( n -- operand )
- [ next-stack@ ] [ stack-frame get params>> stack@ ] if* ;
+ [ next-stack@ ] [ stack-frame get params>> local@ ] if* ;
! On x86, parameters are never passed in registers.
M: int-regs return-reg drop EAX ;
M: int-regs param-regs drop { } ;
M: float-regs param-regs drop { } ;
-GENERIC: push-return-reg ( rep -- )
-GENERIC: load-return-reg ( n rep -- )
-GENERIC: store-return-reg ( n rep -- )
-
-M: int-rep push-return-reg drop EAX PUSH ;
-M: int-rep load-return-reg drop EAX swap next-stack@ MOV ;
-M: int-rep store-return-reg drop stack@ EAX MOV ;
-
-M: float-rep push-return-reg drop ESP 4 SUB ESP [] FSTPS ;
-M: float-rep load-return-reg drop next-stack@ FLDS ;
-M: float-rep store-return-reg drop stack@ FSTPS ;
+GENERIC: load-return-reg ( src rep -- )
+GENERIC: store-return-reg ( dst rep -- )
-M: double-rep push-return-reg drop ESP 8 SUB ESP [] FSTPL ;
-M: double-rep load-return-reg drop next-stack@ FLDL ;
-M: double-rep store-return-reg drop stack@ FSTPL ;
+M: int-rep load-return-reg drop EAX swap MOV ;
+M: int-rep store-return-reg drop EAX MOV ;
-: align-sub ( n -- )
- [ align-stack ] keep - decr-stack-reg ;
+M: float-rep load-return-reg drop FLDS ;
+M: float-rep store-return-reg drop FSTPS ;
-: align-add ( n -- )
- align-stack incr-stack-reg ;
-
-: with-aligned-stack ( n quot -- )
- '[ align-sub @ ] [ align-add ] bi ; inline
+M: double-rep load-return-reg drop FLDL ;
+M: double-rep store-return-reg drop FSTPL ;
M: x86.32 %prologue ( n -- )
dup PUSH
0 PUSH rc-absolute-cell rel-this
3 cells - decr-stack-reg ;
-M: x86.32 %load-param-reg 3drop ;
+M: x86.32 %load-param-reg
+ stack-params assert=
+ [ [ EAX ] dip local@ MOV ] dip
+ stack@ EAX MOV ;
M: x86.32 %save-param-reg 3drop ;
#! are boxing a return value of a C function. If n is an
#! integer, push [ESP+n] on the stack; we are boxing a
#! parameter being passed to a callback from C.
- over [ load-return-reg ] [ 2drop ] if ;
+ over [ [ next-stack@ ] dip load-return-reg ] [ 2drop ] if ;
M:: x86.32 %box ( n rep func -- )
n rep (%box)
- rep rep-size cell + [
- push-vm-ptr
- rep push-return-reg
- func f %alien-invoke
- ] with-aligned-stack ;
-
+ rep rep-size save-vm-ptr
+ 0 stack@ rep store-return-reg
+ func f %alien-invoke ;
+
: (%box-long-long) ( n -- )
[
EDX over next-stack@ MOV
M: x86.32 %box-long-long ( n func -- )
[ (%box-long-long) ] dip
- 12 [
- push-vm-ptr
- EDX PUSH
- EAX PUSH
- f %alien-invoke
- ] with-aligned-stack ;
+ 8 save-vm-ptr
+ 4 stack@ EDX MOV
+ 0 stack@ EAX MOV
+ f %alien-invoke ;
M:: x86.32 %box-large-struct ( n c-type -- )
- ! Compute destination address
EDX n struct-return@ LEA
- 12 [
- push-vm-ptr
- ! Push struct size
- c-type heap-size PUSH
- ! Push destination address
- EDX PUSH
- ! Copy the struct from the C stack
- "box_value_struct" f %alien-invoke
- ] with-aligned-stack ;
+ 8 save-vm-ptr
+ 4 stack@ c-type heap-size MOV
+ 0 stack@ EDX MOV
+ "box_value_struct" f %alien-invoke ;
M: x86.32 %prepare-box-struct ( -- )
! Compute target address for value struct return
EAX f struct-return@ LEA
! Store it as the first parameter
- 0 stack@ EAX MOV ;
+ 0 local@ EAX MOV ;
M: x86.32 %box-small-struct ( c-type -- )
#! Box a <= 8-byte struct returned in EAX:EDX. OS X only.
- 16 [
- push-vm-ptr
- heap-size PUSH
- EDX PUSH
- EAX PUSH
- "box_small_struct" f %alien-invoke
- ] with-aligned-stack ;
+ 12 save-vm-ptr
+ 8 stack@ swap heap-size MOV
+ 4 stack@ EDX MOV
+ 0 stack@ EAX MOV
+ "box_small_struct" f %alien-invoke ;
M: x86.32 %prepare-unbox ( -- )
- #! Move top of data stack to EAX.
- EAX ESI [] MOV
- ESI 4 SUB ;
+ EAX swap ds-reg reg-stack MOV ;
: call-unbox-func ( func -- )
- 8 [
- ! push the vm ptr as an argument
- push-vm-ptr
- ! Push parameter
- EAX PUSH
- ! Call the unboxer
- f %alien-invoke
- ] with-aligned-stack ;
+ 4 save-vm-ptr
+ 0 stack@ EAX MOV
+ f %alien-invoke ;
M: x86.32 %unbox ( n rep func -- )
#! The value being unboxed must already be in EAX.
#! a parameter to a C function about to be called.
call-unbox-func
! Store the return value on the C stack
- over [ store-return-reg ] [ 2drop ] if ;
+ over [ [ local@ ] dip store-return-reg ] [ 2drop ] if ;
M: x86.32 %unbox-long-long ( n func -- )
call-unbox-func
! Store the return value on the C stack
[
- dup stack@ EAX MOV
- cell + stack@ EDX MOV
+ [ local@ EAX MOV ]
+ [ 4 + local@ EDX MOV ] bi
] when* ;
: %unbox-struct-1 ( -- )
#! Alien must be in EAX.
- 8 [
- push-vm-ptr
- EAX PUSH
- "alien_offset" f %alien-invoke
- ! Load first cell
- EAX EAX [] MOV
- ] with-aligned-stack ;
+ 4 save-vm-ptr
+ 0 stack@ EAX MOV
+ "alien_offset" f %alien-invoke
+ ! Load first cell
+ EAX EAX [] MOV ;
: %unbox-struct-2 ( -- )
#! Alien must be in EAX.
- 8 [
- push-vm-ptr
- EAX PUSH
- "alien_offset" f %alien-invoke
- ! Load second cell
- EDX EAX 4 [+] MOV
- ! Load first cell
- EAX EAX [] MOV
- ] with-aligned-stack ;
+ 4 save-vm-ptr
+ 0 stack@ EAX MOV
+ "alien_offset" f %alien-invoke
+ ! Load second cell
+ EDX EAX 4 [+] MOV
+ ! Load first cell
+ EAX EAX [] MOV ;
M: x86 %unbox-small-struct ( size -- )
#! Alien must be in EAX.
M:: x86.32 %unbox-large-struct ( n c-type -- )
! Alien must be in EAX.
! Compute destination address
- EDX n stack@ LEA
- 16 [
- push-vm-ptr
- ! Push struct size
- c-type heap-size PUSH
- ! Push destination address
- EDX PUSH
- ! Push source address
- EAX PUSH
- ! Copy the struct to the stack
- "to_value_struct" f %alien-invoke
- ] with-aligned-stack ;
+ EDX n local@ LEA
+ 12 save-vm-ptr
+ 8 stack@ c-type heap-size MOV
+ 4 stack@ EDX MOV
+ 0 stack@ EAX MOV
+ "to_value_struct" f %alien-invoke ;
M: x86.32 %nest-stacks ( -- )
! Save current frame. See comment in vm/contexts.hpp
EAX stack-reg stack-frame get total-size>> 3 cells - [+] LEA
- 8 [
- push-vm-ptr
- EAX PUSH
- "nest_stacks" f %alien-invoke
- ] with-aligned-stack ;
+ 4 save-vm-ptr
+ 0 stack@ EAX MOV
+ "nest_stacks" f %alien-invoke ;
M: x86.32 %unnest-stacks ( -- )
- 4 [
- push-vm-ptr
- "unnest_stacks" f %alien-invoke
- ] with-aligned-stack ;
+ 0 save-vm-ptr
+ "unnest_stacks" f %alien-invoke ;
M: x86.32 %prepare-alien-indirect ( -- )
- 4 [
- push-vm-ptr
- "unbox_alien" f %alien-invoke
- ] with-aligned-stack
+ 0 save-vm-ptr
+ "unbox_alien" f %alien-invoke
EBP EAX MOV ;
M: x86.32 %alien-indirect ( -- )
EBP CALL ;
M: x86.32 %alien-callback ( quot -- )
+ ! Fastcall
param-reg-1 swap %load-reference
param-reg-2 %mov-vm-ptr
"c_to_factor" f %alien-invoke ;
M: x86.32 %callback-value ( ctype -- )
- ! Align C stack
- ESP 12 SUB
- ! Save top of data stack in non-volatile register
- %prepare-unbox
- EAX PUSH
- push-vm-ptr
+ 0 %prepare-unbox
+ 4 stack@ EAX MOV
+ 0 save-vm-ptr
! Restore data/call/retain stacks
"unnest_stacks" f %alien-invoke
- ! Place top of data stack in EAX
- temp-reg POP
- EAX POP
- ! Restore C stack
- ESP 12 ADD
+ ! Place former top of data stack back in EAX
+ EAX 4 stack@ MOV
! Unbox EAX
unbox-return ;
} cond RET ;
M:: x86.32 %call-gc ( gc-root-count temp -- )
- temp gc-root-base param@ LEA
- 12 [
- ! Pass the VM ptr as the third parameter
- push-vm-ptr
- ! Pass number of roots as second parameter
- gc-root-count PUSH
- ! Pass pointer to start of GC roots as first parameter
- temp PUSH
- ! Call GC
- "inline_gc" f %alien-invoke
- ] with-aligned-stack ;
+ temp gc-root-base special@ LEA
+ 8 save-vm-ptr
+ 4 stack@ gc-root-count MOV
+ 0 stack@ temp MOV
+ "inline_gc" f %alien-invoke ;
M: x86.32 dummy-stack-params? f ;
M: x86.32 dummy-fp-params? f ;
+! Dreadful
+M: object flatten-value-type (flatten-int-type) ;
+
os windows? [
- cell "longlong" c-type (>>align)
- cell "ulonglong" c-type (>>align)
- 4 "double" c-type (>>align)
+ cell longlong c-type (>>align)
+ cell ulonglong c-type (>>align)
+ 4 double c-type (>>align)
] unless
check-sse
cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 cpu.architecture ;
IN: cpu.x86.64
+: param-reg-1 ( -- reg ) int-regs param-regs first ; inline
+: param-reg-2 ( -- reg ) int-regs param-regs second ; inline
+: param-reg-3 ( -- reg ) int-regs param-regs third ; inline
+: param-reg-4 ( -- reg ) int-regs param-regs fourth ; inline
+
+M: x86.64 pic-tail-reg RBX ;
+
+M: int-regs return-reg drop RAX ;
+M: float-regs return-reg drop XMM0 ;
+
+M: x86.64 ds-reg R14 ;
+M: x86.64 rs-reg R15 ;
+M: x86.64 stack-reg RSP ;
+
+M: x86.64 extra-stack-space drop 0 ;
+
M: x86.64 machine-registers
{
{ int-regs { RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 R13 } }
} }
} ;
-M: x86.64 ds-reg R14 ;
-M: x86.64 rs-reg R15 ;
-M: x86.64 stack-reg RSP ;
+: param@ ( n -- op ) reserved-stack-space + stack@ ;
+
+M: x86.64 %prologue ( n -- )
+ temp-reg 0 MOV rc-absolute-cell rel-this
+ dup PUSH
+ temp-reg PUSH
+ stack-reg swap 3 cells - SUB ;
: load-cards-offset ( dst -- )
0 MOV rc-absolute-cell rel-cards-offset ;
[ align-code ]
bi ;
-: param-reg-1 ( -- reg ) int-regs param-regs first ; inline
-: param-reg-2 ( -- reg ) int-regs param-regs second ; inline
-: param-reg-3 ( -- reg ) int-regs param-regs third ; inline
-: param-reg-4 ( -- reg ) int-regs param-regs fourth ; inline
-
-M: x86.64 pic-tail-reg RBX ;
-
-M: int-regs return-reg drop RAX ;
-M: float-regs return-reg drop XMM0 ;
-
-M: x86.64 %prologue ( n -- )
- temp-reg 0 MOV rc-absolute-cell rel-this
- dup PUSH
- temp-reg PUSH
- stack-reg swap 3 cells - SUB ;
-
M: stack-params copy-register*
drop
{
call
] with-scope ; inline
-M: x86.64 %prepare-unbox ( -- )
- ! First parameter is top of stack
- param-reg-1 R14 [] MOV
- R14 cell SUB ;
+M: x86.64 %prepare-unbox ( n -- )
+ param-reg-1 swap ds-reg reg-stack MOV ;
M:: x86.64 %unbox ( n rep func -- )
param-reg-2 %mov-vm-ptr
"c_to_factor" f %alien-invoke ;
M: x86.64 %callback-value ( ctype -- )
- ! Save top of data stack
- %prepare-unbox
- ! Save top of data stack
+ 0 %prepare-unbox
RSP 8 SUB
param-reg-1 PUSH
param-reg-1 %mov-vm-ptr
M: float-regs param-regs
drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
-M: x86.64 reserved-area-size 0 ;
+M: x86.64 reserved-stack-space 0 ;
SYMBOL: (stack-value)
! The ABI for passing structs by value is pretty great
M: float-regs param-regs drop { XMM0 XMM1 XMM2 XMM3 } ;
-M: x86.64 reserved-area-size 4 cells ;
+M: x86.64 reserved-stack-space 4 cells ;
M: x86.64 return-struct-in-registers? ( c-type -- ? )
heap-size { 1 2 4 8 } member? ;
HOOK: stack-reg cpu ( -- reg )
-HOOK: reserved-area-size cpu ( -- n )
+HOOK: reserved-stack-space cpu ( -- n )
+
+HOOK: extra-stack-space cpu ( stack-frame -- n )
: stack@ ( n -- op ) stack-reg swap [+] ;
-: param@ ( n -- op ) reserved-area-size + stack@ ;
+: special@ ( n -- op )
+ stack-frame get extra-stack-space +
+ reserved-stack-space +
+ stack@ ;
-: spill@ ( n -- op ) spill-offset param@ ;
+: spill@ ( n -- op ) spill-offset special@ ;
-: gc-root@ ( n -- op ) gc-root-offset param@ ;
+: gc-root@ ( n -- op ) gc-root-offset special@ ;
: decr-stack-reg ( n -- )
dup 0 = [ drop ] [ stack-reg swap SUB ] if ;
os macosx? cpu x86.64? or [ 16 align ] when ;
M: x86 stack-frame-size ( stack-frame -- i )
- (stack-frame-size) 3 cells reserved-area-size + + align-stack ;
+ [ (stack-frame-size) ]
+ [ extra-stack-space ] bi +
+ reserved-stack-space +
+ 3 cells +
+ align-stack ;
! Must be a volatile register not used for parameter passing, for safe
! use in calls in and out of C
[ ] [ "article-index" print-topic ] unit-test
[ ] [ "primitive-index" print-topic ] unit-test
[ ] [ "error-index" print-topic ] unit-test
-[ ] [ "type-index" print-topic ] unit-test
[ ] [ "class-index" print-topic ] unit-test
ARTICLE: "error-index" "Error index"
{ $index [ all-errors ] } ;
-ARTICLE: "type-index" "Type index"
-{ $index [ builtins get sift ] } ;
-
ARTICLE: "class-index" "Class index"
{ $heading "Built-in classes" }
{ $index [ classes [ builtin-class? ] filter ] }
"article-index"
"primitive-index"
"error-index"
- "type-index"
"class-index"
}
{ $heading "Explore the code base" }
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays alien.c-types assocs kernel sequences math math.functions
-hints math.order math.libm fry combinators byte-arrays accessors
-locals ;
+hints math.order math.libm math.floats.private fry combinators
+byte-arrays accessors locals ;
QUALIFIED-WITH: alien.c-types c
IN: math.vectors
: [v-] ( u v -- w ) [ [-] ] 2map ;
: v* ( u v -- w ) [ * ] 2map ;
: v/ ( u v -- w ) [ / ] 2map ;
-: vmax ( u v -- w ) [ max ] 2map ;
-: vmin ( u v -- w ) [ min ] 2map ;
+
+<PRIVATE
+
+: if-both-floats ( x y p q -- )
+ [ 2dup [ float? ] both? ] 2dip if ; inline
+
+PRIVATE>
+
+: vmax ( u v -- w ) [ [ float-max ] [ max ] if-both-floats ] 2map ;
+: vmin ( u v -- w ) [ [ float-min ] [ min ] if-both-floats ] 2map ;
: v+- ( u v -- w )
[ t ] 2dip
! If the C type doesn't exist, don't generate a vocab
SYMBOL: __does_not_exist__
-[ ] [
- [ __does_not_exist__ specialized-array-vocab forget-vocab ] with-compilation-unit
-] unit-test
-
[
"""
IN: specialized-arrays.tests
deferred?
] unit-test
-[ \ __does_not_exist__ forget ] with-compilation-unit
+[ ] [
+ [
+ \ __does_not_exist__ forget
+ __does_not_exist__ specialized-array-vocab forget-vocab
+ ] with-compilation-unit
+] unit-test
USING: accessors assocs arrays kernel models monads sequences
models.combinators ui.gadgets ui.gadgets.borders ui.gadgets.buttons
-ui.gadgets.buttons.private ui.gadgets.editors words images.loader
-ui.gadgets.scrollers ui.images vocabs.parser lexer
+ui.gadgets.buttons.private ui.gadgets.editors ui.gadgets.editors.private
+words images.loader ui.gadgets.scrollers ui.images vocabs.parser lexer
models.range ui.gadgets.sliders ;
QUALIFIED-WITH: ui.gadgets.sliders slider
QUALIFIED-WITH: ui.gadgets.tables tbl
projects / factor.git / commitdiff