Merge branch 'master' of git://factorcode.org/git/factor
commit
03fc2a3461
|
@ -4,4 +4,9 @@ USING: help.syntax help.markup byte-arrays alien.c-types ;
|
||||||
ARTICLE: "c-arrays" "C arrays"
|
ARTICLE: "c-arrays" "C arrays"
|
||||||
"C arrays are allocated in the same manner as other C data; see " { $link "c-byte-arrays" } " and " { $link "malloc" } "."
|
"C arrays are allocated in the same manner as other C data; see " { $link "c-byte-arrays" } " and " { $link "malloc" } "."
|
||||||
$nl
|
$nl
|
||||||
"C type specifiers for array types are documented in " { $link "c-types-specs" } "." ;
|
"C type specifiers for array types are documented in " { $link "c-types-specs" } "."
|
||||||
|
$nl
|
||||||
|
"Specialized sequences are provided for accessing memory as an array of primitive type values. These sequences are implemented in the " { $vocab-link "specialized-arrays" } " and " { $vocab-link "specialized-arrays.direct" } " vocabulary sets. They can also be loaded and constructed through their primitive C types:"
|
||||||
|
{ $subsection require-c-type-arrays }
|
||||||
|
{ $subsection <c-type-array> }
|
||||||
|
{ $subsection <c-type-direct-array> } ;
|
||||||
|
|
|
@ -29,7 +29,11 @@ M: array box-return drop "void*" box-return ;
|
||||||
|
|
||||||
M: array stack-size drop "void*" stack-size ;
|
M: array stack-size drop "void*" stack-size ;
|
||||||
|
|
||||||
M: array c-type-boxer-quot drop [ ] ;
|
M: array c-type-boxer-quot
|
||||||
|
unclip
|
||||||
|
[ product ]
|
||||||
|
[ [ require-c-type-arrays ] keep ] bi*
|
||||||
|
[ <c-type-direct-array> ] 2curry ;
|
||||||
|
|
||||||
M: array c-type-unboxer-quot drop [ >c-ptr ] ;
|
M: array c-type-unboxer-quot drop [ >c-ptr ] ;
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
IN: alien.c-types
|
IN: alien.c-types
|
||||||
USING: alien help.syntax help.markup libc kernel.private
|
USING: alien help.syntax help.markup libc kernel.private
|
||||||
byte-arrays math strings hashtables alien.syntax alien.strings sequences
|
byte-arrays math strings hashtables alien.syntax alien.strings sequences
|
||||||
io.encodings.string debugger destructors ;
|
io.encodings.string debugger destructors vocabs.loader ;
|
||||||
|
|
||||||
HELP: <c-type>
|
HELP: <c-type>
|
||||||
{ $values { "type" hashtable } }
|
{ $values { "type" hashtable } }
|
||||||
|
@ -128,6 +128,21 @@ HELP: malloc-string
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
|
HELP: require-c-type-arrays
|
||||||
|
{ $values { "c-type" "a C type" } }
|
||||||
|
{ $description { $link require } "s any unloaded vocabularies needed to construct a specialized array or direct array of " { $snippet "c-type" } " using the " { $link <c-type-array> } " or " { $link <c-type-direct-array> } " vocabularies." }
|
||||||
|
{ $notes "This word must be called inside a compilation unit. See the " { $vocab-link "specialized-arrays" } " and " { $vocab-link "specialized-arrays.direct" } " vocabulary sets for details on the underlying sequence types loaded." } ;
|
||||||
|
|
||||||
|
HELP: <c-type-array>
|
||||||
|
{ $values { "len" integer } { "c-type" "a C type" } { "array" "a specialized array" } }
|
||||||
|
{ $description "Constructs a new specialized array of length " { $snippet "len" } " and element type " { $snippet "c-type" } "." }
|
||||||
|
{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-type-arrays } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary set for details on the underlying sequence type constructed." } ;
|
||||||
|
|
||||||
|
HELP: <c-type-direct-array>
|
||||||
|
{ $values { "alien" c-ptr } { "len" integer } { "c-type" "a C type" } { "array" "a specialized direct array" } }
|
||||||
|
{ $description "Constructs a new specialized array of length " { $snippet "len" } " and element type " { $snippet "c-type" } " over the range of memory referenced by " { $snippet "alien" } "." }
|
||||||
|
{ $notes "The appropriate direct specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-type-arrays } " word. See the " { $vocab-link "specialized-arrays.direct" } " vocabulary set for details on the underlying sequence type constructed." } ;
|
||||||
|
|
||||||
ARTICLE: "c-strings" "C strings"
|
ARTICLE: "c-strings" "C strings"
|
||||||
"C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
|
"C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
|
||||||
$nl
|
$nl
|
||||||
|
|
|
@ -5,7 +5,7 @@ namespaces make parser sequences strings words splitting math.parser
|
||||||
cpu.architecture alien alien.accessors alien.strings quotations
|
cpu.architecture alien alien.accessors alien.strings quotations
|
||||||
layouts system compiler.units io io.files io.encodings.binary
|
layouts system compiler.units io io.files io.encodings.binary
|
||||||
io.streams.memory accessors combinators effects continuations fry
|
io.streams.memory accessors combinators effects continuations fry
|
||||||
classes ;
|
classes vocabs vocabs.loader ;
|
||||||
IN: alien.c-types
|
IN: alien.c-types
|
||||||
|
|
||||||
DEFER: <int>
|
DEFER: <int>
|
||||||
|
@ -21,7 +21,12 @@ TUPLE: abstract-c-type
|
||||||
{ getter callable }
|
{ getter callable }
|
||||||
{ setter callable }
|
{ setter callable }
|
||||||
size
|
size
|
||||||
align ;
|
align
|
||||||
|
array-class
|
||||||
|
array-constructor
|
||||||
|
direct-array-class
|
||||||
|
direct-array-constructor
|
||||||
|
sequence-mixin-class ;
|
||||||
|
|
||||||
TUPLE: c-type < abstract-c-type
|
TUPLE: c-type < abstract-c-type
|
||||||
boxer
|
boxer
|
||||||
|
@ -71,6 +76,51 @@ M: string c-type ( name -- type )
|
||||||
] ?if
|
] ?if
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
|
: ?require-word ( word/pair -- )
|
||||||
|
dup word? [ drop ] [ first require ] ?if ;
|
||||||
|
|
||||||
|
GENERIC: require-c-type-arrays ( c-type -- )
|
||||||
|
|
||||||
|
M: object require-c-type-arrays
|
||||||
|
drop ;
|
||||||
|
|
||||||
|
M: c-type require-c-type-arrays
|
||||||
|
[ array-class>> ?require-word ]
|
||||||
|
[ sequence-mixin-class>> ?require-word ]
|
||||||
|
[ direct-array-class>> ?require-word ] tri ;
|
||||||
|
|
||||||
|
M: string require-c-type-arrays
|
||||||
|
c-type require-c-type-arrays ;
|
||||||
|
|
||||||
|
M: array require-c-type-arrays
|
||||||
|
first c-type require-c-type-arrays ;
|
||||||
|
|
||||||
|
ERROR: specialized-array-vocab-not-loaded vocab word ;
|
||||||
|
|
||||||
|
: c-type-array-constructor ( c-type -- word )
|
||||||
|
array-constructor>> dup array?
|
||||||
|
[ first2 specialized-array-vocab-not-loaded ] when ; foldable
|
||||||
|
|
||||||
|
: c-type-direct-array-constructor ( c-type -- word )
|
||||||
|
direct-array-constructor>> dup array?
|
||||||
|
[ first2 specialized-array-vocab-not-loaded ] when ; foldable
|
||||||
|
|
||||||
|
GENERIC: <c-type-array> ( len c-type -- array )
|
||||||
|
M: object <c-type-array>
|
||||||
|
c-type-array-constructor execute( len -- array ) ; inline
|
||||||
|
M: string <c-type-array>
|
||||||
|
c-type <c-type-array> ; inline
|
||||||
|
M: array <c-type-array>
|
||||||
|
first c-type <c-type-array> ; inline
|
||||||
|
|
||||||
|
GENERIC: <c-type-direct-array> ( alien len c-type -- array )
|
||||||
|
M: object <c-type-direct-array>
|
||||||
|
c-type-direct-array-constructor execute( alien len -- array ) ; inline
|
||||||
|
M: string <c-type-direct-array>
|
||||||
|
c-type <c-type-direct-array> ; inline
|
||||||
|
M: array <c-type-direct-array>
|
||||||
|
first c-type <c-type-direct-array> ; inline
|
||||||
|
|
||||||
GENERIC: c-type-class ( name -- class )
|
GENERIC: c-type-class ( name -- class )
|
||||||
|
|
||||||
M: abstract-c-type c-type-class class>> ;
|
M: abstract-c-type c-type-class class>> ;
|
||||||
|
@ -293,6 +343,36 @@ M: long-long-type box-return ( type -- )
|
||||||
: if-void ( type true false -- )
|
: if-void ( type true false -- )
|
||||||
pick "void" = [ drop nip call ] [ nip call ] if ; inline
|
pick "void" = [ drop nip call ] [ nip call ] if ; inline
|
||||||
|
|
||||||
|
: ?lookup ( vocab word -- word/pair )
|
||||||
|
over vocab [ swap lookup ] [ 2array ] if ;
|
||||||
|
|
||||||
|
: set-array-class* ( c-type vocab-stem type-stem -- c-type )
|
||||||
|
{
|
||||||
|
[
|
||||||
|
[ "specialized-arrays." prepend ]
|
||||||
|
[ "-array" append ] bi* ?lookup >>array-class
|
||||||
|
]
|
||||||
|
[
|
||||||
|
[ "specialized-arrays." prepend ]
|
||||||
|
[ "<" "-array>" surround ] bi* ?lookup >>array-constructor
|
||||||
|
]
|
||||||
|
[
|
||||||
|
[ "specialized-arrays." prepend ]
|
||||||
|
[ "-sequence" append ] bi* ?lookup >>sequence-mixin-class
|
||||||
|
]
|
||||||
|
[
|
||||||
|
[ "specialized-arrays.direct." prepend ]
|
||||||
|
[ "direct-" "-array" surround ] bi* ?lookup >>direct-array-class
|
||||||
|
]
|
||||||
|
[
|
||||||
|
[ "specialized-arrays.direct." prepend ]
|
||||||
|
[ "<direct-" "-array>" surround ] bi* ?lookup >>direct-array-constructor
|
||||||
|
]
|
||||||
|
} 2cleave ;
|
||||||
|
|
||||||
|
: set-array-class ( c-type stem -- c-type )
|
||||||
|
dup set-array-class* ;
|
||||||
|
|
||||||
CONSTANT: primitive-types
|
CONSTANT: primitive-types
|
||||||
{
|
{
|
||||||
"char" "uchar"
|
"char" "uchar"
|
||||||
|
@ -315,6 +395,7 @@ CONSTANT: primitive-types
|
||||||
[ >c-ptr ] >>unboxer-quot
|
[ >c-ptr ] >>unboxer-quot
|
||||||
"box_alien" >>boxer
|
"box_alien" >>boxer
|
||||||
"alien_offset" >>unboxer
|
"alien_offset" >>unboxer
|
||||||
|
"alien" "void*" set-array-class*
|
||||||
"void*" define-primitive-type
|
"void*" define-primitive-type
|
||||||
|
|
||||||
<long-long-type>
|
<long-long-type>
|
||||||
|
@ -326,6 +407,7 @@ CONSTANT: primitive-types
|
||||||
8 >>align
|
8 >>align
|
||||||
"box_signed_8" >>boxer
|
"box_signed_8" >>boxer
|
||||||
"to_signed_8" >>unboxer
|
"to_signed_8" >>unboxer
|
||||||
|
"longlong" set-array-class
|
||||||
"longlong" define-primitive-type
|
"longlong" define-primitive-type
|
||||||
|
|
||||||
<long-long-type>
|
<long-long-type>
|
||||||
|
@ -337,6 +419,7 @@ CONSTANT: primitive-types
|
||||||
8 >>align
|
8 >>align
|
||||||
"box_unsigned_8" >>boxer
|
"box_unsigned_8" >>boxer
|
||||||
"to_unsigned_8" >>unboxer
|
"to_unsigned_8" >>unboxer
|
||||||
|
"ulonglong" set-array-class
|
||||||
"ulonglong" define-primitive-type
|
"ulonglong" define-primitive-type
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
|
@ -348,6 +431,7 @@ CONSTANT: primitive-types
|
||||||
bootstrap-cell >>align
|
bootstrap-cell >>align
|
||||||
"box_signed_cell" >>boxer
|
"box_signed_cell" >>boxer
|
||||||
"to_fixnum" >>unboxer
|
"to_fixnum" >>unboxer
|
||||||
|
"long" set-array-class
|
||||||
"long" define-primitive-type
|
"long" define-primitive-type
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
|
@ -359,6 +443,7 @@ CONSTANT: primitive-types
|
||||||
bootstrap-cell >>align
|
bootstrap-cell >>align
|
||||||
"box_unsigned_cell" >>boxer
|
"box_unsigned_cell" >>boxer
|
||||||
"to_cell" >>unboxer
|
"to_cell" >>unboxer
|
||||||
|
"ulong" set-array-class
|
||||||
"ulong" define-primitive-type
|
"ulong" define-primitive-type
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
|
@ -370,6 +455,7 @@ CONSTANT: primitive-types
|
||||||
4 >>align
|
4 >>align
|
||||||
"box_signed_4" >>boxer
|
"box_signed_4" >>boxer
|
||||||
"to_fixnum" >>unboxer
|
"to_fixnum" >>unboxer
|
||||||
|
"int" set-array-class
|
||||||
"int" define-primitive-type
|
"int" define-primitive-type
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
|
@ -381,6 +467,7 @@ CONSTANT: primitive-types
|
||||||
4 >>align
|
4 >>align
|
||||||
"box_unsigned_4" >>boxer
|
"box_unsigned_4" >>boxer
|
||||||
"to_cell" >>unboxer
|
"to_cell" >>unboxer
|
||||||
|
"uint" set-array-class
|
||||||
"uint" define-primitive-type
|
"uint" define-primitive-type
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
|
@ -392,6 +479,7 @@ CONSTANT: primitive-types
|
||||||
2 >>align
|
2 >>align
|
||||||
"box_signed_2" >>boxer
|
"box_signed_2" >>boxer
|
||||||
"to_fixnum" >>unboxer
|
"to_fixnum" >>unboxer
|
||||||
|
"short" set-array-class
|
||||||
"short" define-primitive-type
|
"short" define-primitive-type
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
|
@ -403,6 +491,7 @@ CONSTANT: primitive-types
|
||||||
2 >>align
|
2 >>align
|
||||||
"box_unsigned_2" >>boxer
|
"box_unsigned_2" >>boxer
|
||||||
"to_cell" >>unboxer
|
"to_cell" >>unboxer
|
||||||
|
"ushort" set-array-class
|
||||||
"ushort" define-primitive-type
|
"ushort" define-primitive-type
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
|
@ -414,6 +503,7 @@ CONSTANT: primitive-types
|
||||||
1 >>align
|
1 >>align
|
||||||
"box_signed_1" >>boxer
|
"box_signed_1" >>boxer
|
||||||
"to_fixnum" >>unboxer
|
"to_fixnum" >>unboxer
|
||||||
|
"char" set-array-class
|
||||||
"char" define-primitive-type
|
"char" define-primitive-type
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
|
@ -425,6 +515,7 @@ CONSTANT: primitive-types
|
||||||
1 >>align
|
1 >>align
|
||||||
"box_unsigned_1" >>boxer
|
"box_unsigned_1" >>boxer
|
||||||
"to_cell" >>unboxer
|
"to_cell" >>unboxer
|
||||||
|
"uchar" set-array-class
|
||||||
"uchar" define-primitive-type
|
"uchar" define-primitive-type
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
|
@ -434,6 +525,7 @@ CONSTANT: primitive-types
|
||||||
1 >>align
|
1 >>align
|
||||||
"box_boolean" >>boxer
|
"box_boolean" >>boxer
|
||||||
"to_boolean" >>unboxer
|
"to_boolean" >>unboxer
|
||||||
|
"bool" set-array-class
|
||||||
"bool" define-primitive-type
|
"bool" define-primitive-type
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
|
@ -447,6 +539,7 @@ CONSTANT: primitive-types
|
||||||
"to_float" >>unboxer
|
"to_float" >>unboxer
|
||||||
single-float-rep >>rep
|
single-float-rep >>rep
|
||||||
[ >float ] >>unboxer-quot
|
[ >float ] >>unboxer-quot
|
||||||
|
"float" set-array-class
|
||||||
"float" define-primitive-type
|
"float" define-primitive-type
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
|
@ -460,9 +553,11 @@ CONSTANT: primitive-types
|
||||||
"to_double" >>unboxer
|
"to_double" >>unboxer
|
||||||
double-float-rep >>rep
|
double-float-rep >>rep
|
||||||
[ >float ] >>unboxer-quot
|
[ >float ] >>unboxer-quot
|
||||||
|
"double" set-array-class
|
||||||
"double" define-primitive-type
|
"double" define-primitive-type
|
||||||
|
|
||||||
"long" "ptrdiff_t" typedef
|
"long" "ptrdiff_t" typedef
|
||||||
"long" "intptr_t" typedef
|
"long" "intptr_t" typedef
|
||||||
"ulong" "size_t" typedef
|
"ulong" "size_t" typedef
|
||||||
] with-compilation-unit
|
] with-compilation-unit
|
||||||
|
|
||||||
|
|
|
@ -31,6 +31,7 @@ T c-type
|
||||||
<T> 1quotation >>unboxer-quot
|
<T> 1quotation >>unboxer-quot
|
||||||
*T 1quotation >>boxer-quot
|
*T 1quotation >>boxer-quot
|
||||||
number >>boxed-class
|
number >>boxed-class
|
||||||
|
T set-array-class
|
||||||
drop
|
drop
|
||||||
|
|
||||||
;FUNCTOR
|
;FUNCTOR
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
USING: accessors arrays assocs generic hashtables kernel kernel.private
|
USING: accessors arrays assocs generic hashtables kernel kernel.private
|
||||||
math namespaces parser sequences strings words libc fry
|
math namespaces parser sequences strings words libc fry
|
||||||
alien.c-types alien.structs.fields cpu.architecture math.order
|
alien.c-types alien.structs.fields cpu.architecture math.order
|
||||||
quotations byte-arrays ;
|
quotations byte-arrays struct-arrays ;
|
||||||
IN: alien.structs
|
IN: alien.structs
|
||||||
|
|
||||||
TUPLE: struct-type < abstract-c-type fields return-in-registers? ;
|
TUPLE: struct-type < abstract-c-type fields return-in-registers? ;
|
||||||
|
@ -12,6 +12,16 @@ M: struct-type c-type ;
|
||||||
|
|
||||||
M: struct-type c-type-stack-align? drop f ;
|
M: struct-type c-type-stack-align? drop f ;
|
||||||
|
|
||||||
|
M: struct-type <c-type-array> ( len c-type -- array )
|
||||||
|
dup c-type-array-constructor
|
||||||
|
[ execute( len -- array ) ]
|
||||||
|
[ <struct-array> ] ?if ; inline
|
||||||
|
|
||||||
|
M: struct-type <c-type-direct-array> ( alien len c-type -- array )
|
||||||
|
dup c-type-direct-array-constructor
|
||||||
|
[ execute( alien len -- array ) ]
|
||||||
|
[ <direct-struct-array> ] ?if ; inline
|
||||||
|
|
||||||
: if-value-struct ( ctype true false -- )
|
: if-value-struct ( ctype true false -- )
|
||||||
[ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
|
[ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
|
||||||
|
|
||||||
|
@ -35,9 +45,8 @@ M: struct-type stack-size
|
||||||
|
|
||||||
: c-struct? ( type -- ? ) (c-type) struct-type? ;
|
: c-struct? ( type -- ? ) (c-type) struct-type? ;
|
||||||
|
|
||||||
: (define-struct) ( name size align fields -- )
|
: (define-struct) ( name size align fields class -- )
|
||||||
[ [ align ] keep ] dip
|
[ [ align ] keep ] 2dip new
|
||||||
struct-type new
|
|
||||||
byte-array >>class
|
byte-array >>class
|
||||||
byte-array >>boxed-class
|
byte-array >>boxed-class
|
||||||
swap >>fields
|
swap >>fields
|
||||||
|
@ -55,13 +64,13 @@ M: struct-type stack-size
|
||||||
[ 2drop ] [ make-fields ] 3bi
|
[ 2drop ] [ make-fields ] 3bi
|
||||||
[ struct-offsets ] keep
|
[ struct-offsets ] keep
|
||||||
[ [ type>> ] map compute-struct-align ] keep
|
[ [ type>> ] map compute-struct-align ] keep
|
||||||
[ (define-struct) ] keep
|
[ struct-type (define-struct) ] keep
|
||||||
[ define-field ] each ;
|
[ define-field ] each ;
|
||||||
|
|
||||||
: define-union ( name members -- )
|
: define-union ( name members -- )
|
||||||
[ expand-constants ] map
|
[ expand-constants ] map
|
||||||
[ [ heap-size ] [ max ] map-reduce ] keep
|
[ [ heap-size ] [ max ] map-reduce ] keep
|
||||||
compute-struct-align f (define-struct) ;
|
compute-struct-align f struct-type (define-struct) ;
|
||||||
|
|
||||||
: offset-of ( field struct -- offset )
|
: offset-of ( field struct -- offset )
|
||||||
c-types get at fields>>
|
c-types get at fields>>
|
||||||
|
|
|
@ -1,15 +1,16 @@
|
||||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel words sequences quotations namespaces io vectors
|
USING: kernel words sequences quotations namespaces io vectors
|
||||||
classes.tuple accessors prettyprint prettyprint.config assocs
|
arrays hashtables classes.tuple accessors prettyprint
|
||||||
prettyprint.backend prettyprint.custom prettyprint.sections
|
prettyprint.config assocs prettyprint.backend prettyprint.custom
|
||||||
parser compiler.tree.builder compiler.tree.optimizer
|
prettyprint.sections parser compiler.tree.builder
|
||||||
cpu.architecture compiler.cfg.builder compiler.cfg.linearization
|
compiler.tree.optimizer cpu.architecture compiler.cfg.builder
|
||||||
compiler.cfg.registers compiler.cfg.stack-frame
|
compiler.cfg.linearization compiler.cfg.registers
|
||||||
compiler.cfg.linear-scan compiler.cfg.two-operand
|
compiler.cfg.stack-frame compiler.cfg.linear-scan
|
||||||
compiler.cfg.optimizer compiler.cfg.instructions
|
compiler.cfg.two-operand compiler.cfg.optimizer
|
||||||
compiler.cfg.utilities compiler.cfg.def-use
|
compiler.cfg.instructions compiler.cfg.utilities
|
||||||
compiler.cfg.rpo compiler.cfg.mr compiler.cfg ;
|
compiler.cfg.def-use compiler.cfg.rpo compiler.cfg.mr
|
||||||
|
compiler.cfg.representations.preferred compiler.cfg ;
|
||||||
IN: compiler.cfg.debugger
|
IN: compiler.cfg.debugger
|
||||||
|
|
||||||
GENERIC: test-cfg ( quot -- cfgs )
|
GENERIC: test-cfg ( quot -- cfgs )
|
||||||
|
@ -73,8 +74,9 @@ M: rs-loc pprint* \ R pprint-loc ;
|
||||||
|
|
||||||
: fake-representations ( cfg -- )
|
: fake-representations ( cfg -- )
|
||||||
post-order [
|
post-order [
|
||||||
instructions>>
|
instructions>> [
|
||||||
[ [ temp-vregs ] [ defs-vreg ] bi [ suffix ] when* ]
|
[ [ temp-vregs ] [ temp-vreg-reps ] bi zip ]
|
||||||
map concat
|
[ [ defs-vreg ] [ defs-vreg-rep ] bi 2dup and [ 2array ] [ 2drop f ] if ]
|
||||||
] map concat
|
bi [ suffix ] when*
|
||||||
[ int-rep ] H{ } map>assoc representations set ;
|
] map concat
|
||||||
|
] map concat >hashtable representations set ;
|
|
@ -43,6 +43,7 @@ IN: compiler.cfg.hats
|
||||||
: ^^sub-float ( src1 src2 -- dst ) ^^r2 ##sub-float ; inline
|
: ^^sub-float ( src1 src2 -- dst ) ^^r2 ##sub-float ; inline
|
||||||
: ^^mul-float ( src1 src2 -- dst ) ^^r2 ##mul-float ; inline
|
: ^^mul-float ( src1 src2 -- dst ) ^^r2 ##mul-float ; inline
|
||||||
: ^^div-float ( src1 src2 -- dst ) ^^r2 ##div-float ; inline
|
: ^^div-float ( src1 src2 -- dst ) ^^r2 ##div-float ; inline
|
||||||
|
: ^^sqrt ( src -- dst ) ^^r1 ##sqrt ; inline
|
||||||
: ^^float>integer ( src -- dst ) ^^r1 ##float>integer ; inline
|
: ^^float>integer ( src -- dst ) ^^r1 ##float>integer ; inline
|
||||||
: ^^integer>float ( src -- dst ) ^^r1 ##integer>float ; inline
|
: ^^integer>float ( src -- dst ) ^^r1 ##integer>float ; inline
|
||||||
: ^^allot ( size class -- dst ) ^^r2 next-vreg ##allot ; inline
|
: ^^allot ( size class -- dst ) ^^r2 next-vreg ##allot ; inline
|
||||||
|
|
|
@ -106,6 +106,7 @@ INSN: ##add-float < ##commutative ;
|
||||||
INSN: ##sub-float < ##binary ;
|
INSN: ##sub-float < ##binary ;
|
||||||
INSN: ##mul-float < ##commutative ;
|
INSN: ##mul-float < ##commutative ;
|
||||||
INSN: ##div-float < ##binary ;
|
INSN: ##div-float < ##binary ;
|
||||||
|
INSN: ##sqrt < ##unary ;
|
||||||
|
|
||||||
! Float/integer conversion
|
! Float/integer conversion
|
||||||
INSN: ##float>integer < ##unary ;
|
INSN: ##float>integer < ##unary ;
|
||||||
|
@ -256,6 +257,7 @@ UNION: output-float-insn
|
||||||
##sub-float
|
##sub-float
|
||||||
##mul-float
|
##mul-float
|
||||||
##div-float
|
##div-float
|
||||||
|
##sqrt
|
||||||
##integer>float
|
##integer>float
|
||||||
##unbox-float
|
##unbox-float
|
||||||
##alien-float
|
##alien-float
|
||||||
|
@ -267,6 +269,7 @@ UNION: input-float-insn
|
||||||
##sub-float
|
##sub-float
|
||||||
##mul-float
|
##mul-float
|
||||||
##div-float
|
##div-float
|
||||||
|
##sqrt
|
||||||
##float>integer
|
##float>integer
|
||||||
##box-float
|
##box-float
|
||||||
##set-alien-float
|
##set-alien-float
|
||||||
|
|
|
@ -15,3 +15,6 @@ IN: compiler.cfg.intrinsics.float
|
||||||
|
|
||||||
: emit-fixnum>float ( -- )
|
: emit-fixnum>float ( -- )
|
||||||
ds-pop ^^untag-fixnum ^^integer>float ds-push ;
|
ds-pop ^^untag-fixnum ^^integer>float ds-push ;
|
||||||
|
|
||||||
|
: emit-fsqrt ( -- )
|
||||||
|
ds-pop ^^sqrt ds-push ;
|
||||||
|
|
|
@ -19,6 +19,7 @@ QUALIFIED: strings.private
|
||||||
QUALIFIED: classes.tuple.private
|
QUALIFIED: classes.tuple.private
|
||||||
QUALIFIED: math.private
|
QUALIFIED: math.private
|
||||||
QUALIFIED: math.integers.private
|
QUALIFIED: math.integers.private
|
||||||
|
QUALIFIED: math.libm
|
||||||
QUALIFIED: alien.accessors
|
QUALIFIED: alien.accessors
|
||||||
IN: compiler.cfg.intrinsics
|
IN: compiler.cfg.intrinsics
|
||||||
|
|
||||||
|
@ -92,6 +93,9 @@ IN: compiler.cfg.intrinsics
|
||||||
alien.accessors:set-alien-double
|
alien.accessors:set-alien-double
|
||||||
} [ t "intrinsic" set-word-prop ] each ;
|
} [ t "intrinsic" set-word-prop ] each ;
|
||||||
|
|
||||||
|
: enable-fsqrt ( -- )
|
||||||
|
\ math.libm:fsqrt t "intrinsic" set-word-prop ;
|
||||||
|
|
||||||
: enable-fixnum-log2 ( -- )
|
: enable-fixnum-log2 ( -- )
|
||||||
\ math.integers.private:fixnum-log2 t "intrinsic" set-word-prop ;
|
\ math.integers.private:fixnum-log2 t "intrinsic" set-word-prop ;
|
||||||
|
|
||||||
|
@ -130,6 +134,7 @@ IN: compiler.cfg.intrinsics
|
||||||
{ \ math.private:float= [ drop cc= emit-float-comparison ] }
|
{ \ math.private:float= [ drop cc= emit-float-comparison ] }
|
||||||
{ \ math.private:float>fixnum [ drop emit-float>fixnum ] }
|
{ \ math.private:float>fixnum [ drop emit-float>fixnum ] }
|
||||||
{ \ math.private:fixnum>float [ drop emit-fixnum>float ] }
|
{ \ math.private:fixnum>float [ drop emit-fixnum>float ] }
|
||||||
|
{ \ math.libm:fsqrt [ drop emit-fsqrt ] }
|
||||||
{ \ slots.private:slot [ emit-slot ] }
|
{ \ slots.private:slot [ emit-slot ] }
|
||||||
{ \ slots.private:set-slot [ emit-set-slot ] }
|
{ \ slots.private:set-slot [ emit-set-slot ] }
|
||||||
{ \ strings.private:string-nth [ drop emit-string-nth ] }
|
{ \ strings.private:string-nth [ drop emit-string-nth ] }
|
||||||
|
|
|
@ -656,14 +656,17 @@ V{
|
||||||
T{ ##copy
|
T{ ##copy
|
||||||
{ dst 689481 }
|
{ dst 689481 }
|
||||||
{ src 689475 }
|
{ src 689475 }
|
||||||
|
{ rep int-rep }
|
||||||
}
|
}
|
||||||
T{ ##copy
|
T{ ##copy
|
||||||
{ dst 689482 }
|
{ dst 689482 }
|
||||||
{ src 689474 }
|
{ src 689474 }
|
||||||
|
{ rep int-rep }
|
||||||
}
|
}
|
||||||
T{ ##copy
|
T{ ##copy
|
||||||
{ dst 689483 }
|
{ dst 689483 }
|
||||||
{ src 689473 }
|
{ src 689473 }
|
||||||
|
{ rep int-rep }
|
||||||
}
|
}
|
||||||
T{ ##branch }
|
T{ ##branch }
|
||||||
} 2 test-bb
|
} 2 test-bb
|
||||||
|
@ -672,14 +675,17 @@ V{
|
||||||
T{ ##copy
|
T{ ##copy
|
||||||
{ dst 689481 }
|
{ dst 689481 }
|
||||||
{ src 689473 }
|
{ src 689473 }
|
||||||
|
{ rep int-rep }
|
||||||
}
|
}
|
||||||
T{ ##copy
|
T{ ##copy
|
||||||
{ dst 689482 }
|
{ dst 689482 }
|
||||||
{ src 689475 }
|
{ src 689475 }
|
||||||
|
{ rep int-rep }
|
||||||
}
|
}
|
||||||
T{ ##copy
|
T{ ##copy
|
||||||
{ dst 689483 }
|
{ dst 689483 }
|
||||||
{ src 689474 }
|
{ src 689474 }
|
||||||
|
{ rep int-rep }
|
||||||
}
|
}
|
||||||
T{ ##branch }
|
T{ ##branch }
|
||||||
} 3 test-bb
|
} 3 test-bb
|
||||||
|
@ -742,10 +748,12 @@ V{
|
||||||
T{ ##copy
|
T{ ##copy
|
||||||
{ dst 689608 }
|
{ dst 689608 }
|
||||||
{ src 689600 }
|
{ src 689600 }
|
||||||
|
{ rep int-rep }
|
||||||
}
|
}
|
||||||
T{ ##copy
|
T{ ##copy
|
||||||
{ dst 689610 }
|
{ dst 689610 }
|
||||||
{ src 689601 }
|
{ src 689601 }
|
||||||
|
{ rep int-rep }
|
||||||
}
|
}
|
||||||
T{ ##branch }
|
T{ ##branch }
|
||||||
} 2 test-bb
|
} 2 test-bb
|
||||||
|
@ -758,14 +766,17 @@ V{
|
||||||
T{ ##copy
|
T{ ##copy
|
||||||
{ dst 689607 }
|
{ dst 689607 }
|
||||||
{ src 689600 }
|
{ src 689600 }
|
||||||
|
{ rep int-rep }
|
||||||
}
|
}
|
||||||
T{ ##copy
|
T{ ##copy
|
||||||
{ dst 689608 }
|
{ dst 689608 }
|
||||||
{ src 689601 }
|
{ src 689601 }
|
||||||
|
{ rep int-rep }
|
||||||
}
|
}
|
||||||
T{ ##copy
|
T{ ##copy
|
||||||
{ dst 689610 }
|
{ dst 689610 }
|
||||||
{ src 689609 }
|
{ src 689609 }
|
||||||
|
{ rep int-rep }
|
||||||
}
|
}
|
||||||
T{ ##branch }
|
T{ ##branch }
|
||||||
} 3 test-bb
|
} 3 test-bb
|
||||||
|
@ -816,6 +827,7 @@ V{
|
||||||
T{ ##copy
|
T{ ##copy
|
||||||
{ dst 2 }
|
{ dst 2 }
|
||||||
{ src 1 }
|
{ src 1 }
|
||||||
|
{ rep int-rep }
|
||||||
}
|
}
|
||||||
T{ ##branch }
|
T{ ##branch }
|
||||||
} 2 test-bb
|
} 2 test-bb
|
||||||
|
@ -828,6 +840,7 @@ V{
|
||||||
T{ ##copy
|
T{ ##copy
|
||||||
{ dst 2 }
|
{ dst 2 }
|
||||||
{ src 3 }
|
{ src 3 }
|
||||||
|
{ rep int-rep }
|
||||||
}
|
}
|
||||||
T{ ##branch }
|
T{ ##branch }
|
||||||
} 3 test-bb
|
} 3 test-bb
|
||||||
|
@ -1121,7 +1134,7 @@ V{
|
||||||
{ slot 1 }
|
{ slot 1 }
|
||||||
{ tag 2 }
|
{ tag 2 }
|
||||||
}
|
}
|
||||||
T{ ##copy { dst 79 } { src 69 } }
|
T{ ##copy { dst 79 } { src 69 } { rep int-rep } }
|
||||||
T{ ##slot-imm
|
T{ ##slot-imm
|
||||||
{ dst 85 }
|
{ dst 85 }
|
||||||
{ obj 62 }
|
{ obj 62 }
|
||||||
|
@ -1169,22 +1182,22 @@ V{
|
||||||
T{ ##peek { dst 114 } { loc D 1 } }
|
T{ ##peek { dst 114 } { loc D 1 } }
|
||||||
T{ ##peek { dst 116 } { loc D 4 } }
|
T{ ##peek { dst 116 } { loc D 4 } }
|
||||||
T{ ##peek { dst 119 } { loc R 0 } }
|
T{ ##peek { dst 119 } { loc R 0 } }
|
||||||
T{ ##copy { dst 109 } { src 108 } }
|
T{ ##copy { dst 109 } { src 108 } { rep int-rep } }
|
||||||
T{ ##copy { dst 111 } { src 110 } }
|
T{ ##copy { dst 111 } { src 110 } { rep int-rep } }
|
||||||
T{ ##copy { dst 113 } { src 112 } }
|
T{ ##copy { dst 113 } { src 112 } { rep int-rep } }
|
||||||
T{ ##copy { dst 115 } { src 114 } }
|
T{ ##copy { dst 115 } { src 114 } { rep int-rep } }
|
||||||
T{ ##copy { dst 117 } { src 116 } }
|
T{ ##copy { dst 117 } { src 116 } { rep int-rep } }
|
||||||
T{ ##copy { dst 120 } { src 119 } }
|
T{ ##copy { dst 120 } { src 119 } { rep int-rep } }
|
||||||
T{ ##branch }
|
T{ ##branch }
|
||||||
} 3 test-bb
|
} 3 test-bb
|
||||||
|
|
||||||
V{
|
V{
|
||||||
T{ ##copy { dst 109 } { src 62 } }
|
T{ ##copy { dst 109 } { src 62 } { rep int-rep } }
|
||||||
T{ ##copy { dst 111 } { src 61 } }
|
T{ ##copy { dst 111 } { src 61 } { rep int-rep } }
|
||||||
T{ ##copy { dst 113 } { src 62 } }
|
T{ ##copy { dst 113 } { src 62 } { rep int-rep } }
|
||||||
T{ ##copy { dst 115 } { src 79 } }
|
T{ ##copy { dst 115 } { src 79 } { rep int-rep } }
|
||||||
T{ ##copy { dst 117 } { src 64 } }
|
T{ ##copy { dst 117 } { src 64 } { rep int-rep } }
|
||||||
T{ ##copy { dst 120 } { src 69 } }
|
T{ ##copy { dst 120 } { src 69 } { rep int-rep } }
|
||||||
T{ ##branch }
|
T{ ##branch }
|
||||||
} 4 test-bb
|
} 4 test-bb
|
||||||
|
|
||||||
|
@ -1306,12 +1319,12 @@ V{
|
||||||
T{ ##peek { dst 162 } { loc D 1 } }
|
T{ ##peek { dst 162 } { loc D 1 } }
|
||||||
T{ ##peek { dst 164 } { loc D 4 } }
|
T{ ##peek { dst 164 } { loc D 4 } }
|
||||||
T{ ##peek { dst 167 } { loc R 0 } }
|
T{ ##peek { dst 167 } { loc R 0 } }
|
||||||
T{ ##copy { dst 157 } { src 156 } }
|
T{ ##copy { dst 157 } { src 156 } { rep int-rep } }
|
||||||
T{ ##copy { dst 159 } { src 158 } }
|
T{ ##copy { dst 159 } { src 158 } { rep int-rep } }
|
||||||
T{ ##copy { dst 161 } { src 160 } }
|
T{ ##copy { dst 161 } { src 160 } { rep int-rep } }
|
||||||
T{ ##copy { dst 163 } { src 162 } }
|
T{ ##copy { dst 163 } { src 162 } { rep int-rep } }
|
||||||
T{ ##copy { dst 165 } { src 164 } }
|
T{ ##copy { dst 165 } { src 164 } { rep int-rep } }
|
||||||
T{ ##copy { dst 168 } { src 167 } }
|
T{ ##copy { dst 168 } { src 167 } { rep int-rep } }
|
||||||
T{ ##branch }
|
T{ ##branch }
|
||||||
} 4 test-bb
|
} 4 test-bb
|
||||||
|
|
||||||
|
|
|
@ -170,6 +170,8 @@ M: ##sub-float generate-insn dst/src1/src2 %sub-float ;
|
||||||
M: ##mul-float generate-insn dst/src1/src2 %mul-float ;
|
M: ##mul-float generate-insn dst/src1/src2 %mul-float ;
|
||||||
M: ##div-float generate-insn dst/src1/src2 %div-float ;
|
M: ##div-float generate-insn dst/src1/src2 %div-float ;
|
||||||
|
|
||||||
|
M: ##sqrt generate-insn dst/src %sqrt ;
|
||||||
|
|
||||||
M: ##integer>float generate-insn dst/src %integer>float ;
|
M: ##integer>float generate-insn dst/src %integer>float ;
|
||||||
M: ##float>integer generate-insn dst/src %float>integer ;
|
M: ##float>integer generate-insn dst/src %float>integer ;
|
||||||
|
|
||||||
|
|
|
@ -3,7 +3,7 @@ compiler.cfg.debugger compiler.cfg.instructions compiler.cfg.mr
|
||||||
compiler.cfg.registers compiler.codegen compiler.units
|
compiler.cfg.registers compiler.codegen compiler.units
|
||||||
cpu.architecture hashtables kernel namespaces sequences
|
cpu.architecture hashtables kernel namespaces sequences
|
||||||
tools.test vectors words layouts literals math arrays
|
tools.test vectors words layouts literals math arrays
|
||||||
alien.syntax ;
|
alien.syntax math.private ;
|
||||||
IN: compiler.tests.low-level-ir
|
IN: compiler.tests.low-level-ir
|
||||||
|
|
||||||
: compile-cfg ( cfg -- word )
|
: compile-cfg ( cfg -- word )
|
||||||
|
@ -46,6 +46,20 @@ IN: compiler.tests.low-level-ir
|
||||||
} compile-test-bb
|
} compile-test-bb
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
! ##copy on floats. We can only run this test if float intrinsics
|
||||||
|
! are enabled.
|
||||||
|
\ float+ "intrinsic" word-prop [
|
||||||
|
[ 1.5 ] [
|
||||||
|
V{
|
||||||
|
T{ ##load-reference f 4 1.5 }
|
||||||
|
T{ ##unbox-float f 1 4 }
|
||||||
|
T{ ##copy f 2 1 double-float-rep }
|
||||||
|
T{ ##box-float f 3 2 }
|
||||||
|
T{ ##copy f 0 3 int-rep }
|
||||||
|
} compile-test-bb
|
||||||
|
] unit-test
|
||||||
|
] when
|
||||||
|
|
||||||
! make sure slot access works when the destination is
|
! make sure slot access works when the destination is
|
||||||
! one of the sources
|
! one of the sources
|
||||||
[ t ] [
|
[ t ] [
|
||||||
|
@ -138,4 +152,4 @@ USE: multiline
|
||||||
} compile-test-bb
|
} compile-test-bb
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
*/
|
*/
|
||||||
|
|
|
@ -2,11 +2,12 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel effects accessors math math.private
|
USING: kernel effects accessors math math.private
|
||||||
math.integers.private math.partial-dispatch math.intervals
|
math.integers.private math.partial-dispatch math.intervals
|
||||||
math.parser math.order math.functions layouts words sequences sequences.private
|
math.parser math.order math.functions math.libm layouts words
|
||||||
arrays assocs classes classes.algebra combinators generic.math
|
sequences sequences.private arrays assocs classes
|
||||||
splitting fry locals classes.tuple alien.accessors
|
classes.algebra combinators generic.math splitting fry locals
|
||||||
classes.tuple.private slots.private definitions strings.private
|
classes.tuple alien.accessors classes.tuple.private
|
||||||
vectors hashtables generic quotations
|
slots.private definitions strings.private vectors hashtables
|
||||||
|
generic quotations
|
||||||
stack-checker.state
|
stack-checker.state
|
||||||
compiler.tree.comparisons
|
compiler.tree.comparisons
|
||||||
compiler.tree.propagation.info
|
compiler.tree.propagation.info
|
||||||
|
@ -297,3 +298,8 @@ generic-comparison-ops [
|
||||||
bi
|
bi
|
||||||
] [ 2drop object-info ] if
|
] [ 2drop object-info ] if
|
||||||
] "outputs" set-word-prop
|
] "outputs" set-word-prop
|
||||||
|
|
||||||
|
{ facos fasin fatan fatan2 fcos fsin ftan fcosh fsinh ftanh fexp
|
||||||
|
flog fpow fsqrt facosh fasinh fatanh } [
|
||||||
|
{ float } "default-output-classes" set-word-prop
|
||||||
|
] each
|
||||||
|
|
|
@ -110,6 +110,7 @@ HOOK: %add-float cpu ( dst src1 src2 -- )
|
||||||
HOOK: %sub-float cpu ( dst src1 src2 -- )
|
HOOK: %sub-float cpu ( dst src1 src2 -- )
|
||||||
HOOK: %mul-float cpu ( dst src1 src2 -- )
|
HOOK: %mul-float cpu ( dst src1 src2 -- )
|
||||||
HOOK: %div-float cpu ( dst src1 src2 -- )
|
HOOK: %div-float cpu ( dst src1 src2 -- )
|
||||||
|
HOOK: %sqrt cpu ( dst src -- )
|
||||||
|
|
||||||
HOOK: %integer>float cpu ( dst src -- )
|
HOOK: %integer>float cpu ( dst src -- )
|
||||||
HOOK: %float>integer cpu ( dst src -- )
|
HOOK: %float>integer cpu ( dst src -- )
|
||||||
|
|
|
@ -1,117 +1,120 @@
|
||||||
USING: cpu.ppc.assembler tools.test arrays kernel namespaces
|
USING: cpu.ppc.assembler tools.test arrays kernel namespaces
|
||||||
make vocabs sequences ;
|
make vocabs sequences byte-arrays.hex ;
|
||||||
FROM: cpu.ppc.assembler => B ;
|
FROM: cpu.ppc.assembler => B ;
|
||||||
IN: cpu.ppc.assembler.tests
|
IN: cpu.ppc.assembler.tests
|
||||||
|
|
||||||
: test-assembler ( expected quot -- )
|
: test-assembler ( expected quot -- )
|
||||||
[ 1array ] [ [ B{ } make ] curry ] bi* unit-test ;
|
[ 1array ] [ [ B{ } make ] curry ] bi* unit-test ;
|
||||||
|
|
||||||
B{ HEX: 38 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 ADDI ] test-assembler
|
HEX{ 38 22 00 03 } [ 1 2 3 ADDI ] test-assembler
|
||||||
B{ HEX: 3c HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 ADDIS ] test-assembler
|
HEX{ 3c 22 00 03 } [ 1 2 3 ADDIS ] test-assembler
|
||||||
B{ HEX: 30 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 ADDIC ] test-assembler
|
HEX{ 30 22 00 03 } [ 1 2 3 ADDIC ] test-assembler
|
||||||
B{ HEX: 34 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 ADDIC. ] test-assembler
|
HEX{ 34 22 00 03 } [ 1 2 3 ADDIC. ] test-assembler
|
||||||
B{ HEX: 38 HEX: 40 HEX: 00 HEX: 01 } [ 1 2 LI ] test-assembler
|
HEX{ 38 40 00 01 } [ 1 2 LI ] test-assembler
|
||||||
B{ HEX: 3c HEX: 40 HEX: 00 HEX: 01 } [ 1 2 LIS ] test-assembler
|
HEX{ 3c 40 00 01 } [ 1 2 LIS ] test-assembler
|
||||||
B{ HEX: 38 HEX: 22 HEX: ff HEX: fd } [ 1 2 3 SUBI ] test-assembler
|
HEX{ 38 22 ff fd } [ 1 2 3 SUBI ] test-assembler
|
||||||
B{ HEX: 1c HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 MULI ] test-assembler
|
HEX{ 1c 22 00 03 } [ 1 2 3 MULI ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 1a HEX: 14 } [ 1 2 3 ADD ] test-assembler
|
HEX{ 7c 22 1a 14 } [ 1 2 3 ADD ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 1a HEX: 15 } [ 1 2 3 ADD. ] test-assembler
|
HEX{ 7c 22 1a 15 } [ 1 2 3 ADD. ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 1e HEX: 14 } [ 1 2 3 ADDO ] test-assembler
|
HEX{ 7c 22 1e 14 } [ 1 2 3 ADDO ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 1e HEX: 15 } [ 1 2 3 ADDO. ] test-assembler
|
HEX{ 7c 22 1e 15 } [ 1 2 3 ADDO. ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 18 HEX: 14 } [ 1 2 3 ADDC ] test-assembler
|
HEX{ 7c 22 18 14 } [ 1 2 3 ADDC ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 18 HEX: 15 } [ 1 2 3 ADDC. ] test-assembler
|
HEX{ 7c 22 18 15 } [ 1 2 3 ADDC. ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 1e HEX: 14 } [ 1 2 3 ADDO ] test-assembler
|
HEX{ 7c 22 1e 14 } [ 1 2 3 ADDO ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 1c HEX: 15 } [ 1 2 3 ADDCO. ] test-assembler
|
HEX{ 7c 22 1c 15 } [ 1 2 3 ADDCO. ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 19 HEX: 14 } [ 1 2 3 ADDE ] test-assembler
|
HEX{ 7c 22 19 14 } [ 1 2 3 ADDE ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 18 HEX: 38 } [ 1 2 3 AND ] test-assembler
|
HEX{ 7c 41 18 38 } [ 1 2 3 AND ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 18 HEX: 39 } [ 1 2 3 AND. ] test-assembler
|
HEX{ 7c 41 18 39 } [ 1 2 3 AND. ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 1b HEX: d6 } [ 1 2 3 DIVW ] test-assembler
|
HEX{ 7c 22 1b d6 } [ 1 2 3 DIVW ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 1b HEX: 96 } [ 1 2 3 DIVWU ] test-assembler
|
HEX{ 7c 22 1b 96 } [ 1 2 3 DIVWU ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 1a HEX: 38 } [ 1 2 3 EQV ] test-assembler
|
HEX{ 7c 41 1a 38 } [ 1 2 3 EQV ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 1b HEX: b8 } [ 1 2 3 NAND ] test-assembler
|
HEX{ 7c 41 1b b8 } [ 1 2 3 NAND ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 18 HEX: f8 } [ 1 2 3 NOR ] test-assembler
|
HEX{ 7c 41 18 f8 } [ 1 2 3 NOR ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 10 HEX: f8 } [ 1 2 NOT ] test-assembler
|
HEX{ 7c 41 10 f8 } [ 1 2 NOT ] test-assembler
|
||||||
B{ HEX: 60 HEX: 41 HEX: 00 HEX: 03 } [ 1 2 3 ORI ] test-assembler
|
HEX{ 60 41 00 03 } [ 1 2 3 ORI ] test-assembler
|
||||||
B{ HEX: 64 HEX: 41 HEX: 00 HEX: 03 } [ 1 2 3 ORIS ] test-assembler
|
HEX{ 64 41 00 03 } [ 1 2 3 ORIS ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 1b HEX: 78 } [ 1 2 3 OR ] test-assembler
|
HEX{ 7c 41 1b 78 } [ 1 2 3 OR ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 13 HEX: 78 } [ 1 2 MR ] test-assembler
|
HEX{ 7c 41 13 78 } [ 1 2 MR ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 18 HEX: 96 } [ 1 2 3 MULHW ] test-assembler
|
HEX{ 7c 22 18 96 } [ 1 2 3 MULHW ] test-assembler
|
||||||
B{ HEX: 1c HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 MULLI ] test-assembler
|
HEX{ 1c 22 00 03 } [ 1 2 3 MULLI ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 18 HEX: 16 } [ 1 2 3 MULHWU ] test-assembler
|
HEX{ 7c 22 18 16 } [ 1 2 3 MULHWU ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 19 HEX: d6 } [ 1 2 3 MULLW ] test-assembler
|
HEX{ 7c 22 19 d6 } [ 1 2 3 MULLW ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 18 HEX: 30 } [ 1 2 3 SLW ] test-assembler
|
HEX{ 7c 41 18 30 } [ 1 2 3 SLW ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 1e HEX: 30 } [ 1 2 3 SRAW ] test-assembler
|
HEX{ 7c 41 1e 30 } [ 1 2 3 SRAW ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 1c HEX: 30 } [ 1 2 3 SRW ] test-assembler
|
HEX{ 7c 41 1c 30 } [ 1 2 3 SRW ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 1e HEX: 70 } [ 1 2 3 SRAWI ] test-assembler
|
HEX{ 7c 41 1e 70 } [ 1 2 3 SRAWI ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 18 HEX: 50 } [ 1 2 3 SUBF ] test-assembler
|
HEX{ 7c 22 18 50 } [ 1 2 3 SUBF ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 18 HEX: 10 } [ 1 2 3 SUBFC ] test-assembler
|
HEX{ 7c 22 18 10 } [ 1 2 3 SUBFC ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 19 HEX: 10 } [ 1 2 3 SUBFE ] test-assembler
|
HEX{ 7c 22 19 10 } [ 1 2 3 SUBFE ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 07 HEX: 74 } [ 1 2 EXTSB ] test-assembler
|
HEX{ 7c 41 07 74 } [ 1 2 EXTSB ] test-assembler
|
||||||
B{ HEX: 68 HEX: 41 HEX: 00 HEX: 03 } [ 1 2 3 XORI ] test-assembler
|
HEX{ 68 41 00 03 } [ 1 2 3 XORI ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 1a HEX: 78 } [ 1 2 3 XOR ] test-assembler
|
HEX{ 7c 41 1a 78 } [ 1 2 3 XOR ] test-assembler
|
||||||
B{ HEX: 7c HEX: 22 HEX: 00 HEX: d0 } [ 1 2 NEG ] test-assembler
|
HEX{ 7c 22 00 d0 } [ 1 2 NEG ] test-assembler
|
||||||
B{ HEX: 2c HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 CMPI ] test-assembler
|
HEX{ 2c 22 00 03 } [ 1 2 3 CMPI ] test-assembler
|
||||||
B{ HEX: 28 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 CMPLI ] test-assembler
|
HEX{ 28 22 00 03 } [ 1 2 3 CMPLI ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 18 HEX: 00 } [ 1 2 3 CMP ] test-assembler
|
HEX{ 7c 41 18 00 } [ 1 2 3 CMP ] test-assembler
|
||||||
B{ HEX: 54 HEX: 22 HEX: 19 HEX: 0a } [ 1 2 3 4 5 RLWINM ] test-assembler
|
HEX{ 54 22 19 0a } [ 1 2 3 4 5 RLWINM ] test-assembler
|
||||||
B{ HEX: 54 HEX: 22 HEX: 18 HEX: 38 } [ 1 2 3 SLWI ] test-assembler
|
HEX{ 54 22 18 38 } [ 1 2 3 SLWI ] test-assembler
|
||||||
B{ HEX: 54 HEX: 22 HEX: e8 HEX: fe } [ 1 2 3 SRWI ] test-assembler
|
HEX{ 54 22 e8 fe } [ 1 2 3 SRWI ] test-assembler
|
||||||
B{ HEX: 88 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LBZ ] test-assembler
|
HEX{ 88 22 00 03 } [ 1 2 3 LBZ ] test-assembler
|
||||||
B{ HEX: 8c HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LBZU ] test-assembler
|
HEX{ 8c 22 00 03 } [ 1 2 3 LBZU ] test-assembler
|
||||||
B{ HEX: a8 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LHA ] test-assembler
|
HEX{ a8 22 00 03 } [ 1 2 3 LHA ] test-assembler
|
||||||
B{ HEX: ac HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LHAU ] test-assembler
|
HEX{ ac 22 00 03 } [ 1 2 3 LHAU ] test-assembler
|
||||||
B{ HEX: a0 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LHZ ] test-assembler
|
HEX{ a0 22 00 03 } [ 1 2 3 LHZ ] test-assembler
|
||||||
B{ HEX: a4 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LHZU ] test-assembler
|
HEX{ a4 22 00 03 } [ 1 2 3 LHZU ] test-assembler
|
||||||
B{ HEX: 80 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LWZ ] test-assembler
|
HEX{ 80 22 00 03 } [ 1 2 3 LWZ ] test-assembler
|
||||||
B{ HEX: 84 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LWZU ] test-assembler
|
HEX{ 84 22 00 03 } [ 1 2 3 LWZU ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 18 HEX: ae } [ 1 2 3 LBZX ] test-assembler
|
HEX{ 7c 41 18 ae } [ 1 2 3 LBZX ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 18 HEX: ee } [ 1 2 3 LBZUX ] test-assembler
|
HEX{ 7c 41 18 ee } [ 1 2 3 LBZUX ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 1a HEX: ae } [ 1 2 3 LHAX ] test-assembler
|
HEX{ 7c 41 1a ae } [ 1 2 3 LHAX ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 1a HEX: ee } [ 1 2 3 LHAUX ] test-assembler
|
HEX{ 7c 41 1a ee } [ 1 2 3 LHAUX ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 1a HEX: 2e } [ 1 2 3 LHZX ] test-assembler
|
HEX{ 7c 41 1a 2e } [ 1 2 3 LHZX ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 1a HEX: 6e } [ 1 2 3 LHZUX ] test-assembler
|
HEX{ 7c 41 1a 6e } [ 1 2 3 LHZUX ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 18 HEX: 2e } [ 1 2 3 LWZX ] test-assembler
|
HEX{ 7c 41 18 2e } [ 1 2 3 LWZX ] test-assembler
|
||||||
B{ HEX: 7c HEX: 41 HEX: 18 HEX: 6e } [ 1 2 3 LWZUX ] test-assembler
|
HEX{ 7c 41 18 6e } [ 1 2 3 LWZUX ] test-assembler
|
||||||
B{ HEX: 48 HEX: 00 HEX: 00 HEX: 01 } [ 1 B ] test-assembler
|
HEX{ 48 00 00 01 } [ 1 B ] test-assembler
|
||||||
B{ HEX: 48 HEX: 00 HEX: 00 HEX: 01 } [ 1 BL ] test-assembler
|
HEX{ 48 00 00 01 } [ 1 BL ] test-assembler
|
||||||
B{ HEX: 41 HEX: 80 HEX: 00 HEX: 04 } [ 1 BLT ] test-assembler
|
HEX{ 41 80 00 04 } [ 1 BLT ] test-assembler
|
||||||
B{ HEX: 41 HEX: 81 HEX: 00 HEX: 04 } [ 1 BGT ] test-assembler
|
HEX{ 41 81 00 04 } [ 1 BGT ] test-assembler
|
||||||
B{ HEX: 40 HEX: 81 HEX: 00 HEX: 04 } [ 1 BLE ] test-assembler
|
HEX{ 40 81 00 04 } [ 1 BLE ] test-assembler
|
||||||
B{ HEX: 40 HEX: 80 HEX: 00 HEX: 04 } [ 1 BGE ] test-assembler
|
HEX{ 40 80 00 04 } [ 1 BGE ] test-assembler
|
||||||
B{ HEX: 41 HEX: 80 HEX: 00 HEX: 04 } [ 1 BLT ] test-assembler
|
HEX{ 41 80 00 04 } [ 1 BLT ] test-assembler
|
||||||
B{ HEX: 40 HEX: 82 HEX: 00 HEX: 04 } [ 1 BNE ] test-assembler
|
HEX{ 40 82 00 04 } [ 1 BNE ] test-assembler
|
||||||
B{ HEX: 41 HEX: 82 HEX: 00 HEX: 04 } [ 1 BEQ ] test-assembler
|
HEX{ 41 82 00 04 } [ 1 BEQ ] test-assembler
|
||||||
B{ HEX: 41 HEX: 83 HEX: 00 HEX: 04 } [ 1 BO ] test-assembler
|
HEX{ 41 83 00 04 } [ 1 BO ] test-assembler
|
||||||
B{ HEX: 40 HEX: 83 HEX: 00 HEX: 04 } [ 1 BNO ] test-assembler
|
HEX{ 40 83 00 04 } [ 1 BNO ] test-assembler
|
||||||
B{ HEX: 4c HEX: 20 HEX: 00 HEX: 20 } [ 1 BCLR ] test-assembler
|
HEX{ 4c 20 00 20 } [ 1 BCLR ] test-assembler
|
||||||
B{ HEX: 4e HEX: 80 HEX: 00 HEX: 20 } [ BLR ] test-assembler
|
HEX{ 4e 80 00 20 } [ BLR ] test-assembler
|
||||||
B{ HEX: 4e HEX: 80 HEX: 00 HEX: 21 } [ BLRL ] test-assembler
|
HEX{ 4e 80 00 21 } [ BLRL ] test-assembler
|
||||||
B{ HEX: 4c HEX: 20 HEX: 04 HEX: 20 } [ 1 BCCTR ] test-assembler
|
HEX{ 4c 20 04 20 } [ 1 BCCTR ] test-assembler
|
||||||
B{ HEX: 4e HEX: 80 HEX: 04 HEX: 20 } [ BCTR ] test-assembler
|
HEX{ 4e 80 04 20 } [ BCTR ] test-assembler
|
||||||
B{ HEX: 7c HEX: 61 HEX: 02 HEX: a6 } [ 3 MFXER ] test-assembler
|
HEX{ 7c 61 02 a6 } [ 3 MFXER ] test-assembler
|
||||||
B{ HEX: 7c HEX: 68 HEX: 02 HEX: a6 } [ 3 MFLR ] test-assembler
|
HEX{ 7c 68 02 a6 } [ 3 MFLR ] test-assembler
|
||||||
B{ HEX: 7c HEX: 69 HEX: 02 HEX: a6 } [ 3 MFCTR ] test-assembler
|
HEX{ 7c 69 02 a6 } [ 3 MFCTR ] test-assembler
|
||||||
B{ HEX: 7c HEX: 61 HEX: 03 HEX: a6 } [ 3 MTXER ] test-assembler
|
HEX{ 7c 61 03 a6 } [ 3 MTXER ] test-assembler
|
||||||
B{ HEX: 7c HEX: 68 HEX: 03 HEX: a6 } [ 3 MTLR ] test-assembler
|
HEX{ 7c 68 03 a6 } [ 3 MTLR ] test-assembler
|
||||||
B{ HEX: 7c HEX: 69 HEX: 03 HEX: a6 } [ 3 MTCTR ] test-assembler
|
HEX{ 7c 69 03 a6 } [ 3 MTCTR ] test-assembler
|
||||||
B{ HEX: 7c HEX: 61 HEX: 02 HEX: a6 } [ 3 MFXER ] test-assembler
|
HEX{ 7c 61 02 a6 } [ 3 MFXER ] test-assembler
|
||||||
B{ HEX: 7c HEX: 68 HEX: 02 HEX: a6 } [ 3 MFLR ] test-assembler
|
HEX{ 7c 68 02 a6 } [ 3 MFLR ] test-assembler
|
||||||
B{ HEX: c0 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LFS ] test-assembler
|
HEX{ c0 22 00 03 } [ 1 2 3 LFS ] test-assembler
|
||||||
B{ HEX: c4 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LFSU ] test-assembler
|
HEX{ c4 22 00 03 } [ 1 2 3 LFSU ] test-assembler
|
||||||
B{ HEX: c8 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LFD ] test-assembler
|
HEX{ c8 22 00 03 } [ 1 2 3 LFD ] test-assembler
|
||||||
B{ HEX: cc HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LFDU ] test-assembler
|
HEX{ cc 22 00 03 } [ 1 2 3 LFDU ] test-assembler
|
||||||
B{ HEX: d0 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 STFS ] test-assembler
|
HEX{ d0 22 00 03 } [ 1 2 3 STFS ] test-assembler
|
||||||
B{ HEX: d4 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 STFSU ] test-assembler
|
HEX{ d4 22 00 03 } [ 1 2 3 STFSU ] test-assembler
|
||||||
B{ HEX: d8 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 STFD ] test-assembler
|
HEX{ d8 22 00 03 } [ 1 2 3 STFD ] test-assembler
|
||||||
B{ HEX: dc HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 STFDU ] test-assembler
|
HEX{ dc 22 00 03 } [ 1 2 3 STFDU ] test-assembler
|
||||||
B{ HEX: fc HEX: 20 HEX: 10 HEX: 48 } [ 1 2 FMR ] test-assembler
|
HEX{ fc 20 10 90 } [ 1 2 FMR ] test-assembler
|
||||||
B{ HEX: fc HEX: 20 HEX: 10 HEX: 1e } [ 1 2 FCTIWZ ] test-assembler
|
HEX{ fc 40 08 90 } [ 2 1 FMR ] test-assembler
|
||||||
B{ HEX: fc HEX: 22 HEX: 18 HEX: 2a } [ 1 2 3 FADD ] test-assembler
|
HEX{ fc 20 10 91 } [ 1 2 FMR. ] test-assembler
|
||||||
B{ HEX: fc HEX: 22 HEX: 18 HEX: 2b } [ 1 2 3 FADD. ] test-assembler
|
HEX{ fc 40 08 91 } [ 2 1 FMR. ] test-assembler
|
||||||
B{ HEX: fc HEX: 22 HEX: 18 HEX: 28 } [ 1 2 3 FSUB ] test-assembler
|
HEX{ fc 20 10 1e } [ 1 2 FCTIWZ ] test-assembler
|
||||||
B{ HEX: fc HEX: 22 HEX: 00 HEX: f2 } [ 1 2 3 FMUL ] test-assembler
|
HEX{ fc 22 18 2a } [ 1 2 3 FADD ] test-assembler
|
||||||
B{ HEX: fc HEX: 22 HEX: 18 HEX: 24 } [ 1 2 3 FDIV ] test-assembler
|
HEX{ fc 22 18 2b } [ 1 2 3 FADD. ] test-assembler
|
||||||
B{ HEX: fc HEX: 20 HEX: 10 HEX: 2c } [ 1 2 FSQRT ] test-assembler
|
HEX{ fc 22 18 28 } [ 1 2 3 FSUB ] test-assembler
|
||||||
B{ HEX: fc HEX: 41 HEX: 18 HEX: 00 } [ 1 2 3 FCMPU ] test-assembler
|
HEX{ fc 22 00 f2 } [ 1 2 3 FMUL ] test-assembler
|
||||||
B{ HEX: fc HEX: 41 HEX: 18 HEX: 40 } [ 1 2 3 FCMPO ] test-assembler
|
HEX{ fc 22 18 24 } [ 1 2 3 FDIV ] test-assembler
|
||||||
B{ HEX: 3c HEX: 60 HEX: 12 HEX: 34 HEX: 60 HEX: 63 HEX: 56 HEX: 78 } [ HEX: 12345678 3 LOAD ] test-assembler
|
HEX{ fc 20 10 2c } [ 1 2 FSQRT ] test-assembler
|
||||||
|
HEX{ fc 41 18 00 } [ 1 2 3 FCMPU ] test-assembler
|
||||||
|
HEX{ fc 41 18 40 } [ 1 2 3 FCMPO ] test-assembler
|
||||||
|
HEX{ 3c 60 12 34 60 63 56 78 } [ HEX: 12345678 3 LOAD ] test-assembler
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2005, 2008 Slava Pestov.
|
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel namespaces words io.binary math math.order
|
USING: kernel namespaces words math math.order locals
|
||||||
cpu.ppc.assembler.backend ;
|
cpu.ppc.assembler.backend ;
|
||||||
IN: cpu.ppc.assembler
|
IN: cpu.ppc.assembler
|
||||||
|
|
||||||
|
@ -97,8 +97,8 @@ X: XOR 0 316 31
|
||||||
X: XOR. 1 316 31
|
X: XOR. 1 316 31
|
||||||
X1: EXTSB 0 954 31
|
X1: EXTSB 0 954 31
|
||||||
X1: EXTSB. 1 954 31
|
X1: EXTSB. 1 954 31
|
||||||
: FMR ( a s -- ) [ 0 ] 2dip 72 0 63 x-insn ;
|
: FMR ( a s -- ) [ 0 ] 2dip 0 72 63 x-insn ;
|
||||||
: FMR. ( a s -- ) [ 0 ] 2dip 72 1 63 x-insn ;
|
: FMR. ( a s -- ) [ 0 ] 2dip 1 72 63 x-insn ;
|
||||||
: FCTIWZ ( a s -- ) [ 0 ] 2dip 0 15 63 x-insn ;
|
: FCTIWZ ( a s -- ) [ 0 ] 2dip 0 15 63 x-insn ;
|
||||||
: FCTIWZ. ( a s -- ) [ 0 ] 2dip 1 15 63 x-insn ;
|
: FCTIWZ. ( a s -- ) [ 0 ] 2dip 1 15 63 x-insn ;
|
||||||
|
|
||||||
|
@ -189,9 +189,9 @@ MTSPR: LR 8
|
||||||
MTSPR: CTR 9
|
MTSPR: CTR 9
|
||||||
|
|
||||||
! Pseudo-instructions
|
! Pseudo-instructions
|
||||||
: LI ( value dst -- ) 0 rot ADDI ; inline
|
: LI ( value dst -- ) swap [ 0 ] dip ADDI ; inline
|
||||||
: SUBI ( dst src1 src2 -- ) neg ADDI ; inline
|
: SUBI ( dst src1 src2 -- ) neg ADDI ; inline
|
||||||
: LIS ( value dst -- ) 0 rot ADDIS ; inline
|
: LIS ( value dst -- ) swap [ 0 ] dip ADDIS ; inline
|
||||||
: SUBIC ( dst src1 src2 -- ) neg ADDIC ; inline
|
: SUBIC ( dst src1 src2 -- ) neg ADDIC ; inline
|
||||||
: SUBIC. ( dst src1 src2 -- ) neg ADDIC. ; inline
|
: SUBIC. ( dst src1 src2 -- ) neg ADDIC. ; inline
|
||||||
: NOT ( dst src -- ) dup NOR ; inline
|
: NOT ( dst src -- ) dup NOR ; inline
|
||||||
|
@ -204,6 +204,8 @@ MTSPR: CTR 9
|
||||||
: (SRWI) ( d a b -- d a b x y ) 32 over - swap 31 ; inline
|
: (SRWI) ( d a b -- d a b x y ) 32 over - swap 31 ; inline
|
||||||
: SRWI ( d a b -- ) (SRWI) RLWINM ;
|
: SRWI ( d a b -- ) (SRWI) RLWINM ;
|
||||||
: SRWI. ( d a b -- ) (SRWI) RLWINM. ;
|
: SRWI. ( d a b -- ) (SRWI) RLWINM. ;
|
||||||
: LOAD32 ( n r -- ) [ w>h/h ] dip tuck LIS dup rot ORI ;
|
:: LOAD32 ( n r -- )
|
||||||
|
n -16 shift HEX: ffff bitand r LIS
|
||||||
|
r r n HEX: ffff bitand ORI ;
|
||||||
: immediate? ( n -- ? ) HEX: -8000 HEX: 7fff between? ;
|
: immediate? ( n -- ? ) HEX: -8000 HEX: 7fff between? ;
|
||||||
: LOAD ( n r -- ) over immediate? [ LI ] [ LOAD32 ] if ;
|
: LOAD ( n r -- ) over immediate? [ LI ] [ LOAD32 ] if ;
|
||||||
|
|
|
@ -62,7 +62,7 @@ M: rs-loc loc-reg drop rs-reg ;
|
||||||
M: ppc %peek loc>operand LWZ ;
|
M: ppc %peek loc>operand LWZ ;
|
||||||
M: ppc %replace loc>operand STW ;
|
M: ppc %replace loc>operand STW ;
|
||||||
|
|
||||||
: (%inc) ( n reg -- ) dup rot cells ADDI ; inline
|
:: (%inc) ( n reg -- ) reg reg n cells ADDI ; inline
|
||||||
|
|
||||||
M: ppc %inc-d ( n -- ) ds-reg (%inc) ;
|
M: ppc %inc-d ( n -- ) ds-reg (%inc) ;
|
||||||
M: ppc %inc-r ( n -- ) rs-reg (%inc) ;
|
M: ppc %inc-r ( n -- ) rs-reg (%inc) ;
|
||||||
|
|
|
@ -208,13 +208,13 @@ M: x86 %unbox-small-struct ( size -- )
|
||||||
{ 2 [ %unbox-struct-2 ] }
|
{ 2 [ %unbox-struct-2 ] }
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
M: x86.32 %unbox-large-struct ( n c-type -- )
|
M:: x86.32 %unbox-large-struct ( n c-type -- )
|
||||||
! Alien must be in EAX.
|
! Alien must be in EAX.
|
||||||
! Compute destination address
|
! Compute destination address
|
||||||
ECX rot stack@ LEA
|
ECX n stack@ LEA
|
||||||
12 [
|
12 [
|
||||||
! Push struct size
|
! Push struct size
|
||||||
heap-size PUSH
|
c-type heap-size PUSH
|
||||||
! Push destination address
|
! Push destination address
|
||||||
ECX PUSH
|
ECX PUSH
|
||||||
! Push source address
|
! Push source address
|
||||||
|
@ -304,6 +304,7 @@ USING: cpu.x86.features cpu.x86.features.private ;
|
||||||
sse2? [
|
sse2? [
|
||||||
" - yes" print
|
" - yes" print
|
||||||
enable-float-intrinsics
|
enable-float-intrinsics
|
||||||
|
enable-fsqrt
|
||||||
[
|
[
|
||||||
sse2? [
|
sse2? [
|
||||||
"This image was built to use SSE2, which your CPU does not support." print
|
"This image was built to use SSE2, which your CPU does not support." print
|
||||||
|
|
|
@ -102,13 +102,12 @@ M: x86.64 %unbox-small-struct ( c-type -- )
|
||||||
flatten-value-type [ %unbox-struct-field ] each-index
|
flatten-value-type [ %unbox-struct-field ] each-index
|
||||||
] with-return-regs ;
|
] with-return-regs ;
|
||||||
|
|
||||||
M: x86.64 %unbox-large-struct ( n c-type -- )
|
M:: x86.64 %unbox-large-struct ( n c-type -- )
|
||||||
! Source is in param-reg-1
|
! Source is in param-reg-1
|
||||||
heap-size
|
! Load destination address into param-reg-2
|
||||||
! Load destination address
|
param-reg-2 n param@ LEA
|
||||||
param-reg-2 rot param@ LEA
|
! Load structure size into param-reg-3
|
||||||
! Load structure size
|
param-reg-3 c-type heap-size MOV
|
||||||
param-reg-3 swap MOV
|
|
||||||
! Copy the struct to the C stack
|
! Copy the struct to the C stack
|
||||||
"to_value_struct" f %alien-invoke ;
|
"to_value_struct" f %alien-invoke ;
|
||||||
|
|
||||||
|
@ -204,6 +203,7 @@ enable-alien-4-intrinsics
|
||||||
|
|
||||||
! SSE2 is always available on x86-64.
|
! SSE2 is always available on x86-64.
|
||||||
enable-float-intrinsics
|
enable-float-intrinsics
|
||||||
|
enable-fsqrt
|
||||||
|
|
||||||
USE: vocabs.loader
|
USE: vocabs.loader
|
||||||
|
|
||||||
|
|
|
@ -203,6 +203,7 @@ M: x86 %add-float nip ADDSD ;
|
||||||
M: x86 %sub-float nip SUBSD ;
|
M: x86 %sub-float nip SUBSD ;
|
||||||
M: x86 %mul-float nip MULSD ;
|
M: x86 %mul-float nip MULSD ;
|
||||||
M: x86 %div-float nip DIVSD ;
|
M: x86 %div-float nip DIVSD ;
|
||||||
|
M: x86 %sqrt SQRTSD ;
|
||||||
|
|
||||||
M: x86 %integer>float CVTSI2SD ;
|
M: x86 %integer>float CVTSI2SD ;
|
||||||
M: x86 %float>integer CVTTSD2SI ;
|
M: x86 %float>integer CVTTSD2SI ;
|
||||||
|
|
|
@ -57,7 +57,7 @@ M: unix find-next-file ( DIR* -- byte-array )
|
||||||
|
|
||||||
M: unix >directory-entry ( byte-array -- directory-entry )
|
M: unix >directory-entry ( byte-array -- directory-entry )
|
||||||
{
|
{
|
||||||
[ dirent-d_name utf8 alien>string ]
|
[ dirent-d_name underlying>> utf8 alien>string ]
|
||||||
[ dirent-d_type dirent-type>file-type ]
|
[ dirent-d_type dirent-type>file-type ]
|
||||||
} cleave directory-entry boa ;
|
} cleave directory-entry boa ;
|
||||||
|
|
||||||
|
|
|
@ -5,69 +5,52 @@ IN: math.libm
|
||||||
|
|
||||||
: facos ( x -- y )
|
: facos ( x -- y )
|
||||||
"double" "libm" "acos" { "double" } alien-invoke ;
|
"double" "libm" "acos" { "double" } alien-invoke ;
|
||||||
inline
|
|
||||||
|
|
||||||
: fasin ( x -- y )
|
: fasin ( x -- y )
|
||||||
"double" "libm" "asin" { "double" } alien-invoke ;
|
"double" "libm" "asin" { "double" } alien-invoke ;
|
||||||
inline
|
|
||||||
|
|
||||||
: fatan ( x -- y )
|
: fatan ( x -- y )
|
||||||
"double" "libm" "atan" { "double" } alien-invoke ;
|
"double" "libm" "atan" { "double" } alien-invoke ;
|
||||||
inline
|
|
||||||
|
|
||||||
: fatan2 ( x y -- z )
|
: fatan2 ( x y -- z )
|
||||||
"double" "libm" "atan2" { "double" "double" } alien-invoke ;
|
"double" "libm" "atan2" { "double" "double" } alien-invoke ;
|
||||||
inline
|
|
||||||
|
|
||||||
: fcos ( x -- y )
|
: fcos ( x -- y )
|
||||||
"double" "libm" "cos" { "double" } alien-invoke ;
|
"double" "libm" "cos" { "double" } alien-invoke ;
|
||||||
inline
|
|
||||||
|
|
||||||
: fsin ( x -- y )
|
: fsin ( x -- y )
|
||||||
"double" "libm" "sin" { "double" } alien-invoke ;
|
"double" "libm" "sin" { "double" } alien-invoke ;
|
||||||
inline
|
|
||||||
|
|
||||||
: ftan ( x -- y )
|
: ftan ( x -- y )
|
||||||
"double" "libm" "tan" { "double" } alien-invoke ;
|
"double" "libm" "tan" { "double" } alien-invoke ;
|
||||||
inline
|
|
||||||
|
|
||||||
: fcosh ( x -- y )
|
: fcosh ( x -- y )
|
||||||
"double" "libm" "cosh" { "double" } alien-invoke ;
|
"double" "libm" "cosh" { "double" } alien-invoke ;
|
||||||
inline
|
|
||||||
|
|
||||||
: fsinh ( x -- y )
|
: fsinh ( x -- y )
|
||||||
"double" "libm" "sinh" { "double" } alien-invoke ;
|
"double" "libm" "sinh" { "double" } alien-invoke ;
|
||||||
inline
|
|
||||||
|
|
||||||
: ftanh ( x -- y )
|
: ftanh ( x -- y )
|
||||||
"double" "libm" "tanh" { "double" } alien-invoke ;
|
"double" "libm" "tanh" { "double" } alien-invoke ;
|
||||||
inline
|
|
||||||
|
|
||||||
: fexp ( x -- y )
|
: fexp ( x -- y )
|
||||||
"double" "libm" "exp" { "double" } alien-invoke ;
|
"double" "libm" "exp" { "double" } alien-invoke ;
|
||||||
inline
|
|
||||||
|
|
||||||
: flog ( x -- y )
|
: flog ( x -- y )
|
||||||
"double" "libm" "log" { "double" } alien-invoke ;
|
"double" "libm" "log" { "double" } alien-invoke ;
|
||||||
inline
|
|
||||||
|
|
||||||
: fpow ( x y -- z )
|
: fpow ( x y -- z )
|
||||||
"double" "libm" "pow" { "double" "double" } alien-invoke ;
|
"double" "libm" "pow" { "double" "double" } alien-invoke ;
|
||||||
inline
|
|
||||||
|
|
||||||
: fsqrt ( x -- y )
|
: fsqrt ( x -- y )
|
||||||
"double" "libm" "sqrt" { "double" } alien-invoke ;
|
"double" "libm" "sqrt" { "double" } alien-invoke ;
|
||||||
inline
|
|
||||||
|
|
||||||
! Windows doesn't have these...
|
! Windows doesn't have these...
|
||||||
: facosh ( x -- y )
|
: facosh ( x -- y )
|
||||||
"double" "libm" "acosh" { "double" } alien-invoke ;
|
"double" "libm" "acosh" { "double" } alien-invoke ;
|
||||||
inline
|
|
||||||
|
|
||||||
: fasinh ( x -- y )
|
: fasinh ( x -- y )
|
||||||
"double" "libm" "asinh" { "double" } alien-invoke ;
|
"double" "libm" "asinh" { "double" } alien-invoke ;
|
||||||
inline
|
|
||||||
|
|
||||||
: fatanh ( x -- y )
|
: fatanh ( x -- y )
|
||||||
"double" "libm" "atanh" { "double" } alien-invoke ;
|
"double" "libm" "atanh" { "double" } alien-invoke ;
|
||||||
inline
|
|
||||||
|
|
|
@ -8,6 +8,7 @@ IN: specialized-arrays.direct.functor
|
||||||
FUNCTOR: define-direct-array ( T -- )
|
FUNCTOR: define-direct-array ( T -- )
|
||||||
|
|
||||||
A' IS ${T}-array
|
A' IS ${T}-array
|
||||||
|
S IS ${T}-sequence
|
||||||
>A' IS >${T}-array
|
>A' IS >${T}-array
|
||||||
<A'> IS <${A'}>
|
<A'> IS <${A'}>
|
||||||
A'{ IS ${A'}{
|
A'{ IS ${A'}{
|
||||||
|
@ -31,6 +32,8 @@ M: A set-nth-unsafe underlying>> SET-NTH call ;
|
||||||
M: A like drop dup A instance? [ >A' ] unless ;
|
M: A like drop dup A instance? [ >A' ] unless ;
|
||||||
M: A new-sequence drop <A'> ;
|
M: A new-sequence drop <A'> ;
|
||||||
|
|
||||||
|
M: A byte-length length>> T heap-size * ;
|
||||||
|
|
||||||
M: A pprint-delims drop \ A'{ \ } ;
|
M: A pprint-delims drop \ A'{ \ } ;
|
||||||
|
|
||||||
M: A >pprint-sequence ;
|
M: A >pprint-sequence ;
|
||||||
|
@ -38,5 +41,11 @@ M: A >pprint-sequence ;
|
||||||
M: A pprint* pprint-object ;
|
M: A pprint* pprint-object ;
|
||||||
|
|
||||||
INSTANCE: A sequence
|
INSTANCE: A sequence
|
||||||
|
INSTANCE: A S
|
||||||
|
|
||||||
|
T c-type
|
||||||
|
\ A >>direct-array-class
|
||||||
|
\ <A> >>direct-array-constructor
|
||||||
|
drop
|
||||||
|
|
||||||
;FUNCTOR
|
;FUNCTOR
|
||||||
|
|
|
@ -16,6 +16,7 @@ M: bad-byte-array-length summary
|
||||||
FUNCTOR: define-array ( T -- )
|
FUNCTOR: define-array ( T -- )
|
||||||
|
|
||||||
A DEFINES-CLASS ${T}-array
|
A DEFINES-CLASS ${T}-array
|
||||||
|
S DEFINES-CLASS ${T}-sequence
|
||||||
<A> DEFINES <${A}>
|
<A> DEFINES <${A}>
|
||||||
(A) DEFINES (${A})
|
(A) DEFINES (${A})
|
||||||
>A DEFINES >${A}
|
>A DEFINES >${A}
|
||||||
|
@ -27,6 +28,8 @@ SET-NTH [ T dup c-setter array-accessor ]
|
||||||
|
|
||||||
WHERE
|
WHERE
|
||||||
|
|
||||||
|
MIXIN: S
|
||||||
|
|
||||||
TUPLE: A
|
TUPLE: A
|
||||||
{ length array-capacity read-only }
|
{ length array-capacity read-only }
|
||||||
{ underlying byte-array read-only } ;
|
{ underlying byte-array read-only } ;
|
||||||
|
@ -73,7 +76,14 @@ M: A pprint* pprint-object ;
|
||||||
SYNTAX: A{ \ } [ >A ] parse-literal ;
|
SYNTAX: A{ \ } [ >A ] parse-literal ;
|
||||||
|
|
||||||
INSTANCE: A sequence
|
INSTANCE: A sequence
|
||||||
|
INSTANCE: A S
|
||||||
|
|
||||||
A T c-type-boxed-class specialize-vector-words
|
A T c-type-boxed-class specialize-vector-words
|
||||||
|
|
||||||
|
T c-type
|
||||||
|
\ A >>array-class
|
||||||
|
\ <A> >>array-constructor
|
||||||
|
\ S >>sequence-mixin-class
|
||||||
|
drop
|
||||||
|
|
||||||
;FUNCTOR
|
;FUNCTOR
|
||||||
|
|
|
@ -10,6 +10,7 @@ FUNCTOR: define-vector ( T -- )
|
||||||
V DEFINES-CLASS ${T}-vector
|
V DEFINES-CLASS ${T}-vector
|
||||||
|
|
||||||
A IS ${T}-array
|
A IS ${T}-array
|
||||||
|
S IS ${T}-sequence
|
||||||
<A> IS <${A}>
|
<A> IS <${A}>
|
||||||
|
|
||||||
>V DEFERS >${V}
|
>V DEFERS >${V}
|
||||||
|
@ -32,5 +33,6 @@ M: V pprint* pprint-object ;
|
||||||
SYNTAX: V{ \ } [ >V ] parse-literal ;
|
SYNTAX: V{ \ } [ >V ] parse-literal ;
|
||||||
|
|
||||||
INSTANCE: V growable
|
INSTANCE: V growable
|
||||||
|
INSTANCE: V S
|
||||||
|
|
||||||
;FUNCTOR
|
;FUNCTOR
|
||||||
|
|
|
@ -148,7 +148,7 @@ TUPLE: ole32-error code message ;
|
||||||
[ ]
|
[ ]
|
||||||
} 2cleave
|
} 2cleave
|
||||||
|
|
||||||
GUID-Data4 8 <direct-uchar-array> {
|
GUID-Data4 {
|
||||||
[ 20 22 0 (guid-byte>guid) ]
|
[ 20 22 0 (guid-byte>guid) ]
|
||||||
[ 22 24 1 (guid-byte>guid) ]
|
[ 22 24 1 (guid-byte>guid) ]
|
||||||
|
|
||||||
|
@ -175,7 +175,7 @@ TUPLE: ole32-error code message ;
|
||||||
[ [ GUID-Data3 ] 4 (guid-section%) "-" % ]
|
[ [ GUID-Data3 ] 4 (guid-section%) "-" % ]
|
||||||
[ ]
|
[ ]
|
||||||
} cleave
|
} cleave
|
||||||
GUID-Data4 8 <direct-uchar-array> {
|
GUID-Data4 {
|
||||||
[ 0 (guid-byte%) ]
|
[ 0 (guid-byte%) ]
|
||||||
[ 1 (guid-byte%) "-" % ]
|
[ 1 (guid-byte%) "-" % ]
|
||||||
[ 2 (guid-byte%) ]
|
[ 2 (guid-byte%) ]
|
||||||
|
|
|
@ -12,6 +12,9 @@ M: c-ptr alien>string
|
||||||
[ <memory-stream> ] [ <decoder> ] bi*
|
[ <memory-stream> ] [ <decoder> ] bi*
|
||||||
"\0" swap stream-read-until drop ;
|
"\0" swap stream-read-until drop ;
|
||||||
|
|
||||||
|
M: object alien>string
|
||||||
|
[ underlying>> ] dip alien>string ;
|
||||||
|
|
||||||
M: f alien>string
|
M: f alien>string
|
||||||
drop ;
|
drop ;
|
||||||
|
|
||||||
|
|
|
@ -155,7 +155,7 @@ DEFER: create ( level c r -- scene )
|
||||||
] with map ;
|
] with map ;
|
||||||
|
|
||||||
: ray-pixel ( scene point -- n )
|
: ray-pixel ( scene point -- n )
|
||||||
ss-grid ray-grid 0.0 -rot
|
ss-grid ray-grid [ 0.0 ] 2dip
|
||||||
[ [ swap cast-ray + ] with each ] with each ;
|
[ [ swap cast-ray + ] with each ] with each ;
|
||||||
|
|
||||||
: pixel-grid ( -- grid )
|
: pixel-grid ( -- grid )
|
||||||
|
|
|
@ -1,9 +1,10 @@
|
||||||
! (c)Joe Groff bsd license
|
! (c)Joe Groff bsd license
|
||||||
USING: accessors alien.c-types alien.libraries
|
USING: accessors alien.c-types alien.libraries
|
||||||
alien.structs.fields alien.syntax classes.struct combinators
|
alien.structs.fields alien.syntax ascii classes.struct combinators
|
||||||
destructors io.pathnames io.streams.string kernel libc literals math
|
destructors io.encodings.utf8 io.pathnames io.streams.string
|
||||||
multiline namespaces prettyprint prettyprint.config see system
|
kernel libc literals math multiline namespaces prettyprint
|
||||||
tools.test ;
|
prettyprint.config see sequences specialized-arrays.ushort
|
||||||
|
system tools.test ;
|
||||||
IN: classes.struct.tests
|
IN: classes.struct.tests
|
||||||
|
|
||||||
<<
|
<<
|
||||||
|
@ -30,6 +31,7 @@ STRUCT: struct-test-bar
|
||||||
{ foo struct-test-foo } ;
|
{ foo struct-test-foo } ;
|
||||||
|
|
||||||
[ 12 ] [ struct-test-foo heap-size ] unit-test
|
[ 12 ] [ struct-test-foo heap-size ] unit-test
|
||||||
|
[ 12 ] [ struct-test-foo <struct> byte-length ] unit-test
|
||||||
[ 16 ] [ struct-test-bar heap-size ] unit-test
|
[ 16 ] [ struct-test-bar heap-size ] unit-test
|
||||||
[ 123 ] [ struct-test-foo <struct> y>> ] unit-test
|
[ 123 ] [ struct-test-foo <struct> y>> ] unit-test
|
||||||
[ 123 ] [ struct-test-bar <struct> foo>> y>> ] unit-test
|
[ 123 ] [ struct-test-bar <struct> foo>> y>> ] unit-test
|
||||||
|
@ -144,3 +146,16 @@ LIBRARY: f-cdecl
|
||||||
FUNCTION: int ffi_test_11 ( int a, struct-test-ffi-foo b, int c ) ;
|
FUNCTION: int ffi_test_11 ( int a, struct-test-ffi-foo b, int c ) ;
|
||||||
|
|
||||||
[ 14 ] [ 1 2 3 struct-test-ffi-foo <struct-boa> 4 ffi_test_11 ] unit-test
|
[ 14 ] [ 1 2 3 struct-test-ffi-foo <struct-boa> 4 ffi_test_11 ] unit-test
|
||||||
|
|
||||||
|
STRUCT: struct-test-array-slots
|
||||||
|
{ x int }
|
||||||
|
{ y ushort[6] initial: ushort-array{ 2 3 5 7 11 13 } }
|
||||||
|
{ z int } ;
|
||||||
|
|
||||||
|
[ 11 ] [ struct-test-array-slots <struct> y>> 4 swap nth ] unit-test
|
||||||
|
|
||||||
|
[ t ] [
|
||||||
|
struct-test-array-slots <struct>
|
||||||
|
[ y>> [ 8 3 ] dip set-nth ]
|
||||||
|
[ y>> ushort-array{ 2 3 5 8 11 13 } sequence= ] bi
|
||||||
|
] unit-test
|
||||||
|
|
|
@ -94,6 +94,10 @@ M: struct-class writer-quot
|
||||||
[ \ struct-slot-values create-method-in ]
|
[ \ struct-slot-values create-method-in ]
|
||||||
[ struct-slot-values-quot ] bi define ;
|
[ struct-slot-values-quot ] bi define ;
|
||||||
|
|
||||||
|
: (define-byte-length-method) ( class -- )
|
||||||
|
[ \ byte-length create-method-in ]
|
||||||
|
[ heap-size \ drop swap [ ] 2sequence ] bi define ;
|
||||||
|
|
||||||
! Struct as c-type
|
! Struct as c-type
|
||||||
|
|
||||||
: slot>field ( slot -- field )
|
: slot>field ( slot -- field )
|
||||||
|
@ -113,7 +117,7 @@ M: struct-class writer-quot
|
||||||
[ "struct-align" word-prop ]
|
[ "struct-align" word-prop ]
|
||||||
[ struct-slots [ slot>field ] map ]
|
[ struct-slots [ slot>field ] map ]
|
||||||
} cleave
|
} cleave
|
||||||
(define-struct)
|
struct-type (define-struct)
|
||||||
] [
|
] [
|
||||||
{
|
{
|
||||||
[ name>> c-type ]
|
[ name>> c-type ]
|
||||||
|
@ -172,6 +176,10 @@ M: struct-class heap-size
|
||||||
over [ swapd [ call( value struct -- ) ] curry keep ] [ 2drop ] if
|
over [ swapd [ call( value struct -- ) ] curry keep ] [ 2drop ] if
|
||||||
] each ;
|
] each ;
|
||||||
|
|
||||||
|
: (struct-methods) ( class -- )
|
||||||
|
[ (define-struct-slot-values-method) ]
|
||||||
|
[ (define-byte-length-method) ] bi ;
|
||||||
|
|
||||||
: (struct-word-props) ( class slots size align -- )
|
: (struct-word-props) ( class slots size align -- )
|
||||||
[
|
[
|
||||||
[ "struct-slots" set-word-prop ]
|
[ "struct-slots" set-word-prop ]
|
||||||
|
@ -181,7 +189,7 @@ M: struct-class heap-size
|
||||||
[ "struct-align" set-word-prop ] tri-curry*
|
[ "struct-align" set-word-prop ] tri-curry*
|
||||||
[ tri ] 3curry
|
[ tri ] 3curry
|
||||||
[ dup struct-prototype "prototype" set-word-prop ]
|
[ dup struct-prototype "prototype" set-word-prop ]
|
||||||
[ (define-struct-slot-values-method) ] tri ;
|
[ (struct-methods) ] tri ;
|
||||||
|
|
||||||
: check-struct-slots ( slots -- )
|
: check-struct-slots ( slots -- )
|
||||||
[ c-type>> c-type drop ] each ;
|
[ c-type>> c-type drop ] each ;
|
||||||
|
|
Loading…
Reference in New Issue