From f56615cec0a0d44ab8450d5c811e3d474f9d9cf3 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 25 Aug 2009 15:58:18 -0500 Subject: [PATCH 01/23] add an X-sequence mixin class for each specialized array type to span X-array, X-vector, and direct-X-array --- basis/specialized-arrays/direct/functor/functor.factor | 3 +++ basis/specialized-arrays/functor/functor.factor | 5 +++++ basis/specialized-vectors/functor/functor.factor | 3 +++ 3 files changed, 11 insertions(+) diff --git a/basis/specialized-arrays/direct/functor/functor.factor b/basis/specialized-arrays/direct/functor/functor.factor index b49dfa35e4..89d1b5423d 100755 --- a/basis/specialized-arrays/direct/functor/functor.factor +++ b/basis/specialized-arrays/direct/functor/functor.factor @@ -8,6 +8,7 @@ IN: specialized-arrays.direct.functor FUNCTOR: define-direct-array ( T -- ) A' IS ${T}-array +S IS ${T}-sequence >A' IS >${T}-array IS <${A'}> A'{ IS ${A'}{ @@ -24,6 +25,8 @@ TUPLE: A { underlying c-ptr read-only } { length fixnum read-only } ; +INSTANCE: A S + : ( alien len -- direct-array ) A boa ; inline M: A length length>> ; M: A nth-unsafe underlying>> NTH call ; diff --git a/basis/specialized-arrays/functor/functor.factor b/basis/specialized-arrays/functor/functor.factor index 06b9aef17d..a8d8d677ec 100644 --- a/basis/specialized-arrays/functor/functor.factor +++ b/basis/specialized-arrays/functor/functor.factor @@ -16,6 +16,7 @@ M: bad-byte-array-length summary FUNCTOR: define-array ( T -- ) A DEFINES-CLASS ${T}-array +S DEFINES-CLASS ${T}-sequence DEFINES <${A}> (A) DEFINES (${A}) >A DEFINES >${A} @@ -27,10 +28,14 @@ SET-NTH [ T dup c-setter array-accessor ] WHERE +MIXIN: S + TUPLE: A { length array-capacity read-only } { underlying byte-array read-only } ; +INSTANCE: A S + : ( n -- specialized-array ) dup T A boa ; inline : (A) ( n -- specialized-array ) dup T (c-array) A boa ; inline diff --git a/basis/specialized-vectors/functor/functor.factor b/basis/specialized-vectors/functor/functor.factor index 08c44cd197..48c480b4d1 100644 --- a/basis/specialized-vectors/functor/functor.factor +++ b/basis/specialized-vectors/functor/functor.factor @@ -10,6 +10,7 @@ FUNCTOR: define-vector ( T -- ) V DEFINES-CLASS ${T}-vector A IS ${T}-array +S IS ${T}-sequence IS <${A}> >V DEFERS >${V} @@ -19,6 +20,8 @@ WHERE V A vectors.functor:define-vector +INSTANCE: V S + M: V contract 2drop ; M: V byte-length underlying>> byte-length ; From 182963b9c49d2c0546c5a87e7d57b9bdb535d924 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 25 Aug 2009 17:19:26 -0500 Subject: [PATCH 02/23] add missing use to classes.struct tests --- extra/classes/struct/struct-tests.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/classes/struct/struct-tests.factor b/extra/classes/struct/struct-tests.factor index 51df207003..5da1714803 100644 --- a/extra/classes/struct/struct-tests.factor +++ b/extra/classes/struct/struct-tests.factor @@ -1,9 +1,9 @@ ! (c)Joe Groff bsd license USING: accessors alien.c-types alien.libraries alien.structs.fields alien.syntax classes.struct combinators -destructors io.pathnames io.streams.string kernel libc literals math -multiline namespaces prettyprint prettyprint.config see system -tools.test ; +destructors io.encodings.utf8 io.pathnames io.streams.string +kernel libc literals math multiline namespaces prettyprint +prettyprint.config see system tools.test ; IN: classes.struct.tests << From 79787f6259a8861055ed1de71f28660781729956 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 25 Aug 2009 17:56:01 -0500 Subject: [PATCH 03/23] associate specialized-arrays vocabs with c-types; add words for requiring vocabs and constructing arrays by C type --- basis/alien/c-types/c-types.factor | 96 ++++++++++++++++++- .../direct/functor/functor.factor | 8 +- .../specialized-arrays/functor/functor.factor | 9 +- .../functor/functor.factor | 3 +- 4 files changed, 108 insertions(+), 8 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 2eba6a2b9e..65f663e7b6 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -5,7 +5,7 @@ namespaces make parser sequences strings words splitting math.parser cpu.architecture alien alien.accessors alien.strings quotations layouts system compiler.units io io.files io.encodings.binary io.streams.memory accessors combinators effects continuations fry -classes ; +classes vocabs vocabs.loader ; IN: alien.c-types DEFER: @@ -27,7 +27,12 @@ TUPLE: c-type < abstract-c-type boxer unboxer { rep initial: int-rep } -stack-align? ; +stack-align? +array-class +array-constructor +direct-array-class +direct-array-constructor +sequence-mixin-class ; : ( -- type ) \ c-type new ; @@ -71,6 +76,48 @@ M: string c-type ( name -- type ) ] ?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 ; + +GENERIC: c-type-array-constructor ( c-type -- word ) foldable + +M: string c-type-array-constructor + c-type c-type-array-constructor ; +M: array c-type-array-constructor + first c-type c-type-array-constructor ; +M: c-type c-type-array-constructor + array-constructor>> ; + +GENERIC: c-type-direct-array-constructor ( c-type -- word ) foldable + +M: string c-type-direct-array-constructor + c-type c-type-array-constructor ; +M: array c-type-direct-array-constructor + first c-type c-type-direct-array-constructor ; +M: c-type c-type-direct-array-constructor + direct-array-constructor>> ; + +: ( len c-type -- array ) + c-type-array-constructor execute( len -- array ) ; inline +: ( len c-type -- array ) + c-type-direct-array-constructor execute( len -- array ) ; inline + GENERIC: c-type-class ( name -- class ) M: abstract-c-type c-type-class class>> ; @@ -293,6 +340,36 @@ M: long-long-type box-return ( type -- ) : if-void ( type true false -- ) 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 ] + [ "" surround ] bi* ?lookup >>direct-array-constructor + ] + } 2cleave ; + +: set-array-class ( c-type stem -- c-type ) + dup set-array-class* ; + CONSTANT: primitive-types { "char" "uchar" @@ -315,6 +392,7 @@ CONSTANT: primitive-types [ >c-ptr ] >>unboxer-quot "box_alien" >>boxer "alien_offset" >>unboxer + "alien" "void*" set-array-class* "void*" define-primitive-type @@ -326,6 +404,7 @@ CONSTANT: primitive-types 8 >>align "box_signed_8" >>boxer "to_signed_8" >>unboxer + "longlong" set-array-class "longlong" define-primitive-type @@ -337,6 +416,7 @@ CONSTANT: primitive-types 8 >>align "box_unsigned_8" >>boxer "to_unsigned_8" >>unboxer + "ulonglong" set-array-class "ulonglong" define-primitive-type @@ -348,6 +428,7 @@ CONSTANT: primitive-types bootstrap-cell >>align "box_signed_cell" >>boxer "to_fixnum" >>unboxer + "long" set-array-class "long" define-primitive-type @@ -359,6 +440,7 @@ CONSTANT: primitive-types bootstrap-cell >>align "box_unsigned_cell" >>boxer "to_cell" >>unboxer + "ulong" set-array-class "ulong" define-primitive-type @@ -370,6 +452,7 @@ CONSTANT: primitive-types 4 >>align "box_signed_4" >>boxer "to_fixnum" >>unboxer + "int" set-array-class "int" define-primitive-type @@ -381,6 +464,7 @@ CONSTANT: primitive-types 4 >>align "box_unsigned_4" >>boxer "to_cell" >>unboxer + "uint" set-array-class "uint" define-primitive-type @@ -392,6 +476,7 @@ CONSTANT: primitive-types 2 >>align "box_signed_2" >>boxer "to_fixnum" >>unboxer + "short" set-array-class "short" define-primitive-type @@ -403,6 +488,7 @@ CONSTANT: primitive-types 2 >>align "box_unsigned_2" >>boxer "to_cell" >>unboxer + "ushort" set-array-class "ushort" define-primitive-type @@ -414,6 +500,7 @@ CONSTANT: primitive-types 1 >>align "box_signed_1" >>boxer "to_fixnum" >>unboxer + "char" set-array-class "char" define-primitive-type @@ -425,6 +512,7 @@ CONSTANT: primitive-types 1 >>align "box_unsigned_1" >>boxer "to_cell" >>unboxer + "uchar" set-array-class "uchar" define-primitive-type @@ -434,6 +522,7 @@ CONSTANT: primitive-types 1 >>align "box_boolean" >>boxer "to_boolean" >>unboxer + "bool" set-array-class "bool" define-primitive-type @@ -447,6 +536,7 @@ CONSTANT: primitive-types "to_float" >>unboxer single-float-rep >>rep [ >float ] >>unboxer-quot + "float" set-array-class "float" define-primitive-type @@ -460,9 +550,11 @@ CONSTANT: primitive-types "to_double" >>unboxer double-float-rep >>rep [ >float ] >>unboxer-quot + "double" set-array-class "double" define-primitive-type "long" "ptrdiff_t" typedef "long" "intptr_t" typedef "ulong" "size_t" typedef ] with-compilation-unit + diff --git a/basis/specialized-arrays/direct/functor/functor.factor b/basis/specialized-arrays/direct/functor/functor.factor index 89d1b5423d..4b80940153 100755 --- a/basis/specialized-arrays/direct/functor/functor.factor +++ b/basis/specialized-arrays/direct/functor/functor.factor @@ -25,8 +25,6 @@ TUPLE: A { underlying c-ptr read-only } { length fixnum read-only } ; -INSTANCE: A S - : ( alien len -- direct-array ) A boa ; inline M: A length length>> ; M: A nth-unsafe underlying>> NTH call ; @@ -41,5 +39,11 @@ M: A >pprint-sequence ; M: A pprint* pprint-object ; INSTANCE: A sequence +INSTANCE: A S + +T c-type + \ A >>direct-array-class + \ >>direct-array-constructor + drop ;FUNCTOR diff --git a/basis/specialized-arrays/functor/functor.factor b/basis/specialized-arrays/functor/functor.factor index a8d8d677ec..3341a909d2 100644 --- a/basis/specialized-arrays/functor/functor.factor +++ b/basis/specialized-arrays/functor/functor.factor @@ -34,8 +34,6 @@ TUPLE: A { length array-capacity read-only } { underlying byte-array read-only } ; -INSTANCE: A S - : ( n -- specialized-array ) dup T A boa ; inline : (A) ( n -- specialized-array ) dup T (c-array) A boa ; inline @@ -78,7 +76,14 @@ M: A pprint* pprint-object ; SYNTAX: A{ \ } [ >A ] parse-literal ; INSTANCE: A sequence +INSTANCE: A S A T c-type-boxed-class specialize-vector-words +T c-type + \ A >>array-class + \ >>array-constructor + \ S >>sequence-mixin-class + drop + ;FUNCTOR diff --git a/basis/specialized-vectors/functor/functor.factor b/basis/specialized-vectors/functor/functor.factor index 48c480b4d1..27bba3f9a6 100644 --- a/basis/specialized-vectors/functor/functor.factor +++ b/basis/specialized-vectors/functor/functor.factor @@ -20,8 +20,6 @@ WHERE V A vectors.functor:define-vector -INSTANCE: V S - M: V contract 2drop ; M: V byte-length underlying>> byte-length ; @@ -35,5 +33,6 @@ M: V pprint* pprint-object ; SYNTAX: V{ \ } [ >V ] parse-literal ; INSTANCE: V growable +INSTANCE: V S ;FUNCTOR From 59cdec755a298e454729fc28e653dc327b468c81 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 25 Aug 2009 18:24:49 -0500 Subject: [PATCH 04/23] throw a better error if is called when specialized array vocab isn't loaded. fix --- basis/alien/c-types/c-types.factor | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 65f663e7b6..675bc56503 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -95,6 +95,8 @@ M: string 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 ; + GENERIC: c-type-array-constructor ( c-type -- word ) foldable M: string c-type-array-constructor @@ -102,21 +104,26 @@ M: string c-type-array-constructor M: array c-type-array-constructor first c-type c-type-array-constructor ; M: c-type c-type-array-constructor - array-constructor>> ; + array-constructor>> dup word? + [ first2 specialized-array-vocab-not-loaded ] unless ; GENERIC: c-type-direct-array-constructor ( c-type -- word ) foldable M: string c-type-direct-array-constructor - c-type c-type-array-constructor ; + c-type c-type-direct-array-constructor ; M: array c-type-direct-array-constructor first c-type c-type-direct-array-constructor ; M: c-type c-type-direct-array-constructor - direct-array-constructor>> ; + direct-array-constructor>> dup word? + [ first2 specialized-array-vocab-not-loaded ] unless ; -: ( len c-type -- array ) +GENERIC: ( len c-type -- array ) +M: object c-type-array-constructor execute( len -- array ) ; inline -: ( len c-type -- array ) - c-type-direct-array-constructor execute( len -- array ) ; inline + +GENERIC: ( alien len c-type -- array ) +M: object + c-type-direct-array-constructor execute( alien len -- array ) ; inline GENERIC: c-type-class ( name -- class ) From 005107973f43952b5b52173c2621ad4121dac064 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 25 Aug 2009 18:51:56 -0500 Subject: [PATCH 05/23] docs for require-c-type-arrays, , --- basis/alien/arrays/arrays-docs.factor | 7 ++++++- basis/alien/c-types/c-types-docs.factor | 17 ++++++++++++++++- 2 files changed, 22 insertions(+), 2 deletions(-) diff --git a/basis/alien/arrays/arrays-docs.factor b/basis/alien/arrays/arrays-docs.factor index c5efe1e030..e8ebe1824d 100644 --- a/basis/alien/arrays/arrays-docs.factor +++ b/basis/alien/arrays/arrays-docs.factor @@ -4,4 +4,9 @@ USING: help.syntax help.markup byte-arrays alien.c-types ; 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" } "." $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 } +{ $subsection } ; diff --git a/basis/alien/c-types/c-types-docs.factor b/basis/alien/c-types/c-types-docs.factor index c9c1ecd0e5..f5f9e004c4 100644 --- a/basis/alien/c-types/c-types-docs.factor +++ b/basis/alien/c-types/c-types-docs.factor @@ -1,7 +1,7 @@ IN: alien.c-types USING: alien help.syntax help.markup libc kernel.private byte-arrays math strings hashtables alien.syntax alien.strings sequences -io.encodings.string debugger destructors ; +io.encodings.string debugger destructors vocabs.loader ; HELP: { $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 } " or " { $link } " 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: +{ $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: +{ $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" "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 From f4acf22433091f159483488204b7a231c682fa3a Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 25 Aug 2009 18:54:15 -0500 Subject: [PATCH 06/23] specialized-arrays.direct: define byte-length on direct arrays --- basis/specialized-arrays/direct/functor/functor.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/basis/specialized-arrays/direct/functor/functor.factor b/basis/specialized-arrays/direct/functor/functor.factor index 4b80940153..37978b6dfa 100755 --- a/basis/specialized-arrays/direct/functor/functor.factor +++ b/basis/specialized-arrays/direct/functor/functor.factor @@ -32,6 +32,8 @@ M: A set-nth-unsafe underlying>> SET-NTH call ; M: A like drop dup A instance? [ >A' ] unless ; M: A new-sequence drop ; +M: A byte-length length>> T heap-size * ; + M: A pprint-delims drop \ A'{ \ } ; M: A >pprint-sequence ; From d42edd4e3b016d2059d270152f041edfe10e66f2 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 25 Aug 2009 19:04:29 -0500 Subject: [PATCH 07/23] byte-length method for classes.struct STRUCTs --- extra/classes/struct/struct-tests.factor | 1 + extra/classes/struct/struct.factor | 10 +++++++++- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/extra/classes/struct/struct-tests.factor b/extra/classes/struct/struct-tests.factor index 5da1714803..272b8eb129 100644 --- a/extra/classes/struct/struct-tests.factor +++ b/extra/classes/struct/struct-tests.factor @@ -30,6 +30,7 @@ STRUCT: struct-test-bar { foo struct-test-foo } ; [ 12 ] [ struct-test-foo heap-size ] unit-test +[ 12 ] [ struct-test-foo byte-length ] unit-test [ 16 ] [ struct-test-bar heap-size ] unit-test [ 123 ] [ struct-test-foo y>> ] unit-test [ 123 ] [ struct-test-bar foo>> y>> ] unit-test diff --git a/extra/classes/struct/struct.factor b/extra/classes/struct/struct.factor index 51df296f1a..7d4eed80af 100644 --- a/extra/classes/struct/struct.factor +++ b/extra/classes/struct/struct.factor @@ -94,6 +94,10 @@ M: struct-class writer-quot [ \ struct-slot-values create-method-in ] [ 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 : slot>field ( slot -- field ) @@ -172,6 +176,10 @@ M: struct-class heap-size over [ swapd [ call( value struct -- ) ] curry keep ] [ 2drop ] if ] each ; +: (struct-methods) ( class -- ) + [ (define-struct-slot-values-method) ] + [ (define-byte-length-method) ] bi ; + : (struct-word-props) ( class slots size align -- ) [ [ "struct-slots" set-word-prop ] @@ -181,7 +189,7 @@ M: struct-class heap-size [ "struct-align" set-word-prop ] tri-curry* [ tri ] 3curry [ dup struct-prototype "prototype" set-word-prop ] - [ (define-struct-slot-values-method) ] tri ; + [ (struct-methods) ] tri ; : check-struct-slots ( slots -- ) [ c-type>> c-type drop ] each ; From 7b2c9df34128398610161d90efaeff4b4b49415d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 25 Aug 2009 19:33:35 -0500 Subject: [PATCH 08/23] cpu.ppc.assembler: fix FMR and FMR. opcodes --- .../cpu/ppc/assembler/assembler-tests.factor | 223 +++++++++--------- basis/cpu/ppc/assembler/assembler.factor | 4 +- 2 files changed, 115 insertions(+), 112 deletions(-) diff --git a/basis/cpu/ppc/assembler/assembler-tests.factor b/basis/cpu/ppc/assembler/assembler-tests.factor index 6ee1c84558..8e412c4c83 100644 --- a/basis/cpu/ppc/assembler/assembler-tests.factor +++ b/basis/cpu/ppc/assembler/assembler-tests.factor @@ -1,117 +1,120 @@ USING: cpu.ppc.assembler tools.test arrays kernel namespaces -make vocabs sequences ; +make vocabs sequences byte-arrays.hex ; FROM: cpu.ppc.assembler => B ; IN: cpu.ppc.assembler.tests : test-assembler ( expected quot -- ) [ 1array ] [ [ B{ } make ] curry ] bi* unit-test ; -B{ HEX: 38 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 ADDI ] test-assembler -B{ HEX: 3c HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 ADDIS ] test-assembler -B{ HEX: 30 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 ADDIC ] test-assembler -B{ HEX: 34 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 ADDIC. ] test-assembler -B{ HEX: 38 HEX: 40 HEX: 00 HEX: 01 } [ 1 2 LI ] test-assembler -B{ HEX: 3c HEX: 40 HEX: 00 HEX: 01 } [ 1 2 LIS ] test-assembler -B{ HEX: 38 HEX: 22 HEX: ff HEX: fd } [ 1 2 3 SUBI ] test-assembler -B{ HEX: 1c HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 MULI ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 1a HEX: 14 } [ 1 2 3 ADD ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 1a HEX: 15 } [ 1 2 3 ADD. ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 1e HEX: 14 } [ 1 2 3 ADDO ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 1e HEX: 15 } [ 1 2 3 ADDO. ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 18 HEX: 14 } [ 1 2 3 ADDC ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 18 HEX: 15 } [ 1 2 3 ADDC. ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 1e HEX: 14 } [ 1 2 3 ADDO ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 1c HEX: 15 } [ 1 2 3 ADDCO. ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 19 HEX: 14 } [ 1 2 3 ADDE ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 18 HEX: 38 } [ 1 2 3 AND ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 18 HEX: 39 } [ 1 2 3 AND. ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 1b HEX: d6 } [ 1 2 3 DIVW ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 1b HEX: 96 } [ 1 2 3 DIVWU ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 1a HEX: 38 } [ 1 2 3 EQV ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 1b HEX: b8 } [ 1 2 3 NAND ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 18 HEX: f8 } [ 1 2 3 NOR ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 10 HEX: f8 } [ 1 2 NOT ] test-assembler -B{ HEX: 60 HEX: 41 HEX: 00 HEX: 03 } [ 1 2 3 ORI ] test-assembler -B{ HEX: 64 HEX: 41 HEX: 00 HEX: 03 } [ 1 2 3 ORIS ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 1b HEX: 78 } [ 1 2 3 OR ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 13 HEX: 78 } [ 1 2 MR ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 18 HEX: 96 } [ 1 2 3 MULHW ] test-assembler -B{ HEX: 1c HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 MULLI ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 18 HEX: 16 } [ 1 2 3 MULHWU ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 19 HEX: d6 } [ 1 2 3 MULLW ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 18 HEX: 30 } [ 1 2 3 SLW ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 1e HEX: 30 } [ 1 2 3 SRAW ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 1c HEX: 30 } [ 1 2 3 SRW ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 1e HEX: 70 } [ 1 2 3 SRAWI ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 18 HEX: 50 } [ 1 2 3 SUBF ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 18 HEX: 10 } [ 1 2 3 SUBFC ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 19 HEX: 10 } [ 1 2 3 SUBFE ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 07 HEX: 74 } [ 1 2 EXTSB ] test-assembler -B{ HEX: 68 HEX: 41 HEX: 00 HEX: 03 } [ 1 2 3 XORI ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 1a HEX: 78 } [ 1 2 3 XOR ] test-assembler -B{ HEX: 7c HEX: 22 HEX: 00 HEX: d0 } [ 1 2 NEG ] test-assembler -B{ HEX: 2c HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 CMPI ] test-assembler -B{ HEX: 28 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 CMPLI ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 18 HEX: 00 } [ 1 2 3 CMP ] test-assembler -B{ HEX: 54 HEX: 22 HEX: 19 HEX: 0a } [ 1 2 3 4 5 RLWINM ] test-assembler -B{ HEX: 54 HEX: 22 HEX: 18 HEX: 38 } [ 1 2 3 SLWI ] test-assembler -B{ HEX: 54 HEX: 22 HEX: e8 HEX: fe } [ 1 2 3 SRWI ] test-assembler -B{ HEX: 88 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LBZ ] test-assembler -B{ HEX: 8c HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LBZU ] test-assembler -B{ HEX: a8 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LHA ] test-assembler -B{ HEX: ac HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LHAU ] test-assembler -B{ HEX: a0 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LHZ ] test-assembler -B{ HEX: a4 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LHZU ] test-assembler -B{ HEX: 80 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LWZ ] test-assembler -B{ HEX: 84 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LWZU ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 18 HEX: ae } [ 1 2 3 LBZX ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 18 HEX: ee } [ 1 2 3 LBZUX ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 1a HEX: ae } [ 1 2 3 LHAX ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 1a HEX: ee } [ 1 2 3 LHAUX ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 1a HEX: 2e } [ 1 2 3 LHZX ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 1a HEX: 6e } [ 1 2 3 LHZUX ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 18 HEX: 2e } [ 1 2 3 LWZX ] test-assembler -B{ HEX: 7c HEX: 41 HEX: 18 HEX: 6e } [ 1 2 3 LWZUX ] test-assembler -B{ HEX: 48 HEX: 00 HEX: 00 HEX: 01 } [ 1 B ] test-assembler -B{ HEX: 48 HEX: 00 HEX: 00 HEX: 01 } [ 1 BL ] test-assembler -B{ HEX: 41 HEX: 80 HEX: 00 HEX: 04 } [ 1 BLT ] test-assembler -B{ HEX: 41 HEX: 81 HEX: 00 HEX: 04 } [ 1 BGT ] test-assembler -B{ HEX: 40 HEX: 81 HEX: 00 HEX: 04 } [ 1 BLE ] test-assembler -B{ HEX: 40 HEX: 80 HEX: 00 HEX: 04 } [ 1 BGE ] test-assembler -B{ HEX: 41 HEX: 80 HEX: 00 HEX: 04 } [ 1 BLT ] test-assembler -B{ HEX: 40 HEX: 82 HEX: 00 HEX: 04 } [ 1 BNE ] test-assembler -B{ HEX: 41 HEX: 82 HEX: 00 HEX: 04 } [ 1 BEQ ] test-assembler -B{ HEX: 41 HEX: 83 HEX: 00 HEX: 04 } [ 1 BO ] test-assembler -B{ HEX: 40 HEX: 83 HEX: 00 HEX: 04 } [ 1 BNO ] test-assembler -B{ HEX: 4c HEX: 20 HEX: 00 HEX: 20 } [ 1 BCLR ] test-assembler -B{ HEX: 4e HEX: 80 HEX: 00 HEX: 20 } [ BLR ] test-assembler -B{ HEX: 4e HEX: 80 HEX: 00 HEX: 21 } [ BLRL ] test-assembler -B{ HEX: 4c HEX: 20 HEX: 04 HEX: 20 } [ 1 BCCTR ] test-assembler -B{ HEX: 4e HEX: 80 HEX: 04 HEX: 20 } [ BCTR ] test-assembler -B{ HEX: 7c HEX: 61 HEX: 02 HEX: a6 } [ 3 MFXER ] test-assembler -B{ HEX: 7c HEX: 68 HEX: 02 HEX: a6 } [ 3 MFLR ] test-assembler -B{ HEX: 7c HEX: 69 HEX: 02 HEX: a6 } [ 3 MFCTR ] test-assembler -B{ HEX: 7c HEX: 61 HEX: 03 HEX: a6 } [ 3 MTXER ] test-assembler -B{ HEX: 7c HEX: 68 HEX: 03 HEX: a6 } [ 3 MTLR ] test-assembler -B{ HEX: 7c HEX: 69 HEX: 03 HEX: a6 } [ 3 MTCTR ] test-assembler -B{ HEX: 7c HEX: 61 HEX: 02 HEX: a6 } [ 3 MFXER ] test-assembler -B{ HEX: 7c HEX: 68 HEX: 02 HEX: a6 } [ 3 MFLR ] test-assembler -B{ HEX: c0 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LFS ] test-assembler -B{ HEX: c4 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LFSU ] test-assembler -B{ HEX: c8 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LFD ] test-assembler -B{ HEX: cc HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LFDU ] test-assembler -B{ HEX: d0 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 STFS ] test-assembler -B{ HEX: d4 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 STFSU ] test-assembler -B{ HEX: d8 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 STFD ] test-assembler -B{ HEX: dc HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 STFDU ] test-assembler -B{ HEX: fc HEX: 20 HEX: 10 HEX: 48 } [ 1 2 FMR ] test-assembler -B{ HEX: fc HEX: 20 HEX: 10 HEX: 1e } [ 1 2 FCTIWZ ] test-assembler -B{ HEX: fc HEX: 22 HEX: 18 HEX: 2a } [ 1 2 3 FADD ] test-assembler -B{ HEX: fc HEX: 22 HEX: 18 HEX: 2b } [ 1 2 3 FADD. ] test-assembler -B{ HEX: fc HEX: 22 HEX: 18 HEX: 28 } [ 1 2 3 FSUB ] test-assembler -B{ HEX: fc HEX: 22 HEX: 00 HEX: f2 } [ 1 2 3 FMUL ] test-assembler -B{ HEX: fc HEX: 22 HEX: 18 HEX: 24 } [ 1 2 3 FDIV ] test-assembler -B{ HEX: fc HEX: 20 HEX: 10 HEX: 2c } [ 1 2 FSQRT ] test-assembler -B{ HEX: fc HEX: 41 HEX: 18 HEX: 00 } [ 1 2 3 FCMPU ] test-assembler -B{ HEX: fc HEX: 41 HEX: 18 HEX: 40 } [ 1 2 3 FCMPO ] 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{ 38 22 00 03 } [ 1 2 3 ADDI ] test-assembler +HEX{ 3c 22 00 03 } [ 1 2 3 ADDIS ] test-assembler +HEX{ 30 22 00 03 } [ 1 2 3 ADDIC ] test-assembler +HEX{ 34 22 00 03 } [ 1 2 3 ADDIC. ] test-assembler +HEX{ 38 40 00 01 } [ 1 2 LI ] test-assembler +HEX{ 3c 40 00 01 } [ 1 2 LIS ] test-assembler +HEX{ 38 22 ff fd } [ 1 2 3 SUBI ] test-assembler +HEX{ 1c 22 00 03 } [ 1 2 3 MULI ] test-assembler +HEX{ 7c 22 1a 14 } [ 1 2 3 ADD ] test-assembler +HEX{ 7c 22 1a 15 } [ 1 2 3 ADD. ] test-assembler +HEX{ 7c 22 1e 14 } [ 1 2 3 ADDO ] test-assembler +HEX{ 7c 22 1e 15 } [ 1 2 3 ADDO. ] test-assembler +HEX{ 7c 22 18 14 } [ 1 2 3 ADDC ] test-assembler +HEX{ 7c 22 18 15 } [ 1 2 3 ADDC. ] test-assembler +HEX{ 7c 22 1e 14 } [ 1 2 3 ADDO ] test-assembler +HEX{ 7c 22 1c 15 } [ 1 2 3 ADDCO. ] test-assembler +HEX{ 7c 22 19 14 } [ 1 2 3 ADDE ] test-assembler +HEX{ 7c 41 18 38 } [ 1 2 3 AND ] test-assembler +HEX{ 7c 41 18 39 } [ 1 2 3 AND. ] test-assembler +HEX{ 7c 22 1b d6 } [ 1 2 3 DIVW ] test-assembler +HEX{ 7c 22 1b 96 } [ 1 2 3 DIVWU ] test-assembler +HEX{ 7c 41 1a 38 } [ 1 2 3 EQV ] test-assembler +HEX{ 7c 41 1b b8 } [ 1 2 3 NAND ] test-assembler +HEX{ 7c 41 18 f8 } [ 1 2 3 NOR ] test-assembler +HEX{ 7c 41 10 f8 } [ 1 2 NOT ] test-assembler +HEX{ 60 41 00 03 } [ 1 2 3 ORI ] test-assembler +HEX{ 64 41 00 03 } [ 1 2 3 ORIS ] test-assembler +HEX{ 7c 41 1b 78 } [ 1 2 3 OR ] test-assembler +HEX{ 7c 41 13 78 } [ 1 2 MR ] test-assembler +HEX{ 7c 22 18 96 } [ 1 2 3 MULHW ] test-assembler +HEX{ 1c 22 00 03 } [ 1 2 3 MULLI ] test-assembler +HEX{ 7c 22 18 16 } [ 1 2 3 MULHWU ] test-assembler +HEX{ 7c 22 19 d6 } [ 1 2 3 MULLW ] test-assembler +HEX{ 7c 41 18 30 } [ 1 2 3 SLW ] test-assembler +HEX{ 7c 41 1e 30 } [ 1 2 3 SRAW ] test-assembler +HEX{ 7c 41 1c 30 } [ 1 2 3 SRW ] test-assembler +HEX{ 7c 41 1e 70 } [ 1 2 3 SRAWI ] test-assembler +HEX{ 7c 22 18 50 } [ 1 2 3 SUBF ] test-assembler +HEX{ 7c 22 18 10 } [ 1 2 3 SUBFC ] test-assembler +HEX{ 7c 22 19 10 } [ 1 2 3 SUBFE ] test-assembler +HEX{ 7c 41 07 74 } [ 1 2 EXTSB ] test-assembler +HEX{ 68 41 00 03 } [ 1 2 3 XORI ] test-assembler +HEX{ 7c 41 1a 78 } [ 1 2 3 XOR ] test-assembler +HEX{ 7c 22 00 d0 } [ 1 2 NEG ] test-assembler +HEX{ 2c 22 00 03 } [ 1 2 3 CMPI ] test-assembler +HEX{ 28 22 00 03 } [ 1 2 3 CMPLI ] test-assembler +HEX{ 7c 41 18 00 } [ 1 2 3 CMP ] test-assembler +HEX{ 54 22 19 0a } [ 1 2 3 4 5 RLWINM ] test-assembler +HEX{ 54 22 18 38 } [ 1 2 3 SLWI ] test-assembler +HEX{ 54 22 e8 fe } [ 1 2 3 SRWI ] test-assembler +HEX{ 88 22 00 03 } [ 1 2 3 LBZ ] test-assembler +HEX{ 8c 22 00 03 } [ 1 2 3 LBZU ] test-assembler +HEX{ a8 22 00 03 } [ 1 2 3 LHA ] test-assembler +HEX{ ac 22 00 03 } [ 1 2 3 LHAU ] test-assembler +HEX{ a0 22 00 03 } [ 1 2 3 LHZ ] test-assembler +HEX{ a4 22 00 03 } [ 1 2 3 LHZU ] test-assembler +HEX{ 80 22 00 03 } [ 1 2 3 LWZ ] test-assembler +HEX{ 84 22 00 03 } [ 1 2 3 LWZU ] test-assembler +HEX{ 7c 41 18 ae } [ 1 2 3 LBZX ] test-assembler +HEX{ 7c 41 18 ee } [ 1 2 3 LBZUX ] test-assembler +HEX{ 7c 41 1a ae } [ 1 2 3 LHAX ] test-assembler +HEX{ 7c 41 1a ee } [ 1 2 3 LHAUX ] test-assembler +HEX{ 7c 41 1a 2e } [ 1 2 3 LHZX ] test-assembler +HEX{ 7c 41 1a 6e } [ 1 2 3 LHZUX ] test-assembler +HEX{ 7c 41 18 2e } [ 1 2 3 LWZX ] test-assembler +HEX{ 7c 41 18 6e } [ 1 2 3 LWZUX ] test-assembler +HEX{ 48 00 00 01 } [ 1 B ] test-assembler +HEX{ 48 00 00 01 } [ 1 BL ] test-assembler +HEX{ 41 80 00 04 } [ 1 BLT ] test-assembler +HEX{ 41 81 00 04 } [ 1 BGT ] test-assembler +HEX{ 40 81 00 04 } [ 1 BLE ] test-assembler +HEX{ 40 80 00 04 } [ 1 BGE ] test-assembler +HEX{ 41 80 00 04 } [ 1 BLT ] test-assembler +HEX{ 40 82 00 04 } [ 1 BNE ] test-assembler +HEX{ 41 82 00 04 } [ 1 BEQ ] test-assembler +HEX{ 41 83 00 04 } [ 1 BO ] test-assembler +HEX{ 40 83 00 04 } [ 1 BNO ] test-assembler +HEX{ 4c 20 00 20 } [ 1 BCLR ] test-assembler +HEX{ 4e 80 00 20 } [ BLR ] test-assembler +HEX{ 4e 80 00 21 } [ BLRL ] test-assembler +HEX{ 4c 20 04 20 } [ 1 BCCTR ] test-assembler +HEX{ 4e 80 04 20 } [ BCTR ] test-assembler +HEX{ 7c 61 02 a6 } [ 3 MFXER ] test-assembler +HEX{ 7c 68 02 a6 } [ 3 MFLR ] test-assembler +HEX{ 7c 69 02 a6 } [ 3 MFCTR ] test-assembler +HEX{ 7c 61 03 a6 } [ 3 MTXER ] test-assembler +HEX{ 7c 68 03 a6 } [ 3 MTLR ] test-assembler +HEX{ 7c 69 03 a6 } [ 3 MTCTR ] test-assembler +HEX{ 7c 61 02 a6 } [ 3 MFXER ] test-assembler +HEX{ 7c 68 02 a6 } [ 3 MFLR ] test-assembler +HEX{ c0 22 00 03 } [ 1 2 3 LFS ] test-assembler +HEX{ c4 22 00 03 } [ 1 2 3 LFSU ] test-assembler +HEX{ c8 22 00 03 } [ 1 2 3 LFD ] test-assembler +HEX{ cc 22 00 03 } [ 1 2 3 LFDU ] test-assembler +HEX{ d0 22 00 03 } [ 1 2 3 STFS ] test-assembler +HEX{ d4 22 00 03 } [ 1 2 3 STFSU ] test-assembler +HEX{ d8 22 00 03 } [ 1 2 3 STFD ] test-assembler +HEX{ dc 22 00 03 } [ 1 2 3 STFDU ] test-assembler +HEX{ fc 20 10 90 } [ 1 2 FMR ] test-assembler +HEX{ fc 40 08 90 } [ 2 1 FMR ] test-assembler +HEX{ fc 20 10 91 } [ 1 2 FMR. ] test-assembler +HEX{ fc 40 08 91 } [ 2 1 FMR. ] test-assembler +HEX{ fc 20 10 1e } [ 1 2 FCTIWZ ] test-assembler +HEX{ fc 22 18 2a } [ 1 2 3 FADD ] test-assembler +HEX{ fc 22 18 2b } [ 1 2 3 FADD. ] test-assembler +HEX{ fc 22 18 28 } [ 1 2 3 FSUB ] test-assembler +HEX{ fc 22 00 f2 } [ 1 2 3 FMUL ] test-assembler +HEX{ fc 22 18 24 } [ 1 2 3 FDIV ] test-assembler +HEX{ fc 20 10 2c } [ 1 2 FSQRT ] test-assembler +HEX{ fc 41 18 00 } [ 1 2 3 FCMPU ] test-assembler +HEX{ fc 41 18 40 } [ 1 2 3 FCMPO ] test-assembler +HEX{ 3c 60 12 34 60 63 56 78 } [ HEX: 12345678 3 LOAD ] test-assembler diff --git a/basis/cpu/ppc/assembler/assembler.factor b/basis/cpu/ppc/assembler/assembler.factor index 2daf3678ce..2362bdc73c 100644 --- a/basis/cpu/ppc/assembler/assembler.factor +++ b/basis/cpu/ppc/assembler/assembler.factor @@ -97,8 +97,8 @@ X: XOR 0 316 31 X: XOR. 1 316 31 X1: EXTSB 0 954 31 X1: EXTSB. 1 954 31 -: FMR ( a s -- ) [ 0 ] 2dip 72 0 63 x-insn ; -: FMR. ( a s -- ) [ 0 ] 2dip 72 1 63 x-insn ; +: FMR ( a s -- ) [ 0 ] 2dip 0 72 63 x-insn ; +: FMR. ( a s -- ) [ 0 ] 2dip 1 72 63 x-insn ; : FCTIWZ ( a s -- ) [ 0 ] 2dip 0 15 63 x-insn ; : FCTIWZ. ( a s -- ) [ 0 ] 2dip 1 15 63 x-insn ; From b71e14d89f9e4dc2fd5decde908910fab4c2b864 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 25 Aug 2009 19:33:48 -0500 Subject: [PATCH 09/23] benchmark.raytracer: eliminate -rot usage --- extra/benchmark/raytracer/raytracer.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/benchmark/raytracer/raytracer.factor b/extra/benchmark/raytracer/raytracer.factor index 25915404be..de9b80b4ca 100755 --- a/extra/benchmark/raytracer/raytracer.factor +++ b/extra/benchmark/raytracer/raytracer.factor @@ -155,7 +155,7 @@ DEFER: create ( level c r -- scene ) ] with map ; : 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 ; : pixel-grid ( -- grid ) From 1afd001393724e2c651fda73bdccc4569b07990c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 25 Aug 2009 19:38:48 -0500 Subject: [PATCH 10/23] basis/cpu: eliminate some usages of rot --- basis/cpu/ppc/assembler/assembler.factor | 12 +++++++----- basis/cpu/ppc/ppc.factor | 2 +- basis/cpu/x86/32/32.factor | 6 +++--- basis/cpu/x86/64/64.factor | 11 +++++------ 4 files changed, 16 insertions(+), 15 deletions(-) diff --git a/basis/cpu/ppc/assembler/assembler.factor b/basis/cpu/ppc/assembler/assembler.factor index 2362bdc73c..f59f8779ef 100644 --- a/basis/cpu/ppc/assembler/assembler.factor +++ b/basis/cpu/ppc/assembler/assembler.factor @@ -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. -USING: kernel namespaces words io.binary math math.order +USING: kernel namespaces words math math.order locals cpu.ppc.assembler.backend ; IN: cpu.ppc.assembler @@ -189,9 +189,9 @@ MTSPR: LR 8 MTSPR: CTR 9 ! Pseudo-instructions -: LI ( value dst -- ) 0 rot ADDI ; inline +: LI ( value dst -- ) swap [ 0 ] dip 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 : 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 -- ) (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: 7fff bitand r LIS + r r n HEX: 7fff bitand ORI ; : immediate? ( n -- ? ) HEX: -8000 HEX: 7fff between? ; : LOAD ( n r -- ) over immediate? [ LI ] [ LOAD32 ] if ; diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index d6674e7097..aec7e85b56 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -62,7 +62,7 @@ M: rs-loc loc-reg drop rs-reg ; M: ppc %peek loc>operand LWZ ; 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-r ( n -- ) rs-reg (%inc) ; diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index bd03b47302..74312c3718 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -208,13 +208,13 @@ M: x86 %unbox-small-struct ( size -- ) { 2 [ %unbox-struct-2 ] } } case ; -M: x86.32 %unbox-large-struct ( n c-type -- ) +M:: x86.32 %unbox-large-struct ( n c-type -- ) ! Alien must be in EAX. ! Compute destination address - ECX rot stack@ LEA + ECX n stack@ LEA 12 [ ! Push struct size - heap-size PUSH + c-type heap-size PUSH ! Push destination address ECX PUSH ! Push source address diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 7c832fe66c..145d4ff677 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -102,13 +102,12 @@ M: x86.64 %unbox-small-struct ( c-type -- ) flatten-value-type [ %unbox-struct-field ] each-index ] 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 - heap-size - ! Load destination address - param-reg-2 rot param@ LEA - ! Load structure size - param-reg-3 swap MOV + ! Load destination address into param-reg-2 + param-reg-2 n param@ LEA + ! Load structure size into param-reg-3 + param-reg-3 c-type heap-size MOV ! Copy the struct to the C stack "to_value_struct" f %alien-invoke ; From 61c1ed17d982084b144e958524d310e4cdfad5fb Mon Sep 17 00:00:00 2001 From: sheeple Date: Tue, 25 Aug 2009 19:41:17 -0500 Subject: [PATCH 11/23] basis/compiler/tests/low-level-ir: add ##copy double-float-rep test --- basis/compiler/tests/low-level-ir.factor | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/basis/compiler/tests/low-level-ir.factor b/basis/compiler/tests/low-level-ir.factor index ececac3037..e3e2c3344e 100644 --- a/basis/compiler/tests/low-level-ir.factor +++ b/basis/compiler/tests/low-level-ir.factor @@ -46,6 +46,17 @@ IN: compiler.tests.low-level-ir } compile-test-bb ] unit-test +! ##copy on floats +[ 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 + ! make sure slot access works when the destination is ! one of the sources [ t ] [ @@ -138,4 +149,4 @@ USE: multiline } compile-test-bb ] unit-test -*/ \ No newline at end of file +*/ From 8aa9327dccf2686c0e216751102693b85597e3b3 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 25 Aug 2009 19:58:04 -0500 Subject: [PATCH 12/23] support on complex ffi types --- basis/alien/c-types/c-types.factor | 9 ++++++--- basis/alien/complex/functor/functor.factor | 22 ++++++++++++++++------ basis/alien/structs/structs.factor | 9 ++++----- extra/classes/struct/struct.factor | 2 +- 4 files changed, 27 insertions(+), 15 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 675bc56503..779a5e18de 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -79,12 +79,15 @@ M: string c-type ( name -- type ) : ?require-word ( word/pair -- ) dup word? [ drop ] [ first require ] ?if ; +MIXIN: array-c-type +INSTANCE: c-type array-c-type + GENERIC: require-c-type-arrays ( c-type -- ) M: object require-c-type-arrays drop ; -M: c-type require-c-type-arrays +M: array-c-type require-c-type-arrays [ array-class>> ?require-word ] [ sequence-mixin-class>> ?require-word ] [ direct-array-class>> ?require-word ] tri ; @@ -103,7 +106,7 @@ M: string c-type-array-constructor c-type c-type-array-constructor ; M: array c-type-array-constructor first c-type c-type-array-constructor ; -M: c-type c-type-array-constructor +M: array-c-type c-type-array-constructor array-constructor>> dup word? [ first2 specialized-array-vocab-not-loaded ] unless ; @@ -113,7 +116,7 @@ M: string c-type-direct-array-constructor c-type c-type-direct-array-constructor ; M: array c-type-direct-array-constructor first c-type c-type-direct-array-constructor ; -M: c-type c-type-direct-array-constructor +M: array-c-type c-type-direct-array-constructor direct-array-constructor>> dup word? [ first2 specialized-array-vocab-not-loaded ] unless ; diff --git a/basis/alien/complex/functor/functor.factor b/basis/alien/complex/functor/functor.factor index 98d412639f..a5580318a9 100644 --- a/basis/alien/complex/functor/functor.factor +++ b/basis/alien/complex/functor/functor.factor @@ -1,10 +1,18 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.structs alien.c-types math math.functions sequences -arrays kernel functors vocabs.parser namespaces accessors -quotations ; +USING: alien.structs alien.structs.fields alien.c-types +math math.functions sequences arrays kernel functors +vocabs.parser namespaces accessors quotations ; IN: alien.complex.functor +TUPLE: complex-c-type < struct-type + array-class + array-constructor + direct-array-class + direct-array-constructor + sequence-mixin-class ; +INSTANCE: complex-c-type array-c-type + FUNCTOR: define-complex-type ( N T -- ) T-real DEFINES ${T}-real @@ -23,14 +31,16 @@ WHERE : *T ( alien -- z ) [ T-real ] [ T-imaginary ] bi rect> ; inline -T current-vocab -{ { N "real" } { N "imaginary" } } -define-struct +T N c-type-align [ 2 * ] [ ] bi +T current-vocab N "real" +T current-vocab N "imaginary" N c-type-align >>offset +2array complex-c-type (define-struct) T c-type 1quotation >>unboxer-quot *T 1quotation >>boxer-quot number >>boxed-class +T set-array-class drop ;FUNCTOR diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor index 5c1fb4063b..3d9cae1202 100755 --- a/basis/alien/structs/structs.factor +++ b/basis/alien/structs/structs.factor @@ -35,9 +35,8 @@ M: struct-type stack-size : c-struct? ( type -- ? ) (c-type) struct-type? ; -: (define-struct) ( name size align fields -- ) - [ [ align ] keep ] dip - struct-type new +: (define-struct) ( name size align fields class -- ) + [ [ align ] keep ] 2dip new byte-array >>class byte-array >>boxed-class swap >>fields @@ -55,13 +54,13 @@ M: struct-type stack-size [ 2drop ] [ make-fields ] 3bi [ struct-offsets ] keep [ [ type>> ] map compute-struct-align ] keep - [ (define-struct) ] keep + [ struct-type (define-struct) ] keep [ define-field ] each ; : define-union ( name members -- ) [ expand-constants ] map [ [ 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 ) c-types get at fields>> diff --git a/extra/classes/struct/struct.factor b/extra/classes/struct/struct.factor index 7d4eed80af..e9de2f7e36 100644 --- a/extra/classes/struct/struct.factor +++ b/extra/classes/struct/struct.factor @@ -117,7 +117,7 @@ M: struct-class writer-quot [ "struct-align" word-prop ] [ struct-slots [ slot>field ] map ] } cleave - (define-struct) + struct-type (define-struct) ] [ { [ name>> c-type ] From a2518377e342a62933366a457f907bb938d6720b Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 25 Aug 2009 20:43:48 -0500 Subject: [PATCH 13/23] support of structs using struct-arrays --- basis/alien/c-types/c-types.factor | 47 +++++++++------------- basis/alien/complex/functor/functor.factor | 21 +++------- basis/alien/structs/structs.factor | 12 +++++- 3 files changed, 37 insertions(+), 43 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 779a5e18de..4fc8dab9fe 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -21,19 +21,19 @@ TUPLE: abstract-c-type { getter callable } { setter callable } size -align ; - -TUPLE: c-type < abstract-c-type -boxer -unboxer -{ rep initial: int-rep } -stack-align? +align array-class array-constructor direct-array-class direct-array-constructor sequence-mixin-class ; +TUPLE: c-type < abstract-c-type +boxer +unboxer +{ rep initial: int-rep } +stack-align? ; + : ( -- type ) \ c-type new ; @@ -79,15 +79,12 @@ M: string c-type ( name -- type ) : ?require-word ( word/pair -- ) dup word? [ drop ] [ first require ] ?if ; -MIXIN: array-c-type -INSTANCE: c-type array-c-type - GENERIC: require-c-type-arrays ( c-type -- ) M: object require-c-type-arrays drop ; -M: array-c-type require-c-type-arrays +M: c-type require-c-type-arrays [ array-class>> ?require-word ] [ sequence-mixin-class>> ?require-word ] [ direct-array-class>> ?require-word ] tri ; @@ -100,33 +97,29 @@ M: array require-c-type-arrays ERROR: specialized-array-vocab-not-loaded vocab word ; -GENERIC: c-type-array-constructor ( c-type -- word ) foldable - -M: string c-type-array-constructor - c-type c-type-array-constructor ; -M: array c-type-array-constructor - first c-type c-type-array-constructor ; -M: array-c-type c-type-array-constructor +: c-type-array-constructor ( c-type -- word ) array-constructor>> dup word? - [ first2 specialized-array-vocab-not-loaded ] unless ; + [ first2 specialized-array-vocab-not-loaded ] unless ; foldable -GENERIC: c-type-direct-array-constructor ( c-type -- word ) foldable - -M: string c-type-direct-array-constructor - c-type c-type-direct-array-constructor ; -M: array c-type-direct-array-constructor - first c-type c-type-direct-array-constructor ; -M: array-c-type c-type-direct-array-constructor +: c-type-direct-array-constructor ( c-type -- word ) direct-array-constructor>> dup word? - [ first2 specialized-array-vocab-not-loaded ] unless ; + [ first2 specialized-array-vocab-not-loaded ] unless ; foldable GENERIC: ( len c-type -- array ) M: object c-type-array-constructor execute( len -- array ) ; inline +M: string + c-type ; inline +M: array + first c-type ; inline GENERIC: ( alien len c-type -- array ) M: object c-type-direct-array-constructor execute( alien len -- array ) ; inline +M: string + c-type ; inline +M: array + first c-type ; inline GENERIC: c-type-class ( name -- class ) diff --git a/basis/alien/complex/functor/functor.factor b/basis/alien/complex/functor/functor.factor index a5580318a9..7727546c00 100644 --- a/basis/alien/complex/functor/functor.factor +++ b/basis/alien/complex/functor/functor.factor @@ -1,18 +1,10 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.structs alien.structs.fields alien.c-types -math math.functions sequences arrays kernel functors -vocabs.parser namespaces accessors quotations ; +USING: alien.structs alien.c-types math math.functions sequences +arrays kernel functors vocabs.parser namespaces accessors +quotations ; IN: alien.complex.functor -TUPLE: complex-c-type < struct-type - array-class - array-constructor - direct-array-class - direct-array-constructor - sequence-mixin-class ; -INSTANCE: complex-c-type array-c-type - FUNCTOR: define-complex-type ( N T -- ) T-real DEFINES ${T}-real @@ -31,10 +23,9 @@ WHERE : *T ( alien -- z ) [ T-real ] [ T-imaginary ] bi rect> ; inline -T N c-type-align [ 2 * ] [ ] bi -T current-vocab N "real" -T current-vocab N "imaginary" N c-type-align >>offset -2array complex-c-type (define-struct) +T current-vocab +{ { N "real" } { N "imaginary" } } +define-struct T c-type 1quotation >>unboxer-quot diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor index 3d9cae1202..d8b2edf394 100755 --- a/basis/alien/structs/structs.factor +++ b/basis/alien/structs/structs.factor @@ -3,7 +3,7 @@ USING: accessors arrays assocs generic hashtables kernel kernel.private math namespaces parser sequences strings words libc fry alien.c-types alien.structs.fields cpu.architecture math.order -quotations byte-arrays ; +quotations byte-arrays struct-arrays ; IN: alien.structs 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 ( len c-type -- array ) + dup c-type-array-constructor + [ execute( len -- array ) ] + [ ] ?if ; inline + +M: struct-type ( alien len c-type -- array ) + dup c-type-direct-array-constructor + [ execute( alien len -- array ) ] + [ ] ?if ; inline + : if-value-struct ( ctype true false -- ) [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline From 87c670b785604ecff2cd2493ff9fd328f8cac209 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 25 Aug 2009 20:57:23 -0500 Subject: [PATCH 14/23] no really, support of structs using struct-arrays --- basis/alien/c-types/c-types.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 4fc8dab9fe..9f7ac75558 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -98,12 +98,12 @@ M: array require-c-type-arrays ERROR: specialized-array-vocab-not-loaded vocab word ; : c-type-array-constructor ( c-type -- word ) - array-constructor>> dup word? - [ first2 specialized-array-vocab-not-loaded ] unless ; foldable + array-constructor>> dup array? + [ first2 specialized-array-vocab-not-loaded ] when ; foldable : c-type-direct-array-constructor ( c-type -- word ) - direct-array-constructor>> dup word? - [ first2 specialized-array-vocab-not-loaded ] unless ; foldable + direct-array-constructor>> dup array? + [ first2 specialized-array-vocab-not-loaded ] when ; foldable GENERIC: ( len c-type -- array ) M: object From b6bba164e4724233a49eedb2a3b5a26f93e50bf9 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 25 Aug 2009 21:36:25 -0500 Subject: [PATCH 15/23] box array c-types into direct-arrays --- basis/alien/arrays/arrays.factor | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor index d793814c28..fbf59e6f11 100755 --- a/basis/alien/arrays/arrays.factor +++ b/basis/alien/arrays/arrays.factor @@ -29,7 +29,11 @@ M: array box-return drop "void*" box-return ; 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* + [ ] 2curry ; M: array c-type-unboxer-quot drop [ >c-ptr ] ; From e919e71163988dc54ec986b98407143b6616a0de Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 25 Aug 2009 21:54:19 -0500 Subject: [PATCH 16/23] test array slots in STRUCTs --- extra/classes/struct/struct-tests.factor | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/extra/classes/struct/struct-tests.factor b/extra/classes/struct/struct-tests.factor index 272b8eb129..6c7a4cf35d 100644 --- a/extra/classes/struct/struct-tests.factor +++ b/extra/classes/struct/struct-tests.factor @@ -1,9 +1,10 @@ ! (c)Joe Groff bsd license 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.encodings.utf8 io.pathnames io.streams.string kernel libc literals math multiline namespaces prettyprint -prettyprint.config see system tools.test ; +prettyprint.config see sequences specialized-arrays.ushort +system tools.test ; IN: classes.struct.tests << @@ -145,3 +146,16 @@ LIBRARY: f-cdecl FUNCTION: int ffi_test_11 ( int a, struct-test-ffi-foo b, int c ) ; [ 14 ] [ 1 2 3 struct-test-ffi-foo 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 y>> 4 swap nth ] unit-test + +[ t ] [ + struct-test-array-slots + [ y>> [ 8 3 ] dip set-nth ] + [ y>> ushort-array{ 2 3 5 8 11 13 } sequence= ] bi +] unit-test From b7e29ca8dddb0216050f0cf922f205e2e900e6e2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 25 Aug 2009 22:37:10 -0500 Subject: [PATCH 17/23] cpu.ppc.assembler: LOAD32 assembler macro was busted --- basis/cpu/ppc/assembler/assembler.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/cpu/ppc/assembler/assembler.factor b/basis/cpu/ppc/assembler/assembler.factor index f59f8779ef..dd633f4e9a 100644 --- a/basis/cpu/ppc/assembler/assembler.factor +++ b/basis/cpu/ppc/assembler/assembler.factor @@ -205,7 +205,7 @@ MTSPR: CTR 9 : SRWI ( d a b -- ) (SRWI) RLWINM ; : SRWI. ( d a b -- ) (SRWI) RLWINM. ; :: LOAD32 ( n r -- ) - n -16 shift HEX: 7fff bitand r LIS - r r n HEX: 7fff bitand ORI ; + n -16 shift HEX: ffff bitand r LIS + r r n HEX: ffff bitand ORI ; : immediate? ( n -- ? ) HEX: -8000 HEX: 7fff between? ; : LOAD ( n r -- ) over immediate? [ LI ] [ LOAD32 ] if ; From 0df8aadce2c595ab0c3c9efb5215c42628bb76b2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 25 Aug 2009 23:22:15 -0500 Subject: [PATCH 18/23] cpu.x86: use SQRTSD instruction for math.libm:fsqrt word --- basis/compiler/cfg/hats/hats.factor | 1 + .../cfg/instructions/instructions.factor | 3 +++ .../compiler/cfg/intrinsics/float/float.factor | 3 +++ basis/compiler/cfg/intrinsics/intrinsics.factor | 5 +++++ basis/compiler/codegen/codegen.factor | 2 ++ .../propagation/known-words/known-words.factor | 16 +++++++++++----- basis/cpu/architecture/architecture.factor | 1 + basis/cpu/x86/32/32.factor | 1 + basis/cpu/x86/64/64.factor | 1 + basis/cpu/x86/x86.factor | 1 + basis/math/libm/libm.factor | 17 ----------------- 11 files changed, 29 insertions(+), 22 deletions(-) diff --git a/basis/compiler/cfg/hats/hats.factor b/basis/compiler/cfg/hats/hats.factor index 04fddbb203..d90745a25e 100644 --- a/basis/compiler/cfg/hats/hats.factor +++ b/basis/compiler/cfg/hats/hats.factor @@ -43,6 +43,7 @@ IN: compiler.cfg.hats : ^^sub-float ( src1 src2 -- dst ) ^^r2 ##sub-float ; inline : ^^mul-float ( src1 src2 -- dst ) ^^r2 ##mul-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 : ^^integer>float ( src -- dst ) ^^r1 ##integer>float ; inline : ^^allot ( size class -- dst ) ^^r2 next-vreg ##allot ; inline diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 4cf4340bd7..87c6909a9f 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -106,6 +106,7 @@ INSN: ##add-float < ##commutative ; INSN: ##sub-float < ##binary ; INSN: ##mul-float < ##commutative ; INSN: ##div-float < ##binary ; +INSN: ##sqrt < ##unary ; ! Float/integer conversion INSN: ##float>integer < ##unary ; @@ -256,6 +257,7 @@ UNION: output-float-insn ##sub-float ##mul-float ##div-float + ##sqrt ##integer>float ##unbox-float ##alien-float @@ -267,6 +269,7 @@ UNION: input-float-insn ##sub-float ##mul-float ##div-float + ##sqrt ##float>integer ##box-float ##set-alien-float diff --git a/basis/compiler/cfg/intrinsics/float/float.factor b/basis/compiler/cfg/intrinsics/float/float.factor index 152be80286..9d0af29a15 100644 --- a/basis/compiler/cfg/intrinsics/float/float.factor +++ b/basis/compiler/cfg/intrinsics/float/float.factor @@ -15,3 +15,6 @@ IN: compiler.cfg.intrinsics.float : emit-fixnum>float ( -- ) ds-pop ^^untag-fixnum ^^integer>float ds-push ; + +: emit-fsqrt ( -- ) + ds-pop ^^sqrt ds-push ; diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index 363197c3c0..27d9970a91 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -19,6 +19,7 @@ QUALIFIED: strings.private QUALIFIED: classes.tuple.private QUALIFIED: math.private QUALIFIED: math.integers.private +QUALIFIED: math.libm QUALIFIED: alien.accessors IN: compiler.cfg.intrinsics @@ -92,6 +93,9 @@ IN: compiler.cfg.intrinsics alien.accessors:set-alien-double } [ t "intrinsic" set-word-prop ] each ; +: enable-fsqrt ( -- ) + \ math.libm:fsqrt t "intrinsic" set-word-prop ; + : enable-fixnum-log2 ( -- ) \ 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>fixnum [ drop emit-float>fixnum ] } { \ math.private:fixnum>float [ drop emit-fixnum>float ] } + { \ math.libm:fsqrt [ drop emit-fsqrt ] } { \ slots.private:slot [ emit-slot ] } { \ slots.private:set-slot [ emit-set-slot ] } { \ strings.private:string-nth [ drop emit-string-nth ] } diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index d1b5558beb..6395d8644f 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -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: ##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: ##float>integer generate-insn dst/src %float>integer ; diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor index 3a20424e18..2387db3c15 100644 --- a/basis/compiler/tree/propagation/known-words/known-words.factor +++ b/basis/compiler/tree/propagation/known-words/known-words.factor @@ -2,11 +2,12 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel effects accessors math math.private math.integers.private math.partial-dispatch math.intervals -math.parser math.order math.functions layouts words sequences sequences.private -arrays assocs classes classes.algebra combinators generic.math -splitting fry locals classes.tuple alien.accessors -classes.tuple.private slots.private definitions strings.private -vectors hashtables generic quotations +math.parser math.order math.functions math.libm layouts words +sequences sequences.private arrays assocs classes +classes.algebra combinators generic.math splitting fry locals +classes.tuple alien.accessors classes.tuple.private +slots.private definitions strings.private vectors hashtables +generic quotations stack-checker.state compiler.tree.comparisons compiler.tree.propagation.info @@ -297,3 +298,8 @@ generic-comparison-ops [ bi ] [ 2drop object-info ] if ] "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 diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 7bb9caec9b..71200e1ede 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -110,6 +110,7 @@ HOOK: %add-float cpu ( dst src1 src2 -- ) HOOK: %sub-float cpu ( dst src1 src2 -- ) HOOK: %mul-float cpu ( dst src1 src2 -- ) HOOK: %div-float cpu ( dst src1 src2 -- ) +HOOK: %sqrt cpu ( dst src -- ) HOOK: %integer>float cpu ( dst src -- ) HOOK: %float>integer cpu ( dst src -- ) diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 74312c3718..8808c47995 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -304,6 +304,7 @@ USING: cpu.x86.features cpu.x86.features.private ; sse2? [ " - yes" print enable-float-intrinsics + enable-fsqrt [ sse2? [ "This image was built to use SSE2, which your CPU does not support." print diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 145d4ff677..153e2c511b 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -203,6 +203,7 @@ enable-alien-4-intrinsics ! SSE2 is always available on x86-64. enable-float-intrinsics +enable-fsqrt USE: vocabs.loader diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index a6c958083c..f61dd82276 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -203,6 +203,7 @@ M: x86 %add-float nip ADDSD ; M: x86 %sub-float nip SUBSD ; M: x86 %mul-float nip MULSD ; M: x86 %div-float nip DIVSD ; +M: x86 %sqrt SQRTSD ; M: x86 %integer>float CVTSI2SD ; M: x86 %float>integer CVTTSD2SI ; diff --git a/basis/math/libm/libm.factor b/basis/math/libm/libm.factor index 96f5f134cc..e2bd2ef6eb 100644 --- a/basis/math/libm/libm.factor +++ b/basis/math/libm/libm.factor @@ -5,69 +5,52 @@ IN: math.libm : facos ( x -- y ) "double" "libm" "acos" { "double" } alien-invoke ; - inline : fasin ( x -- y ) "double" "libm" "asin" { "double" } alien-invoke ; - inline : fatan ( x -- y ) "double" "libm" "atan" { "double" } alien-invoke ; - inline : fatan2 ( x y -- z ) "double" "libm" "atan2" { "double" "double" } alien-invoke ; - inline : fcos ( x -- y ) "double" "libm" "cos" { "double" } alien-invoke ; - inline : fsin ( x -- y ) "double" "libm" "sin" { "double" } alien-invoke ; - inline : ftan ( x -- y ) "double" "libm" "tan" { "double" } alien-invoke ; - inline : fcosh ( x -- y ) "double" "libm" "cosh" { "double" } alien-invoke ; - inline : fsinh ( x -- y ) "double" "libm" "sinh" { "double" } alien-invoke ; - inline : ftanh ( x -- y ) "double" "libm" "tanh" { "double" } alien-invoke ; - inline : fexp ( x -- y ) "double" "libm" "exp" { "double" } alien-invoke ; - inline : flog ( x -- y ) "double" "libm" "log" { "double" } alien-invoke ; - inline : fpow ( x y -- z ) "double" "libm" "pow" { "double" "double" } alien-invoke ; - inline : fsqrt ( x -- y ) "double" "libm" "sqrt" { "double" } alien-invoke ; - inline ! Windows doesn't have these... : facosh ( x -- y ) "double" "libm" "acosh" { "double" } alien-invoke ; - inline : fasinh ( x -- y ) "double" "libm" "asinh" { "double" } alien-invoke ; - inline : fatanh ( x -- y ) "double" "libm" "atanh" { "double" } alien-invoke ; - inline From 8d55616d346977da7500b80ecb879b7ce7eb193f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 25 Aug 2009 23:44:01 -0500 Subject: [PATCH 19/23] compiler.cfg.debugger: fix fake-representations so that low-level-ir tests can pass on x86 --- basis/compiler/cfg/debugger/debugger.factor | 30 +++++++++++---------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor index 33f87ff1d4..d51aa477c9 100644 --- a/basis/compiler/cfg/debugger/debugger.factor +++ b/basis/compiler/cfg/debugger/debugger.factor @@ -1,15 +1,16 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel words sequences quotations namespaces io vectors -classes.tuple accessors prettyprint prettyprint.config assocs -prettyprint.backend prettyprint.custom prettyprint.sections -parser compiler.tree.builder compiler.tree.optimizer -cpu.architecture compiler.cfg.builder compiler.cfg.linearization -compiler.cfg.registers compiler.cfg.stack-frame -compiler.cfg.linear-scan compiler.cfg.two-operand -compiler.cfg.optimizer compiler.cfg.instructions -compiler.cfg.utilities compiler.cfg.def-use -compiler.cfg.rpo compiler.cfg.mr compiler.cfg ; +arrays hashtables classes.tuple accessors prettyprint +prettyprint.config assocs prettyprint.backend prettyprint.custom +prettyprint.sections parser compiler.tree.builder +compiler.tree.optimizer cpu.architecture compiler.cfg.builder +compiler.cfg.linearization compiler.cfg.registers +compiler.cfg.stack-frame compiler.cfg.linear-scan +compiler.cfg.two-operand compiler.cfg.optimizer +compiler.cfg.instructions compiler.cfg.utilities +compiler.cfg.def-use compiler.cfg.rpo compiler.cfg.mr +compiler.cfg.representations.preferred compiler.cfg ; IN: compiler.cfg.debugger GENERIC: test-cfg ( quot -- cfgs ) @@ -73,8 +74,9 @@ M: rs-loc pprint* \ R pprint-loc ; : fake-representations ( cfg -- ) post-order [ - instructions>> - [ [ temp-vregs ] [ defs-vreg ] bi [ suffix ] when* ] - map concat - ] map concat - [ int-rep ] H{ } map>assoc representations set ; \ No newline at end of file + instructions>> [ + [ [ temp-vregs ] [ temp-vreg-reps ] bi zip ] + [ [ defs-vreg ] [ defs-vreg-rep ] bi 2dup and [ 2array ] [ 2drop f ] if ] + bi [ suffix ] when* + ] map concat + ] map concat >hashtable representations set ; \ No newline at end of file From a6c8e91f88b6f24f8954aa41bdf748f3cd059caa Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 25 Aug 2009 23:50:27 -0500 Subject: [PATCH 20/23] fix directory-entries so we can bootstrap again --- basis/io/directories/unix/unix.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/directories/unix/unix.factor b/basis/io/directories/unix/unix.factor index b8b781ec12..a107a46275 100644 --- a/basis/io/directories/unix/unix.factor +++ b/basis/io/directories/unix/unix.factor @@ -57,7 +57,7 @@ M: unix find-next-file ( DIR* -- byte-array ) 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 ] } cleave directory-entry boa ; From 0ff80a063db6bb13cf903f465acb6d9041c00d89 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 26 Aug 2009 06:58:47 -0500 Subject: [PATCH 21/23] compiler: only run float test in low-level-ir if float intrinsics enabled; fixes SIGILL on non-sse2 x86 machines --- basis/compiler/tests/low-level-ir.factor | 25 +++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/basis/compiler/tests/low-level-ir.factor b/basis/compiler/tests/low-level-ir.factor index e3e2c3344e..d67aaef43b 100644 --- a/basis/compiler/tests/low-level-ir.factor +++ b/basis/compiler/tests/low-level-ir.factor @@ -3,7 +3,7 @@ compiler.cfg.debugger compiler.cfg.instructions compiler.cfg.mr compiler.cfg.registers compiler.codegen compiler.units cpu.architecture hashtables kernel namespaces sequences tools.test vectors words layouts literals math arrays -alien.syntax ; +alien.syntax math.private ; IN: compiler.tests.low-level-ir : compile-cfg ( cfg -- word ) @@ -46,16 +46,19 @@ IN: compiler.tests.low-level-ir } compile-test-bb ] unit-test -! ##copy on floats -[ 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 +! ##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 ! one of the sources From 8bf709acd015f7ddcbfb927f6439dd89cb30ceaf Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 26 Aug 2009 08:58:00 -0500 Subject: [PATCH 22/23] compiler.cfg.linear-scan: fix unit tests for new fake-representations --- .../cfg/linear-scan/linear-scan-tests.factor | 51 ++++++++++++------- 1 file changed, 32 insertions(+), 19 deletions(-) diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index b7a97e75c6..062c62adab 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -656,14 +656,17 @@ V{ T{ ##copy { dst 689481 } { src 689475 } + { rep int-rep } } T{ ##copy { dst 689482 } { src 689474 } + { rep int-rep } } T{ ##copy { dst 689483 } { src 689473 } + { rep int-rep } } T{ ##branch } } 2 test-bb @@ -672,14 +675,17 @@ V{ T{ ##copy { dst 689481 } { src 689473 } + { rep int-rep } } T{ ##copy { dst 689482 } { src 689475 } + { rep int-rep } } T{ ##copy { dst 689483 } { src 689474 } + { rep int-rep } } T{ ##branch } } 3 test-bb @@ -742,10 +748,12 @@ V{ T{ ##copy { dst 689608 } { src 689600 } + { rep int-rep } } T{ ##copy { dst 689610 } { src 689601 } + { rep int-rep } } T{ ##branch } } 2 test-bb @@ -758,14 +766,17 @@ V{ T{ ##copy { dst 689607 } { src 689600 } + { rep int-rep } } T{ ##copy { dst 689608 } { src 689601 } + { rep int-rep } } T{ ##copy { dst 689610 } { src 689609 } + { rep int-rep } } T{ ##branch } } 3 test-bb @@ -816,6 +827,7 @@ V{ T{ ##copy { dst 2 } { src 1 } + { rep int-rep } } T{ ##branch } } 2 test-bb @@ -828,6 +840,7 @@ V{ T{ ##copy { dst 2 } { src 3 } + { rep int-rep } } T{ ##branch } } 3 test-bb @@ -1121,7 +1134,7 @@ V{ { slot 1 } { tag 2 } } - T{ ##copy { dst 79 } { src 69 } } + T{ ##copy { dst 79 } { src 69 } { rep int-rep } } T{ ##slot-imm { dst 85 } { obj 62 } @@ -1169,22 +1182,22 @@ V{ T{ ##peek { dst 114 } { loc D 1 } } T{ ##peek { dst 116 } { loc D 4 } } T{ ##peek { dst 119 } { loc R 0 } } - T{ ##copy { dst 109 } { src 108 } } - T{ ##copy { dst 111 } { src 110 } } - T{ ##copy { dst 113 } { src 112 } } - T{ ##copy { dst 115 } { src 114 } } - T{ ##copy { dst 117 } { src 116 } } - T{ ##copy { dst 120 } { src 119 } } + T{ ##copy { dst 109 } { src 108 } { rep int-rep } } + T{ ##copy { dst 111 } { src 110 } { rep int-rep } } + T{ ##copy { dst 113 } { src 112 } { rep int-rep } } + T{ ##copy { dst 115 } { src 114 } { rep int-rep } } + T{ ##copy { dst 117 } { src 116 } { rep int-rep } } + T{ ##copy { dst 120 } { src 119 } { rep int-rep } } T{ ##branch } } 3 test-bb V{ - T{ ##copy { dst 109 } { src 62 } } - T{ ##copy { dst 111 } { src 61 } } - T{ ##copy { dst 113 } { src 62 } } - T{ ##copy { dst 115 } { src 79 } } - T{ ##copy { dst 117 } { src 64 } } - T{ ##copy { dst 120 } { src 69 } } + T{ ##copy { dst 109 } { src 62 } { rep int-rep } } + T{ ##copy { dst 111 } { src 61 } { rep int-rep } } + T{ ##copy { dst 113 } { src 62 } { rep int-rep } } + T{ ##copy { dst 115 } { src 79 } { rep int-rep } } + T{ ##copy { dst 117 } { src 64 } { rep int-rep } } + T{ ##copy { dst 120 } { src 69 } { rep int-rep } } T{ ##branch } } 4 test-bb @@ -1306,12 +1319,12 @@ V{ T{ ##peek { dst 162 } { loc D 1 } } T{ ##peek { dst 164 } { loc D 4 } } T{ ##peek { dst 167 } { loc R 0 } } - T{ ##copy { dst 157 } { src 156 } } - T{ ##copy { dst 159 } { src 158 } } - T{ ##copy { dst 161 } { src 160 } } - T{ ##copy { dst 163 } { src 162 } } - T{ ##copy { dst 165 } { src 164 } } - T{ ##copy { dst 168 } { src 167 } } + T{ ##copy { dst 157 } { src 156 } { rep int-rep } } + T{ ##copy { dst 159 } { src 158 } { rep int-rep } } + T{ ##copy { dst 161 } { src 160 } { rep int-rep } } + T{ ##copy { dst 163 } { src 162 } { rep int-rep } } + T{ ##copy { dst 165 } { src 164 } { rep int-rep } } + T{ ##copy { dst 168 } { src 167 } { rep int-rep } } T{ ##branch } } 4 test-bb From 75b3bc655a4b182cf846233aca571d9b62ed7f72 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 26 Aug 2009 09:13:30 -0500 Subject: [PATCH 23/23] allow alien.strings:alien>string to take an object with underlying>> slot --- core/alien/strings/strings.factor | 3 +++ 1 file changed, 3 insertions(+) diff --git a/core/alien/strings/strings.factor b/core/alien/strings/strings.factor index c74c325726..ff20b8b033 100644 --- a/core/alien/strings/strings.factor +++ b/core/alien/strings/strings.factor @@ -12,6 +12,9 @@ M: c-ptr alien>string [ ] [ ] bi* "\0" swap stream-read-until drop ; +M: object alien>string + [ underlying>> ] dip alien>string ; + M: f alien>string drop ;