Revert "factor: vocab:word -> vocab::word"

This reverts commit 354f1cbd34.
modern-harvey2
Doug Coleman 2018-08-02 08:21:52 -04:00
parent ac58033aff
commit 924b434336
170 changed files with 2312 additions and 2273 deletions

View File

@ -11,10 +11,10 @@ INLINE-FUNCTOR: complex-type ( n: existing-word t: name -- ) [[
STRUCT: ${t} { real ${n} } { imaginary ${n} } ;
: <${t}> ( z -- alien )
math::>rect ${t} <struct-boa> >c-ptr ;
math:>rect ${t} <struct-boa> >c-ptr ;
: *${t} ( alien -- z )
${t} memory>struct [ real>> ] [ imaginary>> ] bi math::rect> ; inline
${t} memory>struct [ real>> ] [ imaginary>> ] bi math:rect> ; inline
>>

View File

@ -4,28 +4,28 @@ specialized-arrays.private system tools.test vocabs ;
QUALIFIED-WITH: alien.c-types c
IN: alien.data.tests
{ -1 } [ -1 c::char <ref> c::char deref ] unit-test
{ -1 } [ -1 c::short <ref> c::short deref ] unit-test
{ -1 } [ -1 c::int <ref> c::int deref ] unit-test
{ -1 } [ -1 c:char <ref> c:char deref ] unit-test
{ -1 } [ -1 c:short <ref> c:short deref ] unit-test
{ -1 } [ -1 c:int <ref> c:int deref ] unit-test
! I don't care if this throws an error or works, but at least
! it should be consistent between platforms
{ -1 } [ -1.0 c::int <ref> c::int deref ] unit-test
{ -1 } [ -1.0 c::long <ref> c::long deref ] unit-test
{ -1 } [ -1.0 c::longlong <ref> c::longlong deref ] unit-test
{ 1 } [ 1.0 c::uint <ref> c::uint deref ] unit-test
{ 1 } [ 1.0 c::ulong <ref> c::ulong deref ] unit-test
{ 1 } [ 1.0 c::ulonglong <ref> c::ulonglong deref ] unit-test
{ -1 } [ -1.0 c:int <ref> c:int deref ] unit-test
{ -1 } [ -1.0 c:long <ref> c:long deref ] unit-test
{ -1 } [ -1.0 c:longlong <ref> c:longlong deref ] unit-test
{ 1 } [ 1.0 c:uint <ref> c:uint deref ] unit-test
{ 1 } [ 1.0 c:ulong <ref> c:ulong deref ] unit-test
{ 1 } [ 1.0 c:ulonglong <ref> c:ulonglong deref ] unit-test
[
0 B{ 1 2 3 4 } <displaced-alien> c::void* <ref>
0 B{ 1 2 3 4 } <displaced-alien> c:void* <ref>
] must-fail
os windows? cpu x86.64? and [
[ -2147467259 ] [ 2147500037 c::long <ref> c::long deref ] unit-test
[ -2147467259 ] [ 2147500037 c:long <ref> c:long deref ] unit-test
] when
STRUCT: foo { a c::int } { b c::void* } { c c::bool } ;
STRUCT: foo { a c:int } { b c:void* } { c c:bool } ;
SPECIALIZED-ARRAY: foo

View File

@ -175,5 +175,5 @@ GENERIC: binary-zero? ( value -- ? )
M: object binary-zero? drop f ; inline
M: f binary-zero? drop t ; inline
M: integer binary-zero? zero? ; inline
M: math::float binary-zero? double>bits zero? ; inline
M: math:float binary-zero? double>bits zero? ; inline
M: complex binary-zero? >rect [ binary-zero? ] both? ; inline

View File

@ -12,7 +12,7 @@ ERROR: invalid-signed-conversion n ;
: convert-signed-quot ( n -- quot )
{
{ 1 [ [ char <ref> char deref ] ] }
{ 2 [ [ c::short <ref> c::short deref ] ] }
{ 2 [ [ c:short <ref> c:short deref ] ] }
{ 4 [ [ int <ref> int deref ] ] }
{ 8 [ [ longlong <ref> longlong deref ] ] }
[ invalid-signed-conversion ]
@ -47,7 +47,7 @@ ERROR: unknown-endian-c-type symbol ;
: endian-c-type>c-type-symbol ( symbol -- symbol' )
{
{ [ dup { ule16 ube16 } member? ] [ drop ushort ] }
{ [ dup { le16 be16 } member? ] [ drop c::short ] }
{ [ dup { le16 be16 } member? ] [ drop c:short ] }
{ [ dup { ule32 ube32 } member? ] [ drop uint ] }
{ [ dup { le32 be32 } member? ] [ drop int ] }
{ [ dup { ule64 ube64 } member? ] [ drop ulonglong ] }
@ -122,7 +122,7 @@ ERROR: unsupported-endian-type endian slot ;
{ [ dup bool = ] [ 2drop bool ] }
{ [ dup char = ] [ 2drop char ] }
{ [ dup uchar = ] [ 2drop uchar ] }
{ [ dup c::short = ] [ { le16 be16 } endian-slot ] }
{ [ dup c:short = ] [ { le16 be16 } endian-slot ] }
{ [ dup ushort = ] [ { ule16 ube16 } endian-slot ] }
{ [ dup int = ] [ { le32 be32 } endian-slot ] }
{ [ dup uint = ] [ { ule32 ube32 } endian-slot ] }

View File

@ -137,7 +137,7 @@ STRUCT: struct-test-bar
[ struct-test-foo struct-definer-word ] unit-test
UNION-STRUCT: struct-test-float-and-bits
{ f c::float }
{ f c:float }
{ bits uint } ;
{ 1.0 } [ struct-test-float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test
@ -229,7 +229,7 @@ UNION-STRUCT: struct-test-float-and-bits
T{ struct-slot-spec
{ name "f" }
{ offset 0 }
{ type c::float }
{ type c:float }
{ class float }
{ initial 0.0 }
}
@ -478,11 +478,11 @@ STRUCT: silly-array-field-test { x int*[3] } ;
! Packed structs
PACKED-STRUCT: packed-struct-test
{ d c::int }
{ e c::short }
{ f c::int }
{ g c::char }
{ h c::int } ;
{ d c:int }
{ e c:short }
{ f c:int }
{ g c:char }
{ h c:int } ;
{ 15 } [ packed-struct-test heap-size ] unit-test
@ -495,9 +495,9 @@ PACKED-STRUCT: packed-struct-test
{ postpone: \PACKED-STRUCT: }
[ packed-struct-test struct-definer-word ] unit-test
STRUCT: struct-1 { a c::int } ;
PACKED-STRUCT: struct-1-packed { a c::int } ;
UNION-STRUCT: struct-1-union { a c::int } ;
STRUCT: struct-1 { a c:int } ;
PACKED-STRUCT: struct-1-packed { a c:int } ;
UNION-STRUCT: struct-1-union { a c:int } ;
{ "USING: alien.c-types classes.struct ;
IN: classes.struct.tests

View File

@ -21,8 +21,9 @@ SYNTAX: \?send:
suffix! \ send suffix! ;
SYNTAX: \selector:
scan-token unescape-token dup remember-send
<selector> suffix! \ cocoa.messages::selector suffix! ;
scan-token unescape-token
[ remember-send ]
[ <selector> suffix! \ cocoa.messages:selector suffix! ] bi ;
SYMBOL: super-sent-messages

View File

@ -111,17 +111,17 @@ class-init-hooks [ H{ } clone ] initialize
SYMBOL: objc>alien-types
H{
{ "c" c::char }
{ "i" c::int }
{ "s" c::short }
{ "C" c::uchar }
{ "I" c::uint }
{ "S" c::ushort }
{ "f" c::float }
{ "d" c::double }
{ "B" c::bool }
{ "v" c::void }
{ "*" c::void* }
{ "c" c:char }
{ "i" c:int }
{ "s" c:short }
{ "C" c:uchar }
{ "I" c:uint }
{ "S" c:ushort }
{ "f" c:float }
{ "d" c:double }
{ "B" c:bool }
{ "v" c:void }
{ "*" c:void* }
{ "?" unknown_type }
{ "@" id }
{ "#" Class }
@ -129,10 +129,10 @@ H{
}
cell {
{ 4 [ H{
{ "l" c::long }
{ "q" c::longlong }
{ "L" c::ulong }
{ "Q" c::ulonglong }
{ "l" c:long }
{ "q" c:longlong }
{ "L" c:ulong }
{ "Q" c:ulonglong }
} ] }
{ 8 [ H{
{ "l" long32 }

View File

@ -125,13 +125,13 @@ SYMBOL: ac-counter
] [ vreg kill-computed-set-slot ] if ;
: init-alias-analysis ( -- )
H{ } clone vregs>acs namespaces::set
H{ } clone acs>vregs namespaces::set
H{ } clone live-slots namespaces::set
H{ } clone copies namespaces::set
H{ } clone recent-stores namespaces::set
HS{ } clone dead-stores namespaces::set
0 ac-counter namespaces::set ;
H{ } clone vregs>acs namespaces:set
H{ } clone acs>vregs namespaces:set
H{ } clone live-slots namespaces:set
H{ } clone copies namespaces:set
H{ } clone recent-stores namespaces:set
HS{ } clone dead-stores namespaces:set
0 ac-counter namespaces:set ;
GENERIC: insn-slot# ( insn -- slot#/f )
GENERIC: insn-object ( insn -- vreg )
@ -255,7 +255,7 @@ M: insn eliminate-dead-stores drop t ;
copies get clear-assoc
dead-stores get clear-set
next-ac heap-ac namespaces::set
next-ac heap-ac namespaces:set
##vm-field set-new-ac
##alien-global set-new-ac ;

View File

@ -85,8 +85,8 @@ SYMBOL: visited
[ worklist get push-front ] [ drop ] if ;
: init-worklist ( cfg -- )
<dlist> worklist namespaces::set
HS{ } clone visited namespaces::set
<dlist> worklist namespaces:set
HS{ } clone visited namespaces:set
entry>> add-to-worklist ;
: split-branches ( cfg -- )

View File

@ -125,12 +125,12 @@ M: c-type box
{
{ "from_float" [ drop ] }
{ "from_double" [ drop ] }
{ "from_signed_1" [ drop c::char ^^convert-integer ] }
{ "from_unsigned_1" [ drop c::uchar ^^convert-integer ] }
{ "from_signed_2" [ drop c::short ^^convert-integer ] }
{ "from_unsigned_2" [ drop c::ushort ^^convert-integer ] }
{ "from_signed_4" [ drop c::int ^^convert-integer ] }
{ "from_unsigned_4" [ drop c::uint ^^convert-integer ] }
{ "from_signed_1" [ drop c:char ^^convert-integer ] }
{ "from_unsigned_1" [ drop c:uchar ^^convert-integer ] }
{ "from_signed_2" [ drop c:short ^^convert-integer ] }
{ "from_unsigned_2" [ drop c:ushort ^^convert-integer ] }
{ "from_signed_4" [ drop c:int ^^convert-integer ] }
{ "from_unsigned_4" [ drop c:uint ^^convert-integer ] }
{ "allot_alien" [ drop ^^box-alien ] }
[ swap <gc-map> ^^box ]
} case ;

View File

@ -57,13 +57,12 @@ M: dataflow-analysis join-sets 2drop assoc-refine ;
M: dataflow-analysis ignore-block? drop kill-block?>> ;
INLINE-FUNCTOR: dataflow-analysis ( name: name -- ) [[
USING: assocs namespaces ;
SINGLETON: ${name}
SYMBOL: ${name}-ins
: ${name}-in ( bb -- set ) ${name}-ins get at ;
SYMBOL: ${name}-outs
: ${name}-out ( bb -- set ) ${name}-outs get at ;
USING: assocs namespaces ;
SINGLETON: ${name}
SYMBOL: ${name}-ins
: ${name}-in ( bb -- set ) ${name}-ins get at ;
SYMBOL: ${name}-outs
: ${name}-out ( bb -- set ) ${name}-outs get at ;
]]
! ! ! Forward dataflow analysis
@ -76,16 +75,17 @@ M: forward-analysis successors drop successors>> ;
M: forward-analysis predecessors drop predecessors>> ;
INLINE-FUNCTOR: forward-analysis ( name: name -- ) [[
USING: assocs kernel namespaces ;
QUALIFIED: namespaces
USING: assocs kernel namespaces ;
QUALIFIED: namespaces
DATAFLOW-ANALYSIS: ${name}
DATAFLOW-ANALYSIS: ${name}
INSTANCE: ${name} forward-analysis
INSTANCE: ${name} forward-analysis
: compute-${name}-sets ( cfg -- )
\ ${name} run-dataflow-analysis
[ ${name}-ins namespaces:set ] [ ${name}-outs namespaces:set ] bi* ;
: compute-${name}-sets ( cfg -- )
\ ${name} run-dataflow-analysis
[ ${name}-ins namespaces::set ] [ ${name}-outs namespaces::set ] bi* ;
]]
! ! ! Backward dataflow analysis
@ -98,14 +98,15 @@ M: backward-analysis successors drop predecessors>> ;
M: backward-analysis predecessors drop successors>> ;
INLINE-FUNCTOR: backward-analysis ( name: name -- ) [[
USING: assocs kernel namespaces ;
QUALIFIED: namespaces
USING: assocs kernel namespaces ;
QUALIFIED: namespaces
DATAFLOW-ANALYSIS: ${name}
DATAFLOW-ANALYSIS: ${name}
INSTANCE: ${name} backward-analysis
INSTANCE: ${name} backward-analysis
: compute-${name}-sets ( cfg -- )
\ ${name} run-dataflow-analysis
[ ${name}-outs namespaces:set ] [ ${name}-ins namespaces:set ] bi* ;
: compute-${name}-sets ( cfg -- )
\ ${name} run-dataflow-analysis
[ ${name}-outs namespaces::set ] [ ${name}-ins namespaces::set ] bi* ;
]]

View File

@ -21,9 +21,9 @@ SYMBOL: allocations
allocations get in? ;
: init-dead-code ( -- )
H{ } clone liveness-graph namespaces::set
HS{ } clone live-vregs namespaces::set
HS{ } clone allocations namespaces::set ;
H{ } clone liveness-graph namespaces:set
HS{ } clone live-vregs namespaces:set
HS{ } clone allocations namespaces:set ;
GENERIC: build-liveness-graph ( insn -- )

View File

@ -110,7 +110,7 @@ SYMBOLS: defs insns ;
_ set-def-of
] with each
] simple-analysis
] keep defs namespaces::set ;
] keep defs namespaces:set ;
: compute-insns ( cfg -- )
H{ } clone [
@ -119,4 +119,4 @@ SYMBOLS: defs insns ;
dup _ set-def-of
] each
] simple-analysis
] keep insns namespaces::set ;
] keep insns namespaces:set ;

View File

@ -32,112 +32,112 @@ ERROR: inline-intrinsics-not-supported word quot ;
] assoc-each ;
{
{ kernel.private::tag [ drop emit-tag ] }
{ kernel.private::context-object [ emit-context-object ] }
{ kernel.private::special-object [ emit-special-object ] }
{ kernel.private::set-special-object [ emit-set-special-object ] }
{ kernel.private::(identity-hashcode) [ drop emit-identity-hashcode ] }
{ math.private::both-fixnums? [ drop emit-both-fixnums? ] }
{ math.private::fixnum+ [ drop emit-fixnum+ ] }
{ math.private::fixnum- [ drop emit-fixnum- ] }
{ math.private::fixnum* [ drop emit-fixnum* ] }
{ math.private::fixnum+fast [ drop [ ^^add ] binary-op ] }
{ math.private::fixnum-fast [ drop [ ^^sub ] binary-op ] }
{ math.private::fixnum*fast [ drop [ ^^mul ] binary-op ] }
{ math.private::fixnum-bitand [ drop [ ^^and ] binary-op ] }
{ math.private::fixnum-bitor [ drop [ ^^or ] binary-op ] }
{ math.private::fixnum-bitxor [ drop [ ^^xor ] binary-op ] }
{ math.private::fixnum-shift-fast [ emit-fixnum-shift-fast ] }
{ math.private::fixnum-bitnot [ drop [ ^^not ] unary-op ] }
{ math.private::fixnum< [ drop cc< emit-fixnum-comparison ] }
{ math.private::fixnum<= [ drop cc<= emit-fixnum-comparison ] }
{ math.private::fixnum>= [ drop cc>= emit-fixnum-comparison ] }
{ math.private::fixnum> [ drop cc> emit-fixnum-comparison ] }
{ kernel::eq? [ emit-eq ] }
{ slots.private::slot [ emit-slot ] }
{ slots.private::set-slot [ emit-set-slot ] }
{ strings.private::string-nth-fast [ drop emit-string-nth-fast ] }
{ strings.private::set-string-nth-fast [ drop emit-set-string-nth-fast ] }
{ classes.tuple.private::<tuple-boa> [ emit-<tuple-boa> ] }
{ arrays::<array> [ emit-<array> ] }
{ byte-arrays::<byte-array> [ emit-<byte-array> ] }
{ byte-arrays::(byte-array) [ emit-(byte-array) ] }
{ kernel::<wrapper> [ emit-simple-allot ] }
{ alien.data.private::(local-allot) [ emit-local-allot ] }
{ alien.data.private::(cleanup-allot) [ emit-cleanup-allot ] }
{ alien::<displaced-alien> [ emit-<displaced-alien> ] }
{ alien.accessors::alien-unsigned-1 [ int-rep alien.c-types::uchar emit-load-memory ] }
{ alien.accessors::set-alien-unsigned-1 [ int-rep alien.c-types::uchar emit-store-memory ] }
{ alien.accessors::alien-signed-1 [ int-rep alien.c-types::char emit-load-memory ] }
{ alien.accessors::set-alien-signed-1 [ int-rep alien.c-types::char emit-store-memory ] }
{ alien.accessors::alien-unsigned-2 [ int-rep alien.c-types::ushort emit-load-memory ] }
{ alien.accessors::set-alien-unsigned-2 [ int-rep alien.c-types::ushort emit-store-memory ] }
{ alien.accessors::alien-signed-2 [ int-rep alien.c-types::short emit-load-memory ] }
{ alien.accessors::set-alien-signed-2 [ int-rep alien.c-types::short emit-store-memory ] }
{ alien.accessors::alien-cell [ emit-alien-cell ] }
{ alien.accessors::set-alien-cell [ emit-set-alien-cell ] }
{ kernel.private:tag [ drop emit-tag ] }
{ kernel.private:context-object [ emit-context-object ] }
{ kernel.private:special-object [ emit-special-object ] }
{ kernel.private:set-special-object [ emit-set-special-object ] }
{ kernel.private:(identity-hashcode) [ drop emit-identity-hashcode ] }
{ math.private:both-fixnums? [ drop emit-both-fixnums? ] }
{ math.private:fixnum+ [ drop emit-fixnum+ ] }
{ math.private:fixnum- [ drop emit-fixnum- ] }
{ math.private:fixnum* [ drop emit-fixnum* ] }
{ math.private:fixnum+fast [ drop [ ^^add ] binary-op ] }
{ math.private:fixnum-fast [ drop [ ^^sub ] binary-op ] }
{ math.private:fixnum*fast [ drop [ ^^mul ] binary-op ] }
{ math.private:fixnum-bitand [ drop [ ^^and ] binary-op ] }
{ math.private:fixnum-bitor [ drop [ ^^or ] binary-op ] }
{ math.private:fixnum-bitxor [ drop [ ^^xor ] binary-op ] }
{ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast ] }
{ math.private:fixnum-bitnot [ drop [ ^^not ] unary-op ] }
{ math.private:fixnum< [ drop cc< emit-fixnum-comparison ] }
{ math.private:fixnum<= [ drop cc<= emit-fixnum-comparison ] }
{ math.private:fixnum>= [ drop cc>= emit-fixnum-comparison ] }
{ math.private:fixnum> [ drop cc> emit-fixnum-comparison ] }
{ kernel:eq? [ emit-eq ] }
{ slots.private:slot [ emit-slot ] }
{ slots.private:set-slot [ emit-set-slot ] }
{ strings.private:string-nth-fast [ drop emit-string-nth-fast ] }
{ strings.private:set-string-nth-fast [ drop emit-set-string-nth-fast ] }
{ classes.tuple.private:<tuple-boa> [ emit-<tuple-boa> ] }
{ arrays:<array> [ emit-<array> ] }
{ byte-arrays:<byte-array> [ emit-<byte-array> ] }
{ byte-arrays:(byte-array) [ emit-(byte-array) ] }
{ kernel:<wrapper> [ emit-simple-allot ] }
{ alien.data.private:(local-allot) [ emit-local-allot ] }
{ alien.data.private:(cleanup-allot) [ emit-cleanup-allot ] }
{ alien:<displaced-alien> [ emit-<displaced-alien> ] }
{ alien.accessors:alien-unsigned-1 [ int-rep alien.c-types:uchar emit-load-memory ] }
{ alien.accessors:set-alien-unsigned-1 [ int-rep alien.c-types:uchar emit-store-memory ] }
{ alien.accessors:alien-signed-1 [ int-rep alien.c-types:char emit-load-memory ] }
{ alien.accessors:set-alien-signed-1 [ int-rep alien.c-types:char emit-store-memory ] }
{ alien.accessors:alien-unsigned-2 [ int-rep alien.c-types:ushort emit-load-memory ] }
{ alien.accessors:set-alien-unsigned-2 [ int-rep alien.c-types:ushort emit-store-memory ] }
{ alien.accessors:alien-signed-2 [ int-rep alien.c-types:short emit-load-memory ] }
{ alien.accessors:set-alien-signed-2 [ int-rep alien.c-types:short emit-store-memory ] }
{ alien.accessors:alien-cell [ emit-alien-cell ] }
{ alien.accessors:set-alien-cell [ emit-set-alien-cell ] }
} enable-intrinsics
: enable-alien-4-intrinsics ( -- )
{
{ alien.accessors::alien-signed-4 [ int-rep alien.c-types::int emit-load-memory ] }
{ alien.accessors::set-alien-signed-4 [ int-rep alien.c-types::int emit-store-memory ] }
{ alien.accessors::alien-unsigned-4 [ int-rep alien.c-types::uint emit-load-memory ] }
{ alien.accessors::set-alien-unsigned-4 [ int-rep alien.c-types::uint emit-store-memory ] }
{ alien.accessors:alien-signed-4 [ int-rep alien.c-types:int emit-load-memory ] }
{ alien.accessors:set-alien-signed-4 [ int-rep alien.c-types:int emit-store-memory ] }
{ alien.accessors:alien-unsigned-4 [ int-rep alien.c-types:uint emit-load-memory ] }
{ alien.accessors:set-alien-unsigned-4 [ int-rep alien.c-types:uint emit-store-memory ] }
} enable-intrinsics ;
: enable-float-intrinsics ( -- )
{
{ math.private::float+ [ drop [ ^^add-float ] binary-op ] }
{ math.private::float- [ drop [ ^^sub-float ] binary-op ] }
{ math.private::float* [ drop [ ^^mul-float ] binary-op ] }
{ math.private::float/f [ drop [ ^^div-float ] binary-op ] }
{ math.private::float< [ drop cc< emit-float-ordered-comparison ] }
{ math.private::float<= [ drop cc<= emit-float-ordered-comparison ] }
{ math.private::float>= [ drop cc>= emit-float-ordered-comparison ] }
{ math.private::float> [ drop cc> emit-float-ordered-comparison ] }
{ math.private::float-u< [ drop cc< emit-float-unordered-comparison ] }
{ math.private::float-u<= [ drop cc<= emit-float-unordered-comparison ] }
{ math.private::float-u>= [ drop cc>= emit-float-unordered-comparison ] }
{ math.private::float-u> [ drop cc> emit-float-unordered-comparison ] }
{ math.private::float= [ drop cc= emit-float-unordered-comparison ] }
{ math.private::float>fixnum [ drop [ ^^float>integer ] unary-op ] }
{ math.private::fixnum>float [ drop [ ^^integer>float ] unary-op ] }
{ math.floats.private::float-unordered? [ drop cc/<>= emit-float-unordered-comparison ] }
{ alien.accessors::alien-float [ float-rep f emit-load-memory ] }
{ alien.accessors::set-alien-float [ float-rep f emit-store-memory ] }
{ alien.accessors::alien-double [ double-rep f emit-load-memory ] }
{ alien.accessors::set-alien-double [ double-rep f emit-store-memory ] }
{ math.private:float+ [ drop [ ^^add-float ] binary-op ] }
{ math.private:float- [ drop [ ^^sub-float ] binary-op ] }
{ math.private:float* [ drop [ ^^mul-float ] binary-op ] }
{ math.private:float/f [ drop [ ^^div-float ] binary-op ] }
{ math.private:float< [ drop cc< emit-float-ordered-comparison ] }
{ math.private:float<= [ drop cc<= emit-float-ordered-comparison ] }
{ math.private:float>= [ drop cc>= emit-float-ordered-comparison ] }
{ math.private:float> [ drop cc> emit-float-ordered-comparison ] }
{ math.private:float-u< [ drop cc< emit-float-unordered-comparison ] }
{ math.private:float-u<= [ drop cc<= emit-float-unordered-comparison ] }
{ math.private:float-u>= [ drop cc>= emit-float-unordered-comparison ] }
{ math.private:float-u> [ drop cc> emit-float-unordered-comparison ] }
{ math.private:float= [ drop cc= emit-float-unordered-comparison ] }
{ math.private:float>fixnum [ drop [ ^^float>integer ] unary-op ] }
{ math.private:fixnum>float [ drop [ ^^integer>float ] unary-op ] }
{ math.floats.private:float-unordered? [ drop cc/<>= emit-float-unordered-comparison ] }
{ alien.accessors:alien-float [ float-rep f emit-load-memory ] }
{ alien.accessors:set-alien-float [ float-rep f emit-store-memory ] }
{ alien.accessors:alien-double [ double-rep f emit-load-memory ] }
{ alien.accessors:set-alien-double [ double-rep f emit-store-memory ] }
} enable-intrinsics ;
: enable-fsqrt ( -- )
{
{ math.libm::fsqrt [ drop [ ^^sqrt ] unary-op ] }
{ math.libm:fsqrt [ drop [ ^^sqrt ] unary-op ] }
} enable-intrinsics ;
: enable-float-min/max ( -- )
{
{ math.floats.private::float-min [ drop [ ^^min-float ] binary-op ] }
{ math.floats.private::float-max [ drop [ ^^max-float ] binary-op ] }
{ math.floats.private:float-min [ drop [ ^^min-float ] binary-op ] }
{ math.floats.private:float-max [ drop [ ^^max-float ] binary-op ] }
} enable-intrinsics ;
: enable-min/max ( -- )
{
{ math.integers.private::fixnum-min [ drop [ ^^min ] binary-op ] }
{ math.integers.private::fixnum-max [ drop [ ^^max ] binary-op ] }
{ math.integers.private:fixnum-min [ drop [ ^^min ] binary-op ] }
{ math.integers.private:fixnum-max [ drop [ ^^max ] binary-op ] }
} enable-intrinsics ;
: enable-log2 ( -- )
{
{ math.integers.private::fixnum-log2 [ drop [ ^^log2 ] unary-op ] }
{ math.integers.private:fixnum-log2 [ drop [ ^^log2 ] unary-op ] }
} enable-intrinsics ;
: enable-bit-count ( -- )
{
{ math.bitwise.private::fixnum-bit-count [ drop [ ^^bit-count ] unary-op ] }
{ math.bitwise.private:fixnum-bit-count [ drop [ ^^bit-count ] unary-op ] }
} enable-intrinsics ;
: enable-bit-test ( -- )
{
{ math.integers.private::fixnum-bit? [ drop [ ^^bit-test ] binary-op ] }
{ math.integers.private:fixnum-bit? [ drop [ ^^bit-test ] binary-op ] }
} enable-intrinsics ;

View File

@ -99,7 +99,7 @@ RENAMING: assign "[ vreg>reg ]" "[ vreg>reg ]" "[ vreg>reg ]"
: begin-block ( bb -- )
{
[ basic-block set ]
[ basic-block namespaces:set ]
[ block-from unhandled-intervals get activate-new-intervals ]
[ compute-edge-live-in ]
[ compute-live-in ]
@ -110,7 +110,7 @@ RENAMING: assign "[ vreg>reg ]" "[ vreg>reg ]" "[ vreg>reg ]"
[ '[ [ _ bi@ ] assoc-map ] change-derived-roots drop ] 2bi ; inline
: spill-required? ( live-interval root-leaders n -- ? )
[ [ vreg>> ] dip sets::in? ] [ swap covers? ] bi-curry* bi or ;
[ [ vreg>> ] dip sets:in? ] [ swap covers? ] bi-curry* bi or ;
: spill-intervals ( root-leaders n -- live-intervals )
[ pending-interval-heap get heap-members ] 2dip
@ -160,12 +160,12 @@ RENAMING: assign "[ vreg>reg ]" "[ vreg>reg ]" "[ vreg>reg ]"
[ [ live-interval-start ] map ] keep zip >min-heap ;
: init-assignment ( live-intervals -- )
live-intervals>min-heap unhandled-intervals set
<min-heap> pending-interval-heap set
H{ } clone pending-interval-assoc set
H{ } clone machine-live-ins set
H{ } clone machine-edge-live-ins set
H{ } clone machine-live-outs set ;
live-intervals>min-heap unhandled-intervals namespaces:set
<min-heap> pending-interval-heap namespaces:set
H{ } clone pending-interval-assoc namespaces:set
H{ } clone machine-live-ins namespaces:set
H{ } clone machine-edge-live-ins namespaces:set
H{ } clone machine-live-outs namespaces:set ;
: assign-registers ( cfg live-intervals -- )
init-assignment

View File

@ -47,7 +47,7 @@ SYMBOLS: loop-heads visited ;
[ visited? ] reject ;
: (linearization-order) ( cfg -- bbs )
HS{ } clone visited namespaces::set
HS{ } clone visited namespaces:set
entry>> <dlist> [ push-back ] keep
[ dup '[ process-block _ push-all-back ] slurp-deque ] { } make ;

View File

@ -137,10 +137,10 @@ M: insn visit-insn 2drop ;
[ update-live-out/in ] keep predecessors>> { } ? ;
: init-liveness ( -- )
H{ } clone live-ins namespaces::set
H{ } clone edge-live-ins namespaces::set
H{ } clone live-outs namespaces::set
H{ } clone base-pointers namespaces::set ;
H{ } clone live-ins namespaces:set
H{ } clone edge-live-ins namespaces:set
H{ } clone live-outs namespaces:set
H{ } clone base-pointers namespaces:set ;
: compute-live-sets ( cfg -- )
init-liveness

View File

@ -55,13 +55,13 @@ SYMBOL: loop-nesting
: compute-loop-nesting ( -- )
loops get H{ } clone [
[ values ] dip '[ blocks>> members [ _ inc-at ] each ] each
] keep loop-nesting namespaces::set ;
] keep loop-nesting namespaces:set ;
: detect-loops ( cfg -- cfg' )
H{ } clone loops namespaces::set
HS{ } clone visited namespaces::set
HS{ } clone active namespaces::set
H{ } clone loop-nesting namespaces::set
H{ } clone loops namespaces:set
HS{ } clone visited namespaces:set
HS{ } clone active namespaces:set
H{ } clone loop-nesting namespaces:set
[ needs-predecessors ]
[ entry>> find-loop-headers process-loop-headers compute-loop-nesting ]
[ ] tri ;

View File

@ -39,8 +39,8 @@ M: vreg-insn (collect-vreg-reps)
M: insn (collect-vreg-reps) drop ;
: collect-vreg-reps ( cfg -- )
H{ } clone vreg-reps namespaces::set
HS{ } clone tagged-vregs namespaces::set
H{ } clone vreg-reps namespaces:set
HS{ } clone tagged-vregs namespaces:set
[ [ (collect-vreg-reps) ] each-non-phi ] each-basic-block ;
SYMBOL: possibilities
@ -52,7 +52,7 @@ SYMBOL: possibilities
: compute-possibilities ( cfg -- )
collect-vreg-reps
vreg-reps get [ possible-reps ] assoc-map possibilities namespaces::set ;
vreg-reps get [ possible-reps ] assoc-map possibilities namespaces:set ;
! For every vreg, compute the cost of keeping it in every possible
! representation.
@ -60,7 +60,7 @@ SYMBOL: possibilities
SYMBOL: costs
: init-costs ( -- )
possibilities get [ [ 0 ] H{ } map>assoc ] assoc-map costs namespaces::set ;
possibilities get [ [ 0 ] H{ } map>assoc ] assoc-map costs namespaces:set ;
: increase-cost ( rep scc factor -- )
[ costs get at 2dup key? ] dip
@ -122,7 +122,7 @@ M: vreg-insn compute-insn-costs
: compute-costs ( cfg -- )
init-costs
[
[ basic-block namespaces::set ]
[ basic-block namespaces:set ]
[ [ compute-insn-costs ] each-non-phi ] bi
] each-basic-block ;
@ -134,4 +134,4 @@ M: vreg-insn compute-insn-costs
compute-costs costs get minimize-costs
[ components get [ disjoint-set-members ] keep ] dip
'[ dup _ representative _ at ] H{ } map>assoc
representations namespaces::set ;
representations namespaces:set ;

View File

@ -33,7 +33,7 @@ IN: compiler.cfg.rpo
: optimize-basic-block ( bb quot -- )
over kill-block?>> [ 2drop ] [
over basic-block namespaces::set
over basic-block namespaces:set
change-instructions drop
] if ; inline
@ -42,7 +42,7 @@ IN: compiler.cfg.rpo
: analyze-basic-block ( bb quot -- )
over kill-block?>> [ 2drop ] [
[ dup basic-block namespaces::set instructions>> ] dip call
[ dup basic-block namespaces:set instructions>> ] dip call
] if ; inline
: simple-analysis ( ... cfg quot: ( ... insns -- ... ) -- ... )

View File

@ -27,8 +27,8 @@ M: vreg-insn compute-insn-defs
] with each ;
: compute-defs ( cfg -- )
H{ } clone defs namespaces::set
HS{ } clone defs-multi namespaces::set
H{ } clone defs namespaces:set
HS{ } clone defs-multi namespaces:set
[
[ basic-block get ] dip
[ compute-insn-defs ] with each
@ -46,7 +46,7 @@ SYMBOL: inserting-phis
members merge-set [ insert-phi-later ] with each ;
: compute-phis ( -- )
H{ } clone inserting-phis namespaces::set
H{ } clone inserting-phis namespaces:set
defs-multi get members
defs get '[ dup _ at compute-phis-for ] each ;
@ -57,9 +57,9 @@ SYMBOL: used-vregs
SYMBOLS: stacks pushed ;
: init-renaming ( -- )
H{ } clone phis namespaces::set
<hashed-dlist> used-vregs namespaces::set
H{ } clone stacks namespaces::set ;
H{ } clone phis namespaces:set
<hashed-dlist> used-vregs namespaces:set
H{ } clone stacks namespaces:set ;
: gen-name ( vreg -- vreg' )
[ next-vreg dup ] dip
@ -111,7 +111,7 @@ M: vreg-insn rename-insn
pushed get members stacks get '[ _ at pop* ] each ;
: rename-in-block ( bb -- )
HS{ } clone pushed namespaces::set
HS{ } clone pushed namespaces:set
{
[ rename-phis ]
[ rename-insns ]
@ -119,7 +119,7 @@ M: vreg-insn rename-insn
[
pushed get
[ dom-children [ rename-in-block ] each ] dip
pushed namespaces::set
pushed namespaces:set
]
} cleave
pop-stacks ;
@ -134,7 +134,7 @@ SYMBOL: live-phis
dst>> live-phis get in? ;
: compute-live-phis ( -- )
HS{ } clone live-phis namespaces::set
HS{ } clone live-phis namespaces:set
used-vregs get [
phis get at [
[

View File

@ -47,7 +47,7 @@ V{ } 6 test-bb
{ t } [
2 get 3 get 2array merge-set
4 get 6 get 2array sets::set=
4 get 6 get 2array sets:set=
] unit-test
V{ } 0 test-bb

View File

@ -16,14 +16,14 @@ SYMBOLS: merge-sets levels again? ;
: init-merge-sets ( cfg -- )
post-order dup length '[ _ <bit-set> ] H{ } map>assoc
merge-sets namespaces::set ;
merge-sets namespaces:set ;
: compute-levels ( cfg -- )
0 over entry>> associate [
'[
_ [ [ dom-parent ] dip at 1 + ] 2keep set-at
] each-basic-block
] keep levels namespaces::set ;
] keep levels namespaces:set ;
: j-edge? ( from to -- ? )
2dup eq? [ 2drop f ] [ dominates? not ] if ;

View File

@ -42,8 +42,8 @@ ERROR: vregs-shouldn't-interfere vreg1 vreg2 ;
defs get [ [ dup dup value-of ] dip <vreg-info> 1array ] assoc-map ;
: init-coalescing ( insns -- )
initial-leaders leader-map namespaces::set
initial-class-elements class-element-map namespaces::set ;
initial-leaders leader-map namespaces:set
initial-class-elements class-element-map namespaces:set ;
GENERIC: coalesce-now ( insn -- )

View File

@ -3,6 +3,7 @@ compiler.cfg.registers compiler.cfg.stacks.local
compiler.cfg.utilities compiler.test cpu.architecture kernel
kernel.private make math namespaces sequences.private slots.private
tools.test ;
QUALIFIED: sets
IN: compiler.cfg.stacks.local.tests
! end-local-analysis

View File

@ -72,8 +72,8 @@ SYMBOLS: locs>vregs local-peek-set replaces ;
: begin-local-analysis ( basic-block -- )
height-state [ clone ] change
height-state get [ reset-incs ] keep >>height drop
HS{ } clone local-peek-set namespaces::set
H{ } clone replaces namespaces::set ;
HS{ } clone local-peek-set namespaces:set
H{ } clone replaces namespaces:set ;
: remove-redundant-replaces ( replaces -- replaces' )
[ [ loc>vreg ] dip = ] assoc-reject ;

View File

@ -15,13 +15,13 @@ IN: compiler.cfg.stacks.padding
first2 swapd remove 2array ;
: combine-stacks ( stacks -- stack )
[ first first ] [ [ second ] map sets::combine ] bi 2array ;
[ first first ] [ [ second ] map sets:combine ] bi 2array ;
: classify-read ( stack n -- val )
swap 2dup second member? [ 2drop 2 ] [ first >= [ 1 ] [ 0 ] if ] if ;
: shift-stack ( n stack -- stack' )
first2 pick '[ _ + ] map [ 0 >= ] filter pick 0 max <iota> sets::union
first2 pick '[ _ + ] map [ 0 >= ] filter pick 0 max <iota> sets:union
[ + ] dip 2array ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -2887,14 +2887,14 @@ cpu x86? [
T{ ##peek f 1 d: 0 }
T{ ##tagged>integer f 2 1 }
T{ ##add-imm f 3 2 10 }
T{ ##load-memory-imm f 4 2 10 int-rep c::uchar }
T{ ##load-memory-imm f 4 2 10 int-rep c:uchar }
}
} [
V{
T{ ##peek f 1 d: 0 }
T{ ##tagged>integer f 2 1 }
T{ ##add-imm f 3 2 10 }
T{ ##load-memory-imm f 4 3 0 int-rep c::uchar }
T{ ##load-memory-imm f 4 3 0 int-rep c:uchar }
} value-numbering-step
] unit-test
@ -2905,7 +2905,7 @@ cpu x86? [
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##add-imm f 4 3 10 }
T{ ##store-memory-imm f 2 3 10 int-rep c::uchar }
T{ ##store-memory-imm f 2 3 10 int-rep c:uchar }
}
} [
V{
@ -2914,7 +2914,7 @@ cpu x86? [
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##add-imm f 4 3 10 }
T{ ##store-memory-imm f 2 4 0 int-rep c::uchar }
T{ ##store-memory-imm f 2 4 0 int-rep c:uchar }
} value-numbering-step
] unit-test
@ -2926,7 +2926,7 @@ cpu x86? [
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##add f 4 2 3 }
T{ ##load-memory f 5 2 3 0 0 int-rep c::uchar }
T{ ##load-memory f 5 2 3 0 0 int-rep c:uchar }
}
} [
V{
@ -2935,7 +2935,7 @@ cpu x86? [
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##add f 4 2 3 }
T{ ##load-memory-imm f 5 4 0 int-rep c::uchar }
T{ ##load-memory-imm f 5 4 0 int-rep c:uchar }
} value-numbering-step
] unit-test
@ -2946,7 +2946,7 @@ cpu x86? [
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##add f 4 2 3 }
T{ ##store-memory f 5 2 3 0 0 int-rep c::uchar }
T{ ##store-memory f 5 2 3 0 0 int-rep c:uchar }
}
} [
V{
@ -2955,7 +2955,7 @@ cpu x86? [
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##add f 4 2 3 }
T{ ##store-memory-imm f 5 4 0 int-rep c::uchar }
T{ ##store-memory-imm f 5 4 0 int-rep c:uchar }
} value-numbering-step
] unit-test
@ -2968,7 +2968,7 @@ cpu x86?
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##add-imm f 4 2 31337 }
T{ ##load-memory f 5 2 3 0 31337 int-rep c::uchar }
T{ ##load-memory f 5 2 3 0 31337 int-rep c:uchar }
}
]
[
@ -2978,7 +2978,7 @@ cpu x86?
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##add-imm f 4 2 31337 }
T{ ##load-memory f 5 4 3 0 0 int-rep c::uchar }
T{ ##load-memory f 5 4 3 0 0 int-rep c:uchar }
}
] ?
[
@ -2988,7 +2988,7 @@ cpu x86?
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##add-imm f 4 2 31337 }
T{ ##load-memory f 5 4 3 0 0 int-rep c::uchar }
T{ ##load-memory f 5 4 3 0 0 int-rep c:uchar }
} value-numbering-step
] unit-test
@ -3001,7 +3001,7 @@ cpu x86?
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##add-imm f 4 3 31337 }
T{ ##load-memory f 5 2 3 0 31338 int-rep c::uchar }
T{ ##load-memory f 5 2 3 0 31338 int-rep c:uchar }
}
]
[
@ -3011,7 +3011,7 @@ cpu x86?
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##add-imm f 4 3 31337 }
T{ ##load-memory f 5 2 4 0 1 int-rep c::uchar }
T{ ##load-memory f 5 2 4 0 1 int-rep c:uchar }
}
] ?
[
@ -3021,7 +3021,7 @@ cpu x86?
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##add-imm f 4 3 31337 }
T{ ##load-memory f 5 2 4 0 1 int-rep c::uchar }
T{ ##load-memory f 5 2 4 0 1 int-rep c:uchar }
} value-numbering-step
] unit-test
@ -3034,7 +3034,7 @@ cpu x86?
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##add-imm f 4 3 10 }
T{ ##load-memory f 5 2 4 1 1 int-rep c::uchar }
T{ ##load-memory f 5 2 4 1 1 int-rep c:uchar }
} dup value-numbering-step assert=
] unit-test
@ -3047,7 +3047,7 @@ ${
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##shl-imm f 4 3 2 }
T{ ##load-memory f 5 2 3 2 0 int-rep c::uchar }
T{ ##load-memory f 5 2 3 2 0 int-rep c:uchar }
}
V{
T{ ##peek f 0 d: 0 }
@ -3055,7 +3055,7 @@ ${
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##shl-imm f 4 3 2 }
T{ ##load-memory f 5 2 4 0 0 int-rep c::uchar }
T{ ##load-memory f 5 2 4 0 0 int-rep c:uchar }
} ?
} [
V{
@ -3064,7 +3064,7 @@ ${
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##shl-imm f 4 3 2 }
T{ ##load-memory f 5 2 4 0 0 int-rep c::uchar }
T{ ##load-memory f 5 2 4 0 0 int-rep c:uchar }
} value-numbering-step
] unit-test
@ -3077,7 +3077,7 @@ cpu x86? [
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##shl-imm f 4 3 2 }
T{ ##load-memory f 5 2 4 1 0 int-rep c::uchar }
T{ ##load-memory f 5 2 4 1 0 int-rep c:uchar }
} dup value-numbering-step assert=
] unit-test
@ -3089,7 +3089,7 @@ cpu x86? [
T{ ##tagged>integer f 2 0 }
T{ ##tagged>integer f 3 1 }
T{ ##shl-imm f 4 3 4 }
T{ ##load-memory f 5 2 4 0 0 int-rep c::uchar }
T{ ##load-memory f 5 2 4 0 0 int-rep c:uchar }
} dup value-numbering-step assert=
] unit-test
] when

View File

@ -54,9 +54,9 @@ M: ##copy eliminate-write-barrier
M: insn eliminate-write-barrier drop t ;
: write-barriers-step ( insns -- insns' )
HS{ } clone fresh-allocations namespaces::set
HS{ } clone mutated-objects namespaces::set
H{ } clone copies namespaces::set
HS{ } clone fresh-allocations namespaces:set
HS{ } clone mutated-objects namespaces:set
H{ } clone copies namespaces:set
[ eliminate-write-barrier ] filter! ;
: eliminate-write-barriers ( cfg -- )

View File

@ -55,7 +55,7 @@ M: fake-cpu gc-root-offset ;
uint-array{ 100 } underlying>> %
! GC info footer - 12 bytes
S{ vm::gc-info
S{ vm:gc-info
{ gc-root-count 4 }
{ derived-root-count 3 }
{ return-address-count 1 }

View File

@ -25,9 +25,9 @@ SYMBOL: compiled
: start-compilation ( word -- )
dup name>> compiler-message
H{ } clone dependencies namespaces::set
H{ } clone generic-dependencies namespaces::set
HS{ } clone conditional-dependencies namespaces::set
H{ } clone dependencies namespaces:set
H{ } clone generic-dependencies namespaces:set
HS{ } clone conditional-dependencies namespaces:set
clear-compiler-error ;
GENERIC: no-compile? ( word -- ? )

View File

@ -22,7 +22,7 @@ IN: compiler.tests.callstack-overflow
: overflow/w-primitive ( -- )
reset-dispatch-stats overflow/w-primitive post ;
: get-context ( -- ctx ) context vm::context memory>struct ;
: get-context ( -- ctx ) context vm:context memory>struct ;
: remaining-stack ( -- n )
get-context [ callstack-top>> ] [ callstack-seg>> start>> ] bi - ;

View File

@ -52,7 +52,7 @@ unit-test
[ 3 ]
[
global [ 3 \ foo set ] with-variables
\ foo [ global >n get namespaces.private::ndrop ] compile-call
\ foo [ global >n get namespaces.private:ndrop ] compile-call
] unit-test
: blech ( x -- ) drop ;
@ -66,7 +66,7 @@ unit-test
[ 3 ]
[
global [ 3 \ foo set ] with-variables
\ foo [ global [ get ] swap >n call namespaces.private::ndrop ] compile-call
\ foo [ global [ get ] swap >n call namespaces.private:ndrop ] compile-call
] unit-test
[ 3 ]

View File

@ -2,8 +2,8 @@ USING: compiler.units compiler.test kernel kernel.private memory
math math.private tools.test math.floats.private math.order fry
specialized-arrays sequences math.functions layouts literals ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: c::float
SPECIALIZED-ARRAY: c::double
SPECIALIZED-ARRAY: c:float
SPECIALIZED-ARRAY: c:double
IN: compiler.tests.float
[ 3.0 1 2 3 ] [ 1.0 2.0 [ float+ 1 2 3 ] compile-call ] unit-test

View File

@ -467,8 +467,8 @@ ERROR: bug-in-fixnum* x y a b ;
[ t ] [ pi double <ref> [ { byte-array } declare double deref ] compile-call pi = ] unit-test
! Silly
[ t ] [ pi 4 <byte-array> [ [ { float byte-array } declare 0 set-alien-float ] compile-call ] keep c::float deref pi - -0.001 0.001 between? ] unit-test
[ t ] [ pi c::float <ref> [ { byte-array } declare c::float deref ] compile-call pi - -0.001 0.001 between? ] unit-test
[ t ] [ pi 4 <byte-array> [ [ { float byte-array } declare 0 set-alien-float ] compile-call ] keep c:float deref pi - -0.001 0.001 between? ] unit-test
[ t ] [ pi c:float <ref> [ { byte-array } declare c:float deref ] compile-call pi - -0.001 0.001 between? ] unit-test
[ t ] [ pi 8 <byte-array> [ [ { float byte-array } declare 0 set-alien-double ] compile-call ] keep double deref pi = ] unit-test

View File

@ -2,14 +2,14 @@ USING: alien alien.syntax eval math tools.test ;
QUALIFIED: alien.c-types
IN: compiler.tests.redefine24
TYPEDEF: alien.c-types::int type-1
TYPEDEF: alien.c-types:int type-1
TYPEDEF: alien.c-types::int type-3
TYPEDEF: alien.c-types:int type-3
: callback ( -- ptr )
type-3 { type-1 type-1 } cdecl [ + >integer ] alien-callback ;
TYPEDEF: alien.c-types::float type-2
TYPEDEF: alien.c-types:float type-2
: indirect ( x y ptr -- z )
type-3 { type-2 type-2 } cdecl alien-indirect ;

View File

@ -74,8 +74,8 @@ GENERIC: check-stack-flow* ( node -- )
[ check-stack-flow* terminated? get not ] all? drop ;
: init-stack-flow ( -- )
V{ } clone datastack namespaces::set
V{ } clone retainstack namespaces::set ;
V{ } clone datastack namespaces:set
V{ } clone retainstack namespaces:set ;
: check-stack-flow ( nodes -- )
[
@ -149,7 +149,7 @@ SYMBOL: branch-out
: check-branch ( nodes -- stack )
[
datastack [ clone ] change
V{ } clone retainstack namespaces::set
V{ } clone retainstack namespaces:set
(check-stack-flow)
terminated? get [ assert-retainstack-empty ] unless
terminated? get f datastack get ?
@ -157,7 +157,7 @@ SYMBOL: branch-out
M: #branch check-stack-flow*
[ check-in-d ]
[ children>> [ check-branch ] map branch-out namespaces::set ]
[ children>> [ check-branch ] map branch-out namespaces:set ]
bi ;
: check-phi-in ( #phi -- )
@ -174,7 +174,7 @@ M: #branch check-stack-flow*
: set-phi-datastack ( #phi -- )
phi-in-d>> first length
branch-out get [ ] find nip swap head* >vector datastack namespaces::set ;
branch-out get [ ] find nip swap head* >vector datastack namespaces:set ;
M: #phi check-stack-flow*
branch-out get [ ] any? [

View File

@ -238,22 +238,22 @@ M: float detect-float ;
] when
{ t } [
[ B{ 1 0 } c::short deref 0 number= ]
[ B{ 1 0 } c:short deref 0 number= ]
\ number= inlined?
] unit-test
{ t } [
[ B{ 1 0 } c::short deref 0 { number number } declare number= ]
[ B{ 1 0 } c:short deref 0 { number number } declare number= ]
\ number= inlined?
] unit-test
{ t } [
[ B{ 1 0 } c::short deref 0 = ]
[ B{ 1 0 } c:short deref 0 = ]
\ number= inlined?
] unit-test
{ t } [
[ B{ 1 0 } c::short deref dup number? [ 0 number= ] [ drop f ] if ]
[ B{ 1 0 } c:short deref dup number? [ 0 number= ] [ drop f ] if ]
\ number= inlined?
] unit-test

View File

@ -18,8 +18,8 @@ SYMBOL: live-values
: look-at-inputs ( node -- ) in-d>> look-at-values ;
: init-dead-code ( -- )
<hashed-dlist> work-list namespaces::set
H{ { +bottom+ f } } clone live-values namespaces::set ;
<hashed-dlist> work-list namespaces:set
H{ { +bottom+ f } } clone live-values namespaces:set ;
GENERIC: mark-live-values* ( node -- )

View File

@ -51,7 +51,7 @@ GENERIC: node-uses-values ( node -- values )
M: #introduce node-uses-values drop f ;
M: #push node-uses-values drop f ;
M: #phi node-uses-values phi-in-d>> concat remove-bottom sets::members ;
M: #phi node-uses-values phi-in-d>> concat remove-bottom sets:members ;
M: #declare node-uses-values drop f ;
M: #terminate node-uses-values [ in-d>> ] [ in-r>> ] bi append ;
M: #shuffle node-uses-values [ in-d>> ] [ in-r>> ] bi append ;

View File

@ -18,8 +18,8 @@ SYMBOLS: visited accum ;
: with-simplified-def-use ( quot -- real-usages )
[
HS{ } clone visited namespaces::set
HS{ } clone accum namespaces::set
HS{ } clone visited namespaces:set
HS{ } clone accum namespaces:set
call
accum get members
] with-scope ; inline

View File

@ -98,8 +98,8 @@ M: node compute-modular-candidates*
drop ;
: compute-modular-candidates ( nodes -- )
HS{ } clone modular-values namespaces::set
HS{ } clone fixnum-values namespaces::set
HS{ } clone modular-values namespaces:set
HS{ } clone fixnum-values namespaces:set
[ compute-modular-candidates* ] each-node ;
GENERIC: only-reads-low-order? ( node -- ? )

View File

@ -302,17 +302,17 @@ CONSTANT: lookup-table-at-max 256
: diff-quot ( seq -- quot: ( seq' -- seq'' ) )
[ tester ] keep '[ members _ reject _ set-like ] ;
M\\ sets::set diff [ diff-quot ] 1 define-partial-eval
M\\ sets:set diff [ diff-quot ] 1 define-partial-eval
: intersect-quot ( seq -- quot: ( seq' -- seq'' ) )
[ tester ] keep '[ members _ filter _ set-like ] ;
M\\ sets::set intersect [ intersect-quot ] 1 define-partial-eval
M\\ sets:set intersect [ intersect-quot ] 1 define-partial-eval
: intersects?-quot ( seq -- quot: ( seq' -- seq'' ) )
tester '[ members _ any? ] ;
M\\ sets::set intersects? [ intersects?-quot ] 1 define-partial-eval
M\\ sets:set intersects? [ intersects?-quot ] 1 define-partial-eval
: bit-quot ( #call -- quot/f )
in-d>> second value-info interval>> 0 fixnum-bits [a,b] interval-subset?

View File

@ -35,8 +35,8 @@ GENERIC: node-call-graph ( tail? node -- )
: build-call-graph ( nodes -- labels calls )
[
V{ } clone children namespaces::set
V{ } clone calls namespaces::set
V{ } clone children namespaces:set
V{ } clone calls namespaces:set
[ t ] dip (build-call-graph)
children get
calls get
@ -111,8 +111,8 @@ SYMBOL: changed?
[ changed? get [ while-changing ] [ drop ] if ] bi ; inline recursive
: detect-loops ( call-graph -- )
HS{ } clone not-loops namespaces::set
V{ } clone recursive-nesting namespaces::set
HS{ } clone not-loops namespaces:set
V{ } clone recursive-nesting namespaces:set
[ visit-back-edges ]
[ '[ _ detect-cross-frame-calls ] while-changing ]
bi ;
@ -130,7 +130,7 @@ SYMBOL: call-graph
: analyze-recursive ( nodes -- nodes )
dup build-call-graph drop
[ call-graph namespaces::set ]
[ call-graph namespaces:set ]
[ detect-loops ]
[ mark-loops ]
tri ;

View File

@ -63,13 +63,13 @@ TUPLE: huffman-decoder
dup [ tdesc>> ] [ bits/level>> 2^ ] bi reverse-table >>rtable ; inline
: read1-huff ( huffman-decoder -- elt )
16 over [ bs>> bs::peek ] [ rtable>> nth ] bi
[ size>> swap bs>> bs::seek ] [ value>> ] bi ; inline
16 over [ bs>> bs:peek ] [ rtable>> nth ] bi
[ size>> swap bs>> bs:seek ] [ value>> ] bi ; inline
: reverse-bits ( value bits -- value' )
[ integer>bit-array ] dip
f pad-tail reverse bit-array>integer ; inline
: read1-huff2 ( huffman-decoder -- elt )
16 over [ bs>> bs::peek 16 reverse-bits ] [ rtable>> nth ] bi
[ size>> swap bs>> bs::seek ] [ value>> ] bi ; inline
16 over [ bs>> bs:peek 16 reverse-bits ] [ rtable>> nth ] bi
[ size>> swap bs>> bs:seek ] [ value>> ] bi ; inline

View File

@ -13,14 +13,14 @@ ERROR: bad-zlib-data ;
ERROR: bad-zlib-header ;
:: check-zlib-header ( data -- )
16 data bs::peek 2 >le be> 31 mod ! checksum
16 data bs:peek 2 >le be> 31 mod ! checksum
0 assert=
4 data bs::read 8 assert= ! compression method: deflate
4 data bs::read ! log2(max length)-8, 32K max
4 data bs:read 8 assert= ! compression method: deflate
4 data bs:read ! log2(max length)-8, 32K max
7 <= [ bad-zlib-header ] unless
5 data bs::seek ! drop check bits
1 data bs::read 0 assert= ! dictionary - not allowed in png
2 data bs::seek ! compression level; ignore
5 data bs:seek ! drop check bits
1 data bs:read 0 assert= ! dictionary - not allowed in png
2 data bs:seek ! compression level; ignore
;
CONSTANT: clen-shuffle { 16 17 18 0 8 7 9 6 10 5 11 4 12 3 13 2 14 1 15 }
@ -31,19 +31,19 @@ CONSTANT: clen-shuffle { 16 17 18 0 8 7 9 6 10 5 11 4 12 3 13 2 14 1 15 }
seq>> rest-slice [ natural-sort ] map ; inline
:: decode-huffman-tables ( bitstream -- tables )
5 bitstream bs::read 257 +
5 bitstream bs::read 1 +
4 bitstream bs::read 4 + clen-shuffle swap head
5 bitstream bs:read 257 +
5 bitstream bs:read 1 +
4 bitstream bs:read 4 + clen-shuffle swap head
dup length [ 3 bitstream bs::read ] replicate
dup length [ 3 bitstream bs:read ] replicate
get-table
bitstream swap <huffman-decoder>
[ 2dup + ] dip swap :> k!
'[
_ read1-huff2 {
{ [ dup 16 = ] [ 2 bitstream bs::read 3 + 2array ] }
{ [ dup 17 = ] [ 3 bitstream bs::read 3 + 2array ] }
{ [ dup 18 = ] [ 7 bitstream bs::read 11 + 2array ] }
{ [ dup 16 = ] [ 2 bitstream bs:read 3 + 2array ] }
{ [ dup 17 = ] [ 3 bitstream bs:read 3 + 2array ] }
{ [ dup 18 = ] [ 7 bitstream bs:read 11 + 2array ] }
[ ]
} cond
dup array? [ dup second ] [ 1 ] if
@ -105,7 +105,7 @@ CONSTANT: dist-table
dup 264 > [
dup 261 - 4 /i
dup 5 > [ bad-zlib-data ] when
bitstream bs::read 2array
bitstream bs:read 2array
] when
] unless
@ -114,7 +114,7 @@ CONSTANT: dist-table
dup 3 > [
dup 2 - 2 /i dup 13 >
[ bad-zlib-data ] when
bitstream bs::read 2array
bitstream bs:read 2array
] when 2array
] when dup 256 = not
] [ ] produce nip
@ -131,9 +131,9 @@ CONSTANT: dist-table
] map ;
:: inflate-raw ( bitstream -- bytes )
8 bitstream bs::align
16 bitstream bs::read :> len
16 bitstream bs::read :> nlen
8 bitstream bs:align
16 bitstream bs:read :> len
16 bitstream bs:read :> nlen
! len + ~len = -1
len nlen + 16 >signed -1 assert=
@ -141,7 +141,7 @@ CONSTANT: dist-table
bitstream byte-pos>>
bitstream byte-pos>> len +
bitstream bytes>> <slice>
len 8 * bitstream bs::seek ;
len 8 * bitstream bs:seek ;
: inflate-dynamic ( bitstream -- array )
dup decode-huffman-tables inflate-huffman ;
@ -150,9 +150,9 @@ CONSTANT: dist-table
static-huffman-tables inflate-huffman ;
:: inflate-loop ( bitstream -- array )
[ 1 bitstream bs::read 0 = ] [
[ 1 bitstream bs:read 0 = ] [
bitstream
2 bitstream bs::read
2 bitstream bs:read
{
{ 0 [ inflate-raw ] }
{ 1 [ inflate-static ] }
@ -164,6 +164,6 @@ CONSTANT: dist-table
PRIVATE>
: zlib-inflate ( bytes -- bytes )
bs::<lsb0-bit-reader>
bs:<lsb0-bit-reader>
[ check-zlib-header ] [ inflate-loop ] bi
inflate-lz77 ;

View File

@ -73,7 +73,7 @@ M: gif-lzw increment-code-size [ 1 + 12 min ] change-code-size ;
[ maybe-increment-code-size 2drop ] 2bi ;
: lzw-read ( lzw -- lzw n )
[ ] [ code-size>> ] [ input>> ] tri bs::read ;
[ ] [ code-size>> ] [ input>> ] tri bs:read ;
: end-of-information? ( lzw code -- ? ) swap end-of-information-code>> = ;
: clear-code? ( lzw code -- ? ) swap clear-code>> = ;
@ -121,7 +121,7 @@ DEFER: lzw-uncompress-char
[ lzw-uncompress-char ] [ output>> ] bi ;
: tiff-lzw-uncompress ( seq -- byte-array )
bs::<msb0-bit-reader> 9 tiff-lzw lzw-uncompress ;
bs:<msb0-bit-reader> 9 tiff-lzw lzw-uncompress ;
: gif-lzw-uncompress ( seq code-size -- byte-array )
[ bs::<lsb0-bit-reader> ] dip gif-lzw lzw-uncompress ;
[ bs:<lsb0-bit-reader> ] dip gif-lzw lzw-uncompress ;

View File

@ -5,4 +5,4 @@ QUALIFIED-WITH: compression.zlib.ffi ffi
{ t } [ B{ 1 2 3 4 5 } [ compress uncompress ] keep = ] unit-test
[ ffi::Z_DATA_ERROR zlib-error-message ] [ string>> "data error" = ] must-fail-with
[ ffi:Z_DATA_ERROR zlib-error-message ] [ string>> "data error" = ] must-fail-with

View File

@ -9,7 +9,7 @@ IN: compression.zlib
ERROR: zlib-failed n string ;
: zlib-error-message ( n -- * )
dup compression.zlib.ffi::Z_ERRNO = [
dup compression.zlib.ffi:Z_ERRNO = [
drop errno "native libc error"
] [
dup
@ -23,8 +23,8 @@ ERROR: zlib-failed n string ;
: zlib-error ( n -- )
dup {
{ compression.zlib.ffi::Z_OK [ drop ] }
{ compression.zlib.ffi::Z_STREAM_END [ drop ] }
{ compression.zlib.ffi:Z_OK [ drop ] }
{ compression.zlib.ffi:Z_STREAM_END [ drop ] }
[ dup zlib-error-message zlib-failed ]
} case ;
@ -36,14 +36,14 @@ ERROR: zlib-failed n string ;
compressed-size
[ <byte-vector> dup underlying>> ] keep ulong <ref>
] keep [
dup length compression.zlib.ffi::compress zlib-error
dup length compression.zlib.ffi:compress zlib-error
] keepd ulong deref >>length B{ } like ;
: (uncompress) ( length byte-array -- byte-array )
[
[ drop [ malloc &free ] [ ulong <ref> ] bi ]
[ nip dup length ] 2bi
[ compression.zlib.ffi::uncompress zlib-error ] 4keep
[ compression.zlib.ffi:uncompress zlib-error ] 4keep
2drop ulong deref memory>byte-array
] with-destructors ;

View File

@ -62,7 +62,7 @@ ERROR: unsupported-number-type type ;
{ kCFNumberSInt64Type [ SInt64 (CFNumber>number) ] }
{ kCFNumberFloat64Type [ double (CFNumber>number) ] }
{ kCFNumberCharType [ char (CFNumber>number) ] }
{ kCFNumberShortType [ c::short (CFNumber>number) ] }
{ kCFNumberShortType [ c:short (CFNumber>number) ] }
{ kCFNumberIntType [ int (CFNumber>number) ] }
{ kCFNumberLongType [ long (CFNumber>number) ] }
{ kCFNumberLongLongType [ longlong (CFNumber>number) ] }

View File

@ -686,36 +686,36 @@ M:: ppc %box-displaced-alien ( dst displacement base temp base-class -- )
M:: ppc.32 %convert-integer ( dst src c-type -- )
c-type {
{ c::char [ dst src 24 CLRLWI dst dst EXTSB ] }
{ c::uchar [ dst src 24 CLRLWI ] }
{ c::short [ dst src 16 CLRLWI dst dst EXTSH ] }
{ c::ushort [ dst src 16 CLRLWI ] }
{ c::int [ ] }
{ c::uint [ ] }
{ c:char [ dst src 24 CLRLWI dst dst EXTSB ] }
{ c:uchar [ dst src 24 CLRLWI ] }
{ c:short [ dst src 16 CLRLWI dst dst EXTSH ] }
{ c:ushort [ dst src 16 CLRLWI ] }
{ c:int [ ] }
{ c:uint [ ] }
} case ;
M:: ppc.64 %convert-integer ( dst src c-type -- )
c-type {
{ c::char [ dst src 56 CLRLDI dst dst EXTSB ] }
{ c::uchar [ dst src 56 CLRLDI ] }
{ c::short [ dst src 48 CLRLDI dst dst EXTSH ] }
{ c::ushort [ dst src 48 CLRLDI ] }
{ c::int [ dst src 32 CLRLDI dst dst EXTSW ] }
{ c::uint [ dst src 32 CLRLDI ] }
{ c::longlong [ ] }
{ c::ulonglong [ ] }
{ c:char [ dst src 56 CLRLDI dst dst EXTSB ] }
{ c:uchar [ dst src 56 CLRLDI ] }
{ c:short [ dst src 48 CLRLDI dst dst EXTSH ] }
{ c:ushort [ dst src 48 CLRLDI ] }
{ c:int [ dst src 32 CLRLDI dst dst EXTSW ] }
{ c:uint [ dst src 32 CLRLDI ] }
{ c:longlong [ ] }
{ c:ulonglong [ ] }
} case ;
M: ppc.32 %load-memory-imm ( dst base offset rep c-type -- )
[
pick %trap-null
{
{ c::char [ [ dup ] 2dip LBZ dup EXTSB ] }
{ c::uchar [ LBZ ] }
{ c::short [ LHA ] }
{ c::ushort [ LHZ ] }
{ c::int [ LWZ ] }
{ c::uint [ LWZ ] }
{ c:char [ [ dup ] 2dip LBZ dup EXTSB ] }
{ c:uchar [ LBZ ] }
{ c:short [ LHA ] }
{ c:ushort [ LHZ ] }
{ c:int [ LWZ ] }
{ c:uint [ LWZ ] }
} case
] [
{
@ -729,14 +729,14 @@ M: ppc.64 %load-memory-imm ( dst base offset rep c-type -- )
[
pick %trap-null
{
{ c::char [ [ dup ] 2dip LBZ dup EXTSB ] }
{ c::uchar [ LBZ ] }
{ c::short [ LHA ] }
{ c::ushort [ LHZ ] }
{ c::int [ LWZ ] }
{ c::uint [ LWZ ] }
{ c::longlong [ [ scratch-reg ] dip LI scratch-reg LDX ] }
{ c::ulonglong [ [ scratch-reg ] dip LI scratch-reg LDX ] }
{ c:char [ [ dup ] 2dip LBZ dup EXTSB ] }
{ c:uchar [ LBZ ] }
{ c:short [ LHA ] }
{ c:ushort [ LHZ ] }
{ c:int [ LWZ ] }
{ c:uint [ LWZ ] }
{ c:longlong [ [ scratch-reg ] dip LI scratch-reg LDX ] }
{ c:ulonglong [ [ scratch-reg ] dip LI scratch-reg LDX ] }
} case
] [
{
@ -752,12 +752,12 @@ M: ppc.32 %load-memory ( dst base displacement scale offset rep c-type -- )
[
pick %trap-null
{
{ c::char [ [ LBZX ] [ drop dup EXTSB ] 2bi ] }
{ c::uchar [ LBZX ] }
{ c::short [ LHAX ] }
{ c::ushort [ LHZX ] }
{ c::int [ LWZX ] }
{ c::uint [ LWZX ] }
{ c:char [ [ LBZX ] [ drop dup EXTSB ] 2bi ] }
{ c:uchar [ LBZX ] }
{ c:short [ LHAX ] }
{ c:ushort [ LHZX ] }
{ c:int [ LWZX ] }
{ c:uint [ LWZX ] }
} case
] [
{
@ -772,14 +772,14 @@ M: ppc.64 %load-memory ( dst base displacement scale offset rep c-type -- )
[
pick %trap-null
{
{ c::char [ [ LBZX ] [ drop dup EXTSB ] 2bi ] }
{ c::uchar [ LBZX ] }
{ c::short [ LHAX ] }
{ c::ushort [ LHZX ] }
{ c::int [ LWZX ] }
{ c::uint [ LWZX ] }
{ c::longlong [ LDX ] }
{ c::ulonglong [ LDX ] }
{ c:char [ [ LBZX ] [ drop dup EXTSB ] 2bi ] }
{ c:uchar [ LBZX ] }
{ c:short [ LHAX ] }
{ c:ushort [ LHZX ] }
{ c:int [ LWZX ] }
{ c:uint [ LWZX ] }
{ c:longlong [ LDX ] }
{ c:ulonglong [ LDX ] }
} case
] [
{
@ -793,12 +793,12 @@ M: ppc.64 %load-memory ( dst base displacement scale offset rep c-type -- )
M: ppc.32 %store-memory-imm ( src base offset rep c-type -- )
[
{
{ c::char [ STB ] }
{ c::uchar [ STB ] }
{ c::short [ STH ] }
{ c::ushort [ STH ] }
{ c::int [ STW ] }
{ c::uint [ STW ] }
{ c:char [ STB ] }
{ c:uchar [ STB ] }
{ c:short [ STH ] }
{ c:ushort [ STH ] }
{ c:int [ STW ] }
{ c:uint [ STW ] }
} case
] [
{
@ -811,14 +811,14 @@ M: ppc.32 %store-memory-imm ( src base offset rep c-type -- )
M: ppc.64 %store-memory-imm ( src base offset rep c-type -- )
[
{
{ c::char [ STB ] }
{ c::uchar [ STB ] }
{ c::short [ STH ] }
{ c::ushort [ STH ] }
{ c::int [ STW ] }
{ c::uint [ STW ] }
{ c::longlong [ [ scratch-reg ] dip LI scratch-reg STDX ] }
{ c::ulonglong [ [ scratch-reg ] dip LI scratch-reg STDX ] }
{ c:char [ STB ] }
{ c:uchar [ STB ] }
{ c:short [ STH ] }
{ c:ushort [ STH ] }
{ c:int [ STW ] }
{ c:uint [ STW ] }
{ c:longlong [ [ scratch-reg ] dip LI scratch-reg STDX ] }
{ c:ulonglong [ [ scratch-reg ] dip LI scratch-reg STDX ] }
} case
] [
{
@ -832,12 +832,12 @@ M: ppc.32 %store-memory ( src base displacement scale offset rep c-type -- )
[ [ 0 assert= ] bi@ ] 2dip
[
{
{ c::char [ STBX ] }
{ c::uchar [ STBX ] }
{ c::short [ STHX ] }
{ c::ushort [ STHX ] }
{ c::int [ STWX ] }
{ c::uint [ STWX ] }
{ c:char [ STBX ] }
{ c:uchar [ STBX ] }
{ c:short [ STHX ] }
{ c:ushort [ STHX ] }
{ c:int [ STWX ] }
{ c:uint [ STWX ] }
} case
] [
{
@ -851,14 +851,14 @@ M: ppc.64 %store-memory ( src base displacement scale offset rep c-type -- )
[ [ 0 assert= ] bi@ ] 2dip
[
{
{ c::char [ STBX ] }
{ c::uchar [ STBX ] }
{ c::short [ STHX ] }
{ c::ushort [ STHX ] }
{ c::int [ STWX ] }
{ c::uint [ STWX ] }
{ c::longlong [ STDX ] }
{ c::ulonglong [ STDX ] }
{ c:char [ STBX ] }
{ c:uchar [ STBX ] }
{ c:short [ STHX ] }
{ c:ushort [ STHX ] }
{ c:int [ STWX ] }
{ c:uint [ STWX ] }
{ c:longlong [ STDX ] }
{ c:ulonglong [ STDX ] }
} case
] [
{

View File

@ -8,8 +8,8 @@ QUALIFIED-WITH: alien.c-types c
IN: cpu.x86.sse
! Scalar floating point with SSE2
M: x86 %load-float c::float <ref> float-rep %load-vector ;
M: x86 %load-double c::double <ref> double-rep %load-vector ;
M: x86 %load-float c:float <ref> float-rep %load-vector ;
M: x86 %load-double c:double <ref> double-rep %load-vector ;
M: float-rep copy-register* drop MOVAPS ;
M: double-rep copy-register* drop MOVAPS ;

View File

@ -366,12 +366,12 @@ M: x86.64 has-small-reg? 2drop t ;
M: x86 %convert-integer ( dst src c-type -- )
{
{ c::char [ 8 %sign-extend ] }
{ c::uchar [ 8 %zero-extend ] }
{ c::short [ 16 %sign-extend ] }
{ c::ushort [ 16 %zero-extend ] }
{ c::int [ 32 %sign-extend ] }
{ c::uint [ 32 [ 2drop ] (%convert-integer) ] }
{ c:char [ 8 %sign-extend ] }
{ c:uchar [ 8 %zero-extend ] }
{ c:short [ 16 %sign-extend ] }
{ c:ushort [ 16 %zero-extend ] }
{ c:int [ 32 %sign-extend ] }
{ c:uint [ 32 [ 2drop ] (%convert-integer) ] }
} case ;
:: %alien-integer-getter ( dst exclude address bits quot -- )
@ -402,12 +402,12 @@ M: x86 %convert-integer ( dst src c-type -- )
: (%load-memory) ( dst exclude address rep c-type -- )
[
{
{ c::char [ 8 %alien-signed-getter ] }
{ c::uchar [ 8 %alien-unsigned-getter ] }
{ c::short [ 16 %alien-signed-getter ] }
{ c::ushort [ 16 %alien-unsigned-getter ] }
{ c::int [ 32 %alien-signed-getter ] }
{ c::uint [ 32 [ 2drop ] %alien-integer-getter ] }
{ c:char [ 8 %alien-signed-getter ] }
{ c:uchar [ 8 %alien-unsigned-getter ] }
{ c:short [ 16 %alien-signed-getter ] }
{ c:ushort [ 16 %alien-unsigned-getter ] }
{ c:int [ 32 %alien-signed-getter ] }
{ c:uint [ 32 [ 2drop ] %alien-integer-getter ] }
} case
] [ nipd %copy ] ?if ;
@ -420,12 +420,12 @@ M: x86 %load-memory-imm ( dst base offset rep c-type -- )
: (%store-memory) ( src exclude address rep c-type -- )
[
{
{ c::char [ 8 %alien-integer-setter ] }
{ c::uchar [ 8 %alien-integer-setter ] }
{ c::short [ 16 %alien-integer-setter ] }
{ c::ushort [ 16 %alien-integer-setter ] }
{ c::int [ 32 %alien-integer-setter ] }
{ c::uint [ 32 %alien-integer-setter ] }
{ c:char [ 8 %alien-integer-setter ] }
{ c:uchar [ 8 %alien-integer-setter ] }
{ c:short [ 16 %alien-integer-setter ] }
{ c:ushort [ 16 %alien-integer-setter ] }
{ c:int [ 32 %alien-integer-setter ] }
{ c:uint [ 32 %alien-integer-setter ] }
} case
] [ [ nip swap ] dip %copy ] ?if ;

View File

@ -131,7 +131,7 @@ PRIVATE>
new-lines from text+loc :> new-to
from to document doc-range :> old-string
old-string string from to new-to <edit> document add-undo
new-lines from to document [ (set-doc-range) ] models::change-model
new-lines from to document [ (set-doc-range) ] models:change-model
new-to document update-locs
] unless ;

View File

@ -159,15 +159,15 @@ T-class DEFINES-CLASS ${T}
WHERE
STRUCT: T-class
{ NAME c::longlong }
{ NAME c:longlong }
{ x { TYPE 4 } }
{ y { c::short N } }
{ y { c:short N } }
{ z TYPE initial: 5 }
{ float { c::float 2 } } ;
{ float { c:float 2 } } ;
;FUNCTOR>
"a-struct" "nemo" c::char 2 define-a-struct
"a-struct" "nemo" c:char 2 define-a-struct
>>
@ -178,35 +178,35 @@ STRUCT: T-class
{ offset 0 }
{ class integer }
{ initial 0 }
{ type c::longlong }
{ type c:longlong }
}
T{ struct-slot-spec
{ name "x" }
{ offset 8 }
{ class object }
{ initial f }
{ type { c::char 4 } }
{ type { c:char 4 } }
}
T{ struct-slot-spec
{ name "y" }
{ offset 12 }
{ class object }
{ initial f }
{ type { c::short 2 } }
{ type { c:short 2 } }
}
T{ struct-slot-spec
{ name "z" }
{ offset 16 }
{ class fixnum }
{ initial 5 }
{ type c::char }
{ type c:char }
}
T{ struct-slot-spec
{ name "float" }
{ offset 20 }
{ class object }
{ initial f }
{ type { c::float 2 } }
{ type { c:float 2 } }
}
}
] [ a-struct struct-slots ] unit-test

View File

@ -93,12 +93,12 @@ M: user-saver dispose
<user-saver> &dispose drop ;
: init-user ( user -- )
[ [ logged-in-user namespaces::set ] [ save-user-after ] bi ] when* ;
[ [ logged-in-user namespaces:set ] [ save-user-after ] bi ] when* ;
\ init-user DEBUG add-input-logging
M: realm call-responder* ( path responder -- response )
dup realm namespaces::set
dup realm namespaces:set
logged-in? [
dup init-realm
dup logged-in-username
@ -147,7 +147,7 @@ TUPLE: protected < filter-responder description capabilities ;
] if ;
M: protected call-responder* ( path responder -- response )
dup protected namespaces::set
dup protected namespaces:set
dup capabilities>> have-capabilities?
[ call-next-method ] [
[ drop ] [ [ description>> ] [ capabilities>> ] bi ] bi*

View File

@ -29,11 +29,11 @@ SYMBOL: blank-line
and [ nl ] when ;
: ($blank-line) ( -- )
nl nl blank-line last-element namespaces::set ;
nl nl blank-line last-element namespaces:set ;
: ($span) ( quot -- )
last-block? [ nl ] when
span last-element namespaces::set
span last-element namespaces:set
call ; inline
GENERIC: print-element ( element -- )
@ -60,9 +60,9 @@ M: f print-element drop ;
: ($block) ( quot -- )
?nl
span last-element namespaces::set
span last-element namespaces:set
call
block last-element namespaces::set ; inline
block last-element namespaces:set ; inline
! Some spans
@ -86,7 +86,7 @@ ALIAS: $slot $snippet
: $nl ( children -- )
drop nl last-element get [ nl ] when
blank-line last-element namespaces::set ;
blank-line last-element namespaces:set ;
! Some blocks
: ($heading) ( children quot -- )

View File

@ -140,8 +140,8 @@ ERROR: unknown-chloe-tag tag ;
: with-compiler ( quot -- quot' )
[
SBUF" " string-buffer namespaces::set
V{ } clone tag-stack namespaces::set
SBUF" " string-buffer namespaces:set
V{ } clone tag-stack namespaces:set
call
reset-buffer
] [ ] make ; inline
@ -152,7 +152,7 @@ ERROR: unknown-chloe-tag tag ;
: compile-quot ( quot -- )
reset-buffer
[
SBUF" " string-buffer namespaces::set
SBUF" " string-buffer namespaces:set
call
reset-buffer
] [ ] make , ; inline

View File

@ -184,7 +184,7 @@ M: file-responder call-responder* ( path responder -- response )
[ drop <400> ] [ "/" join serve-object ] if ;
: add-index ( name responder -- )
index-names>> sets::adjoin ;
index-names>> sets:adjoin ;
: serve-fhtml ( path -- response )
<fhtml> <html-content> ;

View File

@ -69,11 +69,11 @@ SYMBOL: inspector-stack
SYMBOL: sorted-keys
: reinspect ( obj -- )
[ me namespaces::set ]
[ me namespaces:set ]
[
dup make-mirror dup mirror namespaces::set
dup make-mirror dup mirror namespaces:set
t +number-rows+ [ (describe) ] with-variable
sorted-keys namespaces::set
sorted-keys namespaces:set
] bi ;
: (inspect) ( obj -- )
@ -118,7 +118,7 @@ PRIVATE>
: inspector ( obj -- )
&help
V{ } clone inspector-stack namespaces::set
V{ } clone inspector-stack namespaces:set
(inspect) ;
: inspect ( obj -- )

View File

@ -10,4 +10,4 @@ M: linux init-io ( -- )
linux set-io-backend
[ start-signal-pipe-thread ] "io.backend.unix::signal-pipe-thread" add-startup-hook
[ start-signal-pipe-thread ] "io.backend.unix:signal-pipe-thread" add-startup-hook

View File

@ -17,4 +17,4 @@ M: macosx init-io ( -- )
macosx set-io-backend
[ start-signal-pipe-thread ]
"io.backend.unix::signal-pipe-thread" add-startup-hook
"io.backend.unix:signal-pipe-thread" add-startup-hook

View File

@ -51,10 +51,10 @@ M: unix tell-handle ( handle -- n )
M: unix seek-handle ( n seek-type handle -- )
swap {
{ io::seek-absolute [ SEEK_SET ] }
{ io::seek-relative [ SEEK_CUR ] }
{ io::seek-end [ SEEK_END ] }
[ io::bad-seek-type ]
{ io:seek-absolute [ SEEK_SET ] }
{ io:seek-relative [ SEEK_CUR ] }
{ io:seek-end [ SEEK_END ] }
[ io:bad-seek-type ]
} case
[ fd>> swap ] dip [ lseek ] unix-system-call drop ;
@ -147,8 +147,8 @@ M: stdin dispose*
] with-destructors ;
: wait-for-stdin ( stdin -- size )
[ control>> char: X over io::stream-write1 io::stream-flush ]
[ size>> ssize_t heap-size swap io::stream-read ssize_t deref ]
[ control>> char: X over io:stream-write1 io:stream-flush ]
[ size>> ssize_t heap-size swap io:stream-read ssize_t deref ]
bi ;
:: refill-stdin ( buffer stdin size -- )
@ -194,7 +194,7 @@ dispatch-signal-hook [ [ drop ] ] initialize
: signal-pipe-loop ( port -- )
'[
int heap-size _ io::stream-read
int heap-size _ io:stream-read
dup [ int deref dispatch-signal-hook get call( x -- ) ] when*
] loop ;

View File

@ -123,9 +123,9 @@ M: linux-monitor dispose* ( monitor -- )
[ inotify-read-loop ] curry ignore-errors ;
M: linux init-monitors
H{ } clone watches namespaces::set
H{ } clone watches namespaces:set
<inotify> [
[ inotify namespaces::set ]
[ inotify namespaces:set ]
[
[ inotify-read-thread ] curry
"Linux monitor thread" spawn drop

View File

@ -6,7 +6,7 @@ QUALIFIED: io.pipes
SPECIALIZED-ARRAY: int
IN: io.pipes.unix
M: unix io.pipes::(pipe) ( -- pair )
M: unix io.pipes:(pipe) ( -- pair )
2 int <c-array>
[ pipe io-error ]
[ first2 [ <fd> init-fd ] bi@ io.pipes::pipe boa ] bi ;
[ first2 [ <fd> init-fd ] bi@ io.pipes:pipe boa ] bi ;

View File

@ -93,7 +93,7 @@ M: f >insecure ;
: log-connection ( remote local -- )
[ accepted-connection ]
[ [ remote-address namespaces::set ] [ local-address namespaces::set ] bi* ]
[ [ remote-address namespaces:set ] [ local-address namespaces:set ] bi* ]
2bi ;
M: threaded-server handle-client* handler>> call( -- ) ;

View File

@ -20,11 +20,11 @@ IN: io.sockets.secure.tests
] curry with-stream
] with-disposal
] with-test-context
] "SSL server test" qm::spawn-linked drop
] "SSL server test" qm:spawn-linked drop
! This is hideous.
! If we fail with a timeout, the test is passing.
! If we fail with something besides a timeout, rethrow it and fail the test.
[ qm::my-mailbox 200 milliseconds mailbox-get-timeout drop ]
[ qm:my-mailbox 200 milliseconds mailbox-get-timeout drop ]
[ dup timed-out-error? [ drop ] [ rethrow ] if ] recover ;
: ?promise-test ( mailbox -- obj )

View File

@ -94,7 +94,7 @@ M: object (server)
: do-accept ( server addrspec -- fd sockaddr )
[ handle>> handle-fd ] [ empty-sockaddr/size int <ref> ] bi*
[ unix.ffi::accept ] keepd ; inline
[ unix.ffi:accept ] keepd ; inline
M: object (accept)
2dup do-accept over 0 >= [

View File

@ -11,7 +11,7 @@ SYMBOL: insomniac-recipients
: email-subject ( service -- string )
[
"Log analysis for " % % " on " % io.sockets::host-name %
"Log analysis for " % % " on " % io.sockets:host-name %
] "" make ;
:: (email-log-report) ( service word-names -- )

View File

@ -7,9 +7,9 @@ sequences.unrolled sequences.unrolled.private specialized-arrays
vocabs ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAYS:
c::char c::short c::int c::longlong
c::uchar c::ushort c::uint c::ulonglong
c::float c::double ;
c:char c:short c:int c:longlong
c:uchar c:ushort c:uint c:ulonglong
c:float c:double ;
IN: math.vectors.simd.intrinsics
! Word props are added later
@ -47,44 +47,44 @@ IN: math.vectors.simd.intrinsics
: byte>rep-array ( byte-array rep -- array )
{
{ char-16-rep [ 16 c::char <c-direct-array> ] }
{ uchar-16-rep [ 16 c::uchar <c-direct-array> ] }
{ short-8-rep [ 8 c::short <c-direct-array> ] }
{ ushort-8-rep [ 8 c::ushort <c-direct-array> ] }
{ int-4-rep [ 4 c::int <c-direct-array> ] }
{ uint-4-rep [ 4 c::uint <c-direct-array> ] }
{ longlong-2-rep [ 2 c::longlong <c-direct-array> ] }
{ ulonglong-2-rep [ 2 c::ulonglong <c-direct-array> ] }
{ float-4-rep [ 4 c::float <c-direct-array> ] }
{ double-2-rep [ 2 c::double <c-direct-array> ] }
{ char-16-rep [ 16 c:char <c-direct-array> ] }
{ uchar-16-rep [ 16 c:uchar <c-direct-array> ] }
{ short-8-rep [ 8 c:short <c-direct-array> ] }
{ ushort-8-rep [ 8 c:ushort <c-direct-array> ] }
{ int-4-rep [ 4 c:int <c-direct-array> ] }
{ uint-4-rep [ 4 c:uint <c-direct-array> ] }
{ longlong-2-rep [ 2 c:longlong <c-direct-array> ] }
{ ulonglong-2-rep [ 2 c:ulonglong <c-direct-array> ] }
{ float-4-rep [ 4 c:float <c-direct-array> ] }
{ double-2-rep [ 2 c:double <c-direct-array> ] }
} case ; inline
: >rep-array ( seq rep -- array )
{
{ char-16-rep [ c::char >c-array ] }
{ uchar-16-rep [ c::uchar >c-array ] }
{ short-8-rep [ c::short >c-array ] }
{ ushort-8-rep [ c::ushort >c-array ] }
{ int-4-rep [ c::int >c-array ] }
{ uint-4-rep [ c::uint >c-array ] }
{ longlong-2-rep [ c::longlong >c-array ] }
{ ulonglong-2-rep [ c::ulonglong >c-array ] }
{ float-4-rep [ c::float >c-array ] }
{ double-2-rep [ c::double >c-array ] }
{ char-16-rep [ c:char >c-array ] }
{ uchar-16-rep [ c:uchar >c-array ] }
{ short-8-rep [ c:short >c-array ] }
{ ushort-8-rep [ c:ushort >c-array ] }
{ int-4-rep [ c:int >c-array ] }
{ uint-4-rep [ c:uint >c-array ] }
{ longlong-2-rep [ c:longlong >c-array ] }
{ ulonglong-2-rep [ c:ulonglong >c-array ] }
{ float-4-rep [ c:float >c-array ] }
{ double-2-rep [ c:double >c-array ] }
} case ; inline
: <rep-array> ( rep -- array )
{
{ char-16-rep [ 16 c::char (c-array) ] }
{ uchar-16-rep [ 16 c::uchar (c-array) ] }
{ short-8-rep [ 8 c::short (c-array) ] }
{ ushort-8-rep [ 8 c::ushort (c-array) ] }
{ int-4-rep [ 4 c::int (c-array) ] }
{ uint-4-rep [ 4 c::uint (c-array) ] }
{ longlong-2-rep [ 2 c::longlong (c-array) ] }
{ ulonglong-2-rep [ 2 c::ulonglong (c-array) ] }
{ float-4-rep [ 4 c::float (c-array) ] }
{ double-2-rep [ 2 c::double (c-array) ] }
{ char-16-rep [ 16 c:char (c-array) ] }
{ uchar-16-rep [ 16 c:uchar (c-array) ] }
{ short-8-rep [ 8 c:short (c-array) ] }
{ ushort-8-rep [ 8 c:ushort (c-array) ] }
{ int-4-rep [ 4 c:int (c-array) ] }
{ uint-4-rep [ 4 c:uint (c-array) ] }
{ longlong-2-rep [ 2 c:longlong (c-array) ] }
{ ulonglong-2-rep [ 2 c:ulonglong (c-array) ] }
{ float-4-rep [ 4 c:float (c-array) ] }
{ double-2-rep [ 2 c:double (c-array) ] }
} case ; inline
: rep-tf-values ( rep -- t f )
@ -158,14 +158,14 @@ PRIVATE>
] unrolled-each-unsafe
c' underlying>> ;
: (simd-vs+) ( a b rep -- c )
dup rep-component-type '[ + _ c::c-type-clamp ] components-2map ;
dup rep-component-type '[ + _ c:c-type-clamp ] components-2map ;
: (simd-vs-) ( a b rep -- c )
dup rep-component-type '[ - _ c::c-type-clamp ] components-2map ;
dup rep-component-type '[ - _ c:c-type-clamp ] components-2map ;
: (simd-vs*) ( a b rep -- c )
dup rep-component-type '[ * _ c::c-type-clamp ] components-2map ;
dup rep-component-type '[ * _ c:c-type-clamp ] components-2map ;
: (simd-v*) ( a b rep -- c ) [ * ] components-2map ;
: (simd-v*high) ( a b rep -- c )
dup rep-component-type c::heap-size -8 * '[ * _ shift ] components-2map ;
dup rep-component-type c:heap-size -8 * '[ * _ shift ] components-2map ;
:: (simd-v*hs+) ( a b rep -- c )
rep { char-16-rep uchar-16-rep } member-eq?
[ uchar-16-rep char-16-rep ]
@ -177,7 +177,7 @@ PRIVATE>
a' b' rep rep-length 2 /i [
[ [ first ] bi@ * ]
[ [ second ] bi@ * ] 2bi +
wide-type c::c-type-clamp
wide-type c:c-type-clamp
] wide-rep <rep-array> unrolled-2map-as-unsafe underlying>> ;
: (simd-v/) ( a b rep -- c ) [ native/ ] components-2map ;
: (simd-vavg) ( a b rep -- c )
@ -257,11 +257,11 @@ PRIVATE>
: (simd-vpack-signed) ( a b rep -- c )
[ [ 2byte>rep-array cord-append ] [ rep-length 2 * ] bi ]
[ narrow-vector-rep [ <rep-array> ] [ rep-component-type ] bi ] bi
'[ _ c::c-type-clamp ] swap unrolled-map-as-unsafe underlying>> ;
'[ _ c:c-type-clamp ] swap unrolled-map-as-unsafe underlying>> ;
: (simd-vpack-unsigned) ( a b rep -- c )
[ [ 2byte>rep-array cord-append ] [ rep-length 2 * ] bi ]
[ narrow-vector-rep >uint-vector-rep [ <rep-array> ] [ rep-component-type ] bi ] bi
'[ _ c::c-type-clamp ] swap unrolled-map-as-unsafe underlying>> ;
'[ _ c:c-type-clamp ] swap unrolled-map-as-unsafe underlying>> ;
: (simd-vunpack-head) ( a rep -- c )
[ byte>rep-array ] [ widen-vector-rep [ rep-length ] [ '[ _ >rep-array ] ] bi ] bi
[ head-slice ] dip call( a' -- c' ) underlying>> ;

View File

@ -9,7 +9,7 @@ quotations math.constants compiler.units splitting math.matrices
math.vectors.simd.cords alien.data ;
FROM: math.vectors.simd.intrinsics => alien-vector set-alien-vector ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: c::float
SPECIALIZED-ARRAY: c:float
IN: math.vectors.simd.tests
! Test type propagation
@ -723,10 +723,10 @@ STRUCT: simd-struct
[ 5.0 float-4{ 1 2 3 4 } float-4{ 4 5 6 7 } 0.0 simd-spill-test-2 ] unit-test
: callback-1 ( -- c )
c::int { c::int c::int c::int c::int c::int } cdecl [ + + + + ] alien-callback ;
c:int { c:int c:int c:int c:int c:int } cdecl [ + + + + ] alien-callback ;
: indirect-1 ( x x x x x c -- y )
c::int { c::int c::int c::int c::int c::int } cdecl alien-indirect ; inline
c:int { c:int c:int c:int c:int c:int } cdecl alien-indirect ; inline
: simd-spill-test-3 ( a b d c -- v )
{ float float-4 float-4 float } declare
@ -740,9 +740,9 @@ STRUCT: simd-struct
! aligned right
: simd-stack-test ( -- b c )
{ c::int float-4 } [
[ 123 swap 0 c::int c::set-alien-value ]
[ float-4{ 1 2 3 4 } swap 0 float-4 c::set-alien-value ] bi*
{ c:int float-4 } [
[ 123 swap 0 c:int c:set-alien-value ]
[ float-4{ 1 2 3 4 } swap 0 float-4 c:set-alien-value ] bi*
] with-out-parameters ;
{ 123 float-4{ 1 2 3 4 } } [ simd-stack-test ] unit-test
@ -752,8 +752,8 @@ STRUCT: simd-struct
: (simd-stack-spill-test) ( -- n ) 17 ;
: simd-stack-spill-test ( x -- b c )
{ c::int } [
123 swap 0 c::int c::set-alien-value
{ c:int } [
123 swap 0 c:int c:set-alien-value
>float (simd-stack-spill-test) float-4-with swap cos v*n
] with-out-parameters ;

View File

@ -30,10 +30,10 @@ PRIVATE>
! Helper for boolean vector literals
: vector-true-value ( class -- value )
{ c::float c::double } member? [ -1 bits>double ] [ -1 ] if ; foldable
{ c:float c:double } member? [ -1 bits>double ] [ -1 ] if ; foldable
: vector-false-value ( type -- value )
{ c::float c::double } member? [ 0.0 ] [ 0 ] if ; foldable
{ c:float c:double } member? [ 0.0 ] [ 0 ] if ; foldable
: boolean>element ( bool/elt type -- elt )
swap {
@ -276,7 +276,7 @@ INLINE-FUNCTOR: simd-128-type ( type: name -- ) [[
! ELT [ A-rep rep-component-type ]
! N [ A-rep rep-length ]
! COERCER [ A-rep rep-component-type c::c-type-class "coercer" word-prop [ ] or ]
! COERCER [ A-rep rep-component-type c:c-type-class "coercer" word-prop [ ] or ]
! BOA-EFFECT [ A-rep rep-length "n" <array> { "v" } <effect> ]
@ -287,7 +287,7 @@ TUPLE: ${type} < simd-128 ; final
>>
<<
c::<c-type>
c:<c-type>
byte-array >>class
${type} >>boxed-class
{ ${type}-rep alien-vector ${type} boa } >quotation >>getter
@ -298,11 +298,11 @@ c::<c-type>
16 >>size
16 >>align
${type}-rep >>rep
\ ${type} c::typedef
\ ${type} c:typedef
>>
<<
: ${type}-coercer ( -- m ) ${type}-rep rep-component-type c::c-type-class "coercer" word-prop [ ] or ; inline
: ${type}-coercer ( -- m ) ${type}-rep rep-component-type c:c-type-class "coercer" word-prop [ ] or ; inline
>>
: ${type}-with ( n -- v ) $[ ${type}-coercer ] call \ ${type}-rep (simd-with) \ ${type} boa ; inline
: ${type}-cast ( v -- v' ) underlying>> \ ${type} boa ; inline
@ -318,7 +318,7 @@ M: ${type} nth-unsafe
swap \ ${type}-rep [ (simd-select) ] [ call-next-method ] vx->x-op ; inline
M: ${type} set-nth-unsafe
[ ${type} boolean>element ] 2dip
underlying>> $[ ${type}-rep rep-component-type ] c::set-alien-element ; inline
underlying>> $[ ${type}-rep rep-component-type ] c:set-alien-element ; inline
M: ${type} like drop dup \ ${type} instance? [ >${type} ] unless ; inline

View File

@ -3,6 +3,7 @@
USING: arrays alien.c-types assocs kernel sequences math
math.functions grouping math.order math.libm math.floats.private
fry combinators byte-arrays accessors locals ;
QUALIFIED-WITH: alien.c-types c
IN: math.vectors
GENERIC: vneg ( v -- w )

File diff suppressed because it is too large Load Diff

View File

@ -111,9 +111,9 @@ TUPLE: peg-head rule-id involved-set eval-set ;
: process-rule-result ( p result -- result )
[
nip [ ast>> ] [ remaining>> ] bi input-from pos namespaces::set
nip [ ast>> ] [ remaining>> ] bi input-from pos namespaces:set
] [
pos namespaces::set fail
pos namespaces:set fail
] if* ;
: eval-rule ( rule -- ast )
@ -138,7 +138,7 @@ TUPLE: peg-head rule-id involved-set eval-set ;
pos>> <= or ;
: setup-growth ( h p -- )
pos namespaces::set dup involved-set>> clone >>eval-set drop ;
pos namespaces:set dup involved-set>> clone >>eval-set drop ;
: (grow-lr) ( h p r: ( -- result ) m -- )
[ [ setup-growth ] 2keep ] 2dip
@ -154,7 +154,7 @@ TUPLE: peg-head rule-id involved-set eval-set ;
[ [ heads set-at ] 2keep ] 2dip
pick over [ (grow-lr) ] 2dip
swap heads delete-at
dup pos>> pos namespaces::set ans>>
dup pos>> pos namespaces:set ans>>
; inline
:: (setup-lr) ( l s -- )
@ -208,9 +208,9 @@ TUPLE: peg-head rule-id involved-set eval-set ;
:: apply-non-memo-rule ( r p -- ast )
fail r rule-id f lrstack get left-recursion boa :> lr
lr lrstack namespaces::set lr p memo-entry boa dup p r rule-id set-memo :> m
lr lrstack namespaces:set lr p memo-entry boa dup p r rule-id set-memo :> m
r eval-rule :> ans
lrstack get next>> lrstack namespaces::set
lrstack get next>> lrstack namespaces:set
pos get m pos<<
lr head>> [
m ans>> left-recursion? [
@ -223,7 +223,7 @@ TUPLE: peg-head rule-id involved-set eval-set ;
] if ; inline
: apply-memo-rule ( r m -- ast )
[ ans>> ] [ pos>> ] bi pos namespaces::set
[ ans>> ] [ pos>> ] bi pos namespaces:set
dup left-recursion? [
[ setup-lr ] keep seed>>
] [
@ -500,7 +500,7 @@ TUPLE: sp-parser parser ;
M: sp-parser (compile)
parser>> compile-parser-quot '[
input-slice [ blank? ] trim-head-slice input-from pos namespaces::set @
input-slice [ blank? ] trim-head-slice input-from pos namespaces:set @
] ;
TUPLE: delay-parser quot ;

View File

@ -231,7 +231,7 @@ M: callable >pprint-sequence ;
M: hashtable >pprint-sequence >alist ;
M: wrapper >pprint-sequence wrapped>> 1array ;
M: callstack >pprint-sequence callstack>array ;
M: hash-set >pprint-sequence sets::members ;
M: hash-set >pprint-sequence sets:members ;
M: anonymous-union >pprint-sequence members>> ;
M: anonymous-intersection >pprint-sequence participants>> ;
M: anonymous-complement >pprint-sequence class>> 1array ;

View File

@ -327,8 +327,8 @@ SYMBOL: next
: group-flow ( seq -- newseq )
[
dup length <iota> [
2dup 1 - swap ?nth prev namespaces::set
2dup 1 + swap ?nth next namespaces::set
2dup 1 - swap ?nth prev namespaces:set
2dup 1 + swap ?nth next namespaces:set
swap nth dup split-before dup , split-after
] with each
] { } make { t } split harvest ;
@ -359,10 +359,10 @@ M: block long-section ( block -- )
: make-pprint ( obj quot manifest? -- block manifest/f )
[
0 position namespaces::set
HS{ } clone pprinter-use namespaces::set
V{ } clone recursion-check namespaces::set
V{ } clone pprinter-stack namespaces::set
0 position namespaces:set
HS{ } clone pprinter-use namespaces:set
V{ } clone recursion-check namespaces:set
V{ } clone pprinter-stack namespaces:set
[ over <object call pprinter-block ] dip
[ pprinter-manifest ] [ f ] if

View File

@ -7,7 +7,7 @@ io.binary kernel locals math math.bitwise math.constants
math.functions math.order math.ranges namespaces sequences
sequences.private sets summary system typed vocabs ;
QUALIFIED-WITH: alien.c-types c
QUALIFIED: sets
QUALIFIED-WITH: sets sets
IN: random
SYMBOL: system-random-generator
@ -22,13 +22,13 @@ M: object random-bytes*
[ integer>fixnum-strict [ (byte-array) ] keep ] dip
[ over 4 >= ] [
[ 4 - ] dip
[ random-32* 2over c::int c::set-alien-value ] keep
[ random-32* 2over c:int c:set-alien-value ] keep
] while over zero? [ 2drop ] [
random-32* c::int <ref> swap head 0 pick copy-unsafe
random-32* c:int <ref> swap head 0 pick copy-unsafe
] if ;
M: object random-32*
4 swap random-bytes* c::uint deref ;
4 swap random-bytes* c:uint deref ;
ERROR: no-random-number-generator ;
@ -105,7 +105,7 @@ M: hashtable random
[ array-nth ] [ [ 1 + ] dip array-nth ] 2bi 2array
] if-zero ;
M: sets::set random members random ;
M: sets:set random members random ;
M: hash-set random
dup cardinality [ drop f ] [

View File

@ -156,8 +156,8 @@ M: with-options nfa-node ( node -- start end )
: construct-nfa ( ast -- nfa-table )
[
0 state namespaces::set
<transition-table> nfa-table namespaces::set
0 state namespaces:set
<transition-table> nfa-table namespaces:set
nfa-node
nfa-table get
swap 1array fast-set >>final-states

View File

@ -20,8 +20,8 @@ GENERIC: see* ( defspec -- )
: synopsis ( defspec -- str )
[
string-limit? off
0 margin namespaces::set
1 line-limit namespaces::set
0 margin namespaces:set
1 line-limit namespaces:set
[ synopsis* ] with-in
] with-string-writer ;
@ -46,7 +46,7 @@ M: word print-stack-effect? drop t ;
<PRIVATE
: seeing-word ( word -- )
vocabulary>> dup [ lookup-vocab ] when pprinter-in namespaces::set ;
vocabulary>> dup [ lookup-vocab ] when pprinter-in namespaces:set ;
: word-synopsis ( word -- )
{
@ -92,8 +92,8 @@ M: pathname synopsis* pprint* ;
M: alias summary
[
0 margin namespaces::set
1 line-limit namespaces::set
0 margin namespaces:set
1 line-limit namespaces:set
[
{
[ seeing-word ]
@ -128,8 +128,8 @@ M: word declarations.
M: object see*
[
12 nesting-limit namespaces::set
100 length-limit namespaces::set
12 nesting-limit namespaces:set
100 length-limit namespaces:set
<colon dup synopsis*
<block dup definition pprint-elements block>
dup definer nip [ pprint-word ] when* declarations.

View File

@ -1,7 +1,7 @@
USING: specialized-arrays sequences.complex
kernel sequences tools.test arrays accessors ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: c::float
SPECIALIZED-ARRAY: c:float
IN: sequences.complex.tests
: test-array ( -- x )

View File

@ -96,5 +96,5 @@ TUPLE: tuple2 d ;
{ { { "apples" 1 } { "bananas" 2 } { "cherries" 3 } } } [
H{ { "apples" 1 } { "bananas" 2 } { "cherries" 3 } }
{ { sequences::length <=> } } sort-keys-by
{ { sequences:length <=> } } sort-keys-by
] unit-test

View File

@ -3,52 +3,55 @@
USING: alien.parser arrays functors2 growable kernel lexer make
math.parser sequences vocabs.loader ;
FROM: sequences.private => nth-unsafe ;
QUALIFIED: vectors.functor
IN: specialized-vectors
MIXIN: specialized-vector
FUNCTOR: specialized-vector ( type: existing-word -- ) [[
USING: accessors alien alien.c-types alien.data classes growable
kernel math parser prettyprint.custom sequences
sequences.private specialized-arrays specialized-arrays.private
specialized-vectors vectors.functor ;
FROM: specialized-arrays.private => nth-c-ptr direct-like ;
<<
SPECIALIZED-ARRAY: ${type}
>>
USING: accessors alien alien.c-types alien.data classes growable
kernel math parser prettyprint.custom sequences
sequences.private specialized-arrays specialized-arrays.private
specialized-vectors vectors.functor ;
FROM: specialized-arrays.private => nth-c-ptr direct-like ;
<<
! For >foo-vector to be defined in time
VECTORIZED: ${type} ${type}-array <${type}-array>
>>
<<
SPECIALIZED-ARRAY: ${type}
>>
SYNTAX: ${type}-vector{ \ } [ >${type}-vector ] parse-literal ;
<<
! For >foo-vector to be defined in time
VECTORIZED: ${type} ${type}-array <${type}-array>
>>
INSTANCE: ${type}-vector specialized-vector
SYNTAX: ${type}-vector{ \ } [ >${type}-vector ] parse-literal ;
M: ${type}-vector contract 2drop ; inline
INSTANCE: ${type}-vector specialized-vector
M: ${type}-vector element-size drop \ ${type} heap-size ; inline
M: ${type}-vector contract 2drop ; inline
M: ${type}-vector pprint-delims drop \ ${type}-vector{ \ } ;
M: ${type}-vector element-size drop \ ${type} heap-size ; inline
M: ${type}-vector >pprint-sequence ;
M: ${type}-vector pprint-delims drop \ ${type}-vector{ \ } ;
M: ${type}-vector pprint* pprint-object ;
M: ${type}-vector >pprint-sequence ;
M: ${type}-vector >c-ptr underlying>> underlying>> ; inline
M: ${type}-vector byte-length [ length ] [ element-size ] bi * ; inline
M: ${type}-vector pprint* pprint-object ;
M: ${type}-vector direct-like drop <direct-${type}-array> ; inline
M: ${type}-vector nth-c-ptr underlying>> nth-c-ptr ; inline
M: ${type}-vector >c-ptr underlying>> underlying>> ; inline
M: ${type}-vector byte-length [ length ] [ element-size ] bi * ; inline
M: ${type}-vector direct-like drop <direct-${type}-array> ; inline
M: ${type}-vector nth-c-ptr underlying>> nth-c-ptr ; inline
M: ${type}-array like
drop dup ${type}-array instance? [
dup ${type}-vector instance? [
[ >c-ptr ] [ length>> ] bi <direct-${type}-array>
] [ \ ${type} >c-array ] if
] unless ; inline
M: ${type}-array like
drop dup ${type}-array instance? [
dup ${type}-vector instance? [
[ >c-ptr ] [ length>> ] bi <direct-${type}-array>
] [ \ ${type} >c-array ] if
] unless ; inline
]]
<PRIVATE

View File

@ -1,4 +1,5 @@
USING: assocs kernel sequences tools.completion tools.test ;
USING: assocs kernel sequences tools.test ;
IN: tools.completion
{ f } [ "abc" "def" fuzzy ] unit-test
{ V{ 4 5 6 } } [ "set-nth" "nth" fuzzy ] unit-test

View File

@ -1,10 +1,13 @@
! Copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: cocoa.application cocoa.plists combinators io.backend
io.directories io.directories.hierarchy io.files
io.files.info.unix io.pathnames kernel make namespaces sequences
system tools.deploy.backend tools.deploy.config
tools.deploy.config.editor vocabs.loader ;
USING: io io.files io.files.info.unix io.pathnames
io.directories io.directories.hierarchy kernel namespaces make
sequences system tools.deploy.backend tools.deploy.config
tools.deploy.config.editor assocs hashtables prettyprint
io.backend.unix cocoa io.encodings.utf8 io.backend
cocoa.application cocoa.classes cocoa.plists
combinators vocabs.metadata vocabs.loader webbrowser ;
QUALIFIED-WITH: tools.deploy.unix unix
IN: tools.deploy.macosx
: bundle-dir ( -- dir )

View File

@ -311,11 +311,11 @@ IN: tools.deploy.shaker
[
"inspector-hook" "inspector" lookup-word ,
{
source-files::source-files
continuations::error
continuations::error-continuation
continuations::error-thread
continuations::restarts
source-files:source-files
continuations:error
continuations:error-continuation
continuations:error-thread
continuations:restarts
} %
"disposables" "destructors" lookup-word ,
@ -345,30 +345,30 @@ IN: tools.deploy.shaker
{
gensym
name>char-hook
classes.private::next-method-quot-cache
classes.private::class-and-cache
classes.private::class-not-cache
classes.private::class-or-cache
classes.private::class<=-cache
classes.private::classes-intersect-cache
classes.private::implementors-map
classes.private::update-map
classes.private:next-method-quot-cache
classes.private:class-and-cache
classes.private:class-not-cache
classes.private:class-or-cache
classes.private:class<=-cache
classes.private:classes-intersect-cache
classes.private:implementors-map
classes.private:update-map
main-vocab-hook
compiler.crossref::compiled-crossref
compiler.crossref::generic-call-site-crossref
compiler.crossref:compiled-crossref
compiler.crossref:generic-call-site-crossref
compiler-impl
compiler.errors::compiler-errors
compiler.errors:compiler-errors
print-use-hook
root-cache
require-when-vocabs
require-when-table
source-files.errors::error-types
source-files.errors::error-observers
vocabs::dictionary
vocabs::require-hook
vocabs::vocab-observers
vocabs.loader::add-vocab-root-hook
vocabs.parser::manifest
source-files.errors:error-types
source-files.errors:error-observers
vocabs:dictionary
vocabs:require-hook
vocabs:vocab-observers
vocabs.loader:add-vocab-root-hook
vocabs.parser:manifest
word
parser-quiet?
} %
@ -387,7 +387,7 @@ IN: tools.deploy.shaker
] when
strip-debugger? [
\ compiler.errors::compiler-errors ,
\ compiler.errors:compiler-errors ,
] when
] { } make ;
@ -395,7 +395,7 @@ IN: tools.deploy.shaker
[
{
init::startup-hooks
init:startup-hooks
input-stream
output-stream
error-stream
@ -634,7 +634,7 @@ SYMBOL: deploy-vocab
"ui.debugger" require
] when
] unless
[ deploy-vocab namespaces::set ] [ require ] [
[ deploy-vocab namespaces:set ] [ require ] [
vocab-main [
"Vocabulary has no MAIN: word." print flush 1 exit
] unless

View File

@ -1,10 +1,13 @@
! Copyright (C) 2013 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
USING: accessors alien.c-types alien.data alien.syntax arrays
assocs byte-arrays classes.struct continuations fry grouping
kernel libc literals math sequences splitting strings system
system-info.macosx tools.ps unix unix.time unix.types ;
QUALIFIED-WITH: alien.c-types c
IN: tools.ps.macosx
<PRIVATE
@ -36,7 +39,7 @@ STRUCT: _pcred
STRUCT: _ucred
{ cr_ref int32_t }
{ cr_uid uid_t }
{ cr_ngroups c::short }
{ cr_ngroups c:short }
{ cr_groups gid_t[16] } ;
STRUCT: vmspace
@ -106,15 +109,15 @@ STRUCT: kinfo_proc
{ e_vm vmspace }
{ e_ppid pid_t }
{ e_pgid pid_t }
{ e_joc c::short }
{ e_joc c:short }
{ e_tdev dev_t }
{ e_tpgid pid_t }
{ e_tsess void* }
{ e_mesg char[8] }
{ e_xsize segsz_t }
{ e_xrssize c::short }
{ e_xccount c::short }
{ e_xswrss c::short }
{ e_xrssize c:short }
{ e_xccount c:short }
{ e_xswrss c:short }
{ e_flag int32_t }
{ e_login char[12] }
{ e_spare int32_t[4] } ;

View File

@ -57,7 +57,7 @@ CONSTANT: attrib-table H{
: arb-make-pixel-format ( world attributes -- pf )
[ handle>> hDC>> ] dip
perm-attribs attrib-table pixel-format-attributes>int-array
f 1 { c::int c::int }
f 1 { c:int c:int }
[ wglChoosePixelFormatARB win32-error=0/f ] with-out-parameters drop ;
CONSTANT: pfd-flag-map H{
@ -84,7 +84,7 @@ CONSTANT: pfd-flag-map H{
: >pfd ( attributes -- pfd )
[ PIXELFORMATDESCRIPTOR <struct> ] dip
{
[ drop PIXELFORMATDESCRIPTOR c::heap-size >>nSize ]
[ drop PIXELFORMATDESCRIPTOR c:heap-size >>nSize ]
[ drop 1 >>nVersion ]
[ >pfd-flags >>dwFlags ]
[ drop PFD_TYPE_RGBA >>iPixelType ]
@ -434,7 +434,7 @@ SYMBOL: nc-buttons
drop
] [
[ SetCapture drop ] keep
mouse-captured namespaces::set
mouse-captured namespaces:set
] if ;
: release-capture ( -- )
@ -466,7 +466,7 @@ SYMBOL: nc-buttons
: make-TRACKMOUSEEVENT ( hWnd -- alien )
TRACKMOUSEEVENT <struct>
swap >>hwndTrack
TRACKMOUSEEVENT c::heap-size >>cbSize ;
TRACKMOUSEEVENT c:heap-size >>cbSize ;
: handle-wm-mousemove ( hWnd uMsg wParam lParam -- )
2nip
@ -554,10 +554,15 @@ SYMBOL: trace-messages?
! return 0 if you handle the message, else just let DefWindowProc return its val
: ui-wndproc ( -- object )
c::uint { c::void* c::uint WPARAM LPARAM } stdcall [
pick wm-handlers get-global at*
[ flush call( hWnd Msg wParam lParam -- result ) ] [ drop DefWindowProc ] if
] alien-callback ;
c:uint { c:void* c:uint WPARAM LPARAM } stdcall [
pick
trace-messages? get-global
[ dup windows-message-name name>> print flush ] when
wm-handlers get-global at*
[ call( hWnd Msg wParam lParam -- result ) ] [ drop DefWindowProc ] if
] alien-callback ;
: peek-message? ( msg -- ? ) f 0 0 PM_REMOVE PeekMessage zero? ;
@ -571,7 +576,7 @@ M: windows-ui-backend do-events
:: register-window-class ( class-name-ptr -- )
WNDCLASSEX <struct> f GetModuleHandle
class-name-ptr pick GetClassInfoEx 0 = [
WNDCLASSEX c::heap-size >>cbSize
WNDCLASSEX c:heap-size >>cbSize
flags{ CS_HREDRAW CS_VREDRAW CS_OWNDC } >>style
ui-wndproc >>lpfnWndProc
0 >>cbClsExtra
@ -715,7 +720,7 @@ M: windows-ui-backend system-alert
: fullscreen-RECT ( hwnd -- RECT )
MONITOR_DEFAULTTONEAREST MonitorFromWindow
MONITORINFOEX <struct>
MONITORINFOEX c::heap-size >>cbSize
MONITORINFOEX c:heap-size >>cbSize
[ GetMonitorInfo win32-error=0/f ] keep rcMonitor>> ;
: client-area>RECT ( hwnd -- RECT )

View File

@ -395,7 +395,7 @@ editor "editing" f {
: com-paste ( editor -- ) clipboard get paste-clipboard ;
: paste-selection ( editor -- ) ui.clipboards::selection get paste-clipboard ;
: paste-selection ( editor -- ) ui.clipboards:selection get paste-clipboard ;
: com-cut ( editor -- ) clipboard get editor-cut ;

View File

@ -271,10 +271,10 @@ SYMBOL: drag-timer
dup multi-click? [
hand-click# inc
] [
1 hand-click# namespaces::set
1 hand-click# namespaces:set
] if
hand-last-button namespaces::set
nano-count hand-last-time namespaces::set
hand-last-button namespaces:set
nano-count hand-last-time namespaces:set
] with-global ;
: update-clicked ( -- )

View File

@ -20,11 +20,11 @@ SYMBOL: viewport-translation
: init-clip ( gadget -- )
[
dim>>
[ { 0 1 } v* viewport-translation namespaces::set ]
[ { 0 1 } v* viewport-translation namespaces:set ]
[ [ { 0 0 } ] dip gl-viewport ]
[ [ 0 ] dip first2 0 1 -1 glOrtho ] tri
]
[ clip namespaces::set ] bi
[ clip namespaces:set ] bi
do-clip ;
SLOT: background-color
@ -87,7 +87,7 @@ M: gadget gadget-foreground dup interior>> pen-foreground ;
<PRIVATE
: draw-selection-background ( gadget -- )
selection-background get background namespaces::set
selection-background get background namespaces:set
selection-background get gl-color
[ { 0 0 } ] dip dim>> gl-fill-rect ;
@ -123,7 +123,7 @@ PRIVATE>
: with-clipping ( gadget quot -- )
clip get [ over change-clip do-clip call ] dip
clip namespaces::set do-clip ; inline
clip namespaces:set do-clip ; inline
: draw-gadget ( gadget -- )
{
@ -142,10 +142,10 @@ M: gadget draw-children
} cleave [
{
[ [ selected-gadgets namespaces::set ] when* ]
[ [ selection-background namespaces::set ] when* ]
[ [ background namespaces::set ] when* ]
[ [ foreground namespaces::set ] when* ]
[ [ selected-gadgets namespaces:set ] when* ]
[ [ selection-background namespaces:set ] when* ]
[ [ background namespaces:set ] when* ]
[ [ foreground namespaces:set ] when* ]
} spread
[ draw-gadget ] each
] with-scope

View File

@ -28,7 +28,7 @@ M: stack-entry-renderer row-value drop object>> ;
40 >>min-cols
40 >>max-cols
monospace-font >>font
[ i::inspector ] >>action
[ i:inspector ] >>action
t >>single-click? ;
: <stack-display> ( model quot title color -- gadget )
@ -68,13 +68,13 @@ TUPLE: traceback-gadget < tool ;
add-toolbar ;
: variables ( traceback -- )
model>> [ dup [ name>> vars-in-scope ] when ] <arrow> i::inspect-model ;
model>> [ dup [ name>> vars-in-scope ] when ] <arrow> i:inspect-model ;
: traceback-window ( continuation -- )
<model> <traceback-gadget> "Traceback" open-status-window ;
: inspect-continuation ( traceback -- )
control-value i::inspector ;
control-value i:inspector ;
traceback-gadget "toolbar" f {
{ T{ key-down f f "v" } variables }

View File

@ -2,6 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.short-circuit kernel locals namespaces sbufs
sequences splitting unicode.categories unicode.data ;
QUALIFIED: ascii
IN: unicode.case
SYMBOL: locale ! Just casing locale, or overall?

View File

@ -33,7 +33,7 @@ CONSTANT: name-map H{ }
: combining-class ( char -- n ) class-map at ; inline
: non-starter? ( char -- ? ) combining-class { 0 f } member? not ; inline
: property ( property -- interval-map ) properties at ; foldable
: property? ( char property -- ? ) property interval-sets::in? ; inline
: property? ( char property -- ? ) property interval-sets:in? ; inline
: special-case ( ch -- casing-tuple ) special-casing at ; inline
! For non-existent characters, use Cn

View File

@ -18,7 +18,7 @@ GENERIC: group-struct ( obj -- group/f )
gr_mem>> utf8 alien>strings ;
: (group-struct) ( id -- group-struct id group-struct byte-array length void* )
[ unix.ffi::group <struct> ] dip over 4096
[ unix.ffi:group <struct> ] dip over 4096
[ <byte-array> ] keep f void* <ref> ;
: check-group-struct ( group-struct ptr -- group-struct/f )
@ -26,12 +26,12 @@ GENERIC: group-struct ( obj -- group/f )
M: integer group-struct ( id -- group/f )
(group-struct)
[ [ unix.ffi::getgrgid_r ] unix-system-call drop ] keep
[ [ unix.ffi:getgrgid_r ] unix-system-call drop ] keep
check-group-struct ;
M: string group-struct ( string -- group/f )
(group-struct)
[ [ unix.ffi::getgrnam_r ] unix-system-call drop ] keep
[ [ unix.ffi:getgrnam_r ] unix-system-call drop ] keep
check-group-struct ;
: group-struct>group ( group-struct -- group )
@ -64,12 +64,12 @@ ERROR: no-group string ;
<PRIVATE
: >groups ( byte-array n -- groups )
[ 4 grouping::group ] dip head-slice [ uint deref group-name ] map ;
[ 4 grouping:group ] dip head-slice [ uint deref group-name ] map ;
: (user-groups) ( string -- seq )
dup user-passwd [
gid>> 64 [ 4 * <byte-array> ] keep
int <ref> [ [ unix.ffi::getgrouplist ] unix-system-call drop ] 2keep
int <ref> [ [ unix.ffi:getgrouplist ] unix-system-call drop ] 2keep
int deref >groups
] [
drop { }
@ -86,7 +86,7 @@ M: integer user-groups ( id -- seq )
user-name (user-groups) ;
: all-groups ( -- seq )
[ unix.ffi::getgrent dup ] [ group-struct>group ] produce nip
[ unix.ffi:getgrent dup ] [ group-struct>group ] produce nip
endgrent ;
: all-group-names ( -- seq )
@ -98,11 +98,11 @@ M: integer user-groups ( id -- seq )
: with-group-cache ( quot -- )
[ <group-cache> group-cache ] dip with-variable ; inline
: real-group-id ( -- id ) unix.ffi::getgid ; inline
: real-group-id ( -- id ) unix.ffi:getgid ; inline
: real-group-name ( -- string ) real-group-id group-name ; inline
: effective-group-id ( -- string ) unix.ffi::getegid ; inline
: effective-group-id ( -- string ) unix.ffi:getegid ; inline
: effective-group-name ( -- string )
effective-group-id group-name ; inline
@ -130,10 +130,10 @@ GENERIC: set-effective-group ( obj -- )
<PRIVATE
: (set-real-group) ( id -- )
[ unix.ffi::setgid ] unix-system-call drop ; inline
[ unix.ffi:setgid ] unix-system-call drop ; inline
: (set-effective-group) ( id -- )
[ unix.ffi::setegid ] unix-system-call drop ; inline
[ unix.ffi:setegid ] unix-system-call drop ; inline
PRIVATE>

View File

@ -35,4 +35,4 @@ C-TYPE: rlimit
C-TYPE: rusage
C-TYPE: sockaddr
"unix.types." os name>> sequences::append require
"unix.types." os name>> sequences:append require

View File

@ -32,13 +32,13 @@ M: unix passwd>new-passwd ( passwd -- seq )
: with-pwent ( quot -- )
setpwent
[ unix.ffi::endpwent ] [ ] cleanup ; inline
[ unix.ffi:endpwent ] [ ] cleanup ; inline
PRIVATE>
: all-users ( -- seq )
[
[ unix.ffi::getpwent dup ] [ passwd>new-passwd ] produce nip
[ unix.ffi:getpwent dup ] [ passwd>new-passwd ] produce nip
] with-pwent ;
: all-user-names ( -- seq )
@ -56,10 +56,10 @@ GENERIC: user-passwd ( obj -- passwd/f )
M: integer user-passwd ( id -- passwd/f )
user-cache get
[ at ] [ unix.ffi::getpwuid [ passwd>new-passwd ] [ f ] if* ] if* ;
[ at ] [ unix.ffi:getpwuid [ passwd>new-passwd ] [ f ] if* ] if* ;
M: string user-passwd ( string -- passwd/f )
unix.ffi::getpwnam dup [ passwd>new-passwd ] when ;
unix.ffi:getpwnam dup [ passwd>new-passwd ] when ;
: user-name ( id -- string )
dup user-passwd
@ -74,13 +74,13 @@ ERROR: no-user string ;
dup user-passwd [ nip uid>> ] [ no-user ] if* ;
: real-user-id ( -- id )
unix.ffi::getuid ; inline
unix.ffi:getuid ; inline
: real-user-name ( -- string )
real-user-id user-name ; inline
: effective-user-id ( -- id )
unix.ffi::geteuid ; inline
unix.ffi:geteuid ; inline
: effective-user-name ( -- string )
effective-user-id user-name ; inline
@ -110,10 +110,10 @@ GENERIC: set-effective-user ( string/id -- )
<PRIVATE
: (set-real-user) ( id -- )
[ unix.ffi::setuid ] unix-system-call drop ; inline
[ unix.ffi:setuid ] unix-system-call drop ; inline
: (set-effective-user) ( id -- )
[ unix.ffi::seteuid ] unix-system-call drop ; inline
[ unix.ffi:seteuid ] unix-system-call drop ; inline
PRIVATE>

View File

@ -4,7 +4,7 @@ QUALIFIED: vm
IN: vm.tests
: get-ctx ( -- ctx )
context vm::context memory>struct ;
context vm:context memory>struct ;
{ t } [
get-ctx [ callstack-bottom>> ] [ callstack-top>> ] bi - 0 >

View File

@ -5,7 +5,7 @@ math multiline classes.struct alien.data arrays literals ;
QUALIFIED-WITH: alien.c-types c
IN: windows.kernel32
: lo-word ( wparam -- lo ) c::short <ref> c::short deref ; inline
: lo-word ( wparam -- lo ) c:short <ref> c:short deref ; inline
: hi-word ( wparam -- hi ) -16 shift lo-word ; inline
: >lo-hi ( WORD -- array ) [ lo-word ] [ hi-word ] bi 2array ; inline

View File

@ -121,8 +121,8 @@ DEFER: make-tag ! Is this unavoidable?
: take-internal-subset ( -- dtd )
[
H{ } clone pe-table namespaces::set
t in-dtd? namespaces::set
H{ } clone pe-table namespaces:set
t in-dtd? namespaces:set
dtd-loop
pe-table get
] { } make swap extra-entities get swap <dtd> ;

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