From b426f287389c590a9431902273e5017ef9ef5b23 Mon Sep 17 00:00:00 2001 From: prunedtree Date: Fri, 12 Jun 2009 01:29:34 -0700 Subject: [PATCH 01/12] make m^n private --- basis/math/matrices/matrices.factor | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/basis/math/matrices/matrices.factor b/basis/math/matrices/matrices.factor index 61e98ee444..21d9a97adf 100644 --- a/basis/math/matrices/matrices.factor +++ b/basis/math/matrices/matrices.factor @@ -61,8 +61,11 @@ PRIVATE> : cross-zip ( seq1 seq2 -- seq1xseq2 ) [ [ 2array ] with map ] curry map ; + + \ No newline at end of file From 9ffbf32c6f94a71f37c11c0032f16ba74392d521 Mon Sep 17 00:00:00 2001 From: prunedtree Date: Fri, 12 Jun 2009 01:35:25 -0700 Subject: [PATCH 02/12] unit test for m^n --- basis/math/matrices/matrices-tests.factor | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/basis/math/matrices/matrices-tests.factor b/basis/math/matrices/matrices-tests.factor index 20942356de..3ee1ddbd6d 100644 --- a/basis/math/matrices/matrices-tests.factor +++ b/basis/math/matrices/matrices-tests.factor @@ -106,4 +106,7 @@ USING: math.matrices math.vectors tools.test math ; [ { 1 0 0 } ] [ { 1 1 0 } { 1 0 0 } proj ] unit-test [ { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } ] -[ { 1 2 } { "a" "b" } cross-zip ] unit-test \ No newline at end of file +[ { 1 2 } { "a" "b" } cross-zip ] unit-test + +[ { { 4181 6765 } { 6765 10946 } } ] +[ { { 0 1 } { 1 1 } } 20 m^n ] unit-test From 6a658506085fae99c827d7c7a4a1f714bb45cbc0 Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Mon, 22 Jun 2009 23:06:07 +0200 Subject: [PATCH 03/12] WIP: crude xt>name disassembler help --- basis/tools/disassembler/udis/udis.factor | 9 +++-- basis/tools/disassembler/utils/utils.factor | 41 +++++++++++++++++++++ 2 files changed, 47 insertions(+), 3 deletions(-) create mode 100644 basis/tools/disassembler/utils/utils.factor diff --git a/basis/tools/disassembler/udis/udis.factor b/basis/tools/disassembler/udis/udis.factor index df624cab28..2f0456ab62 100755 --- a/basis/tools/disassembler/udis/udis.factor +++ b/basis/tools/disassembler/udis/udis.factor @@ -3,7 +3,8 @@ USING: tools.disassembler namespaces combinators alien alien.syntax alien.c-types lexer parser kernel sequences layouts math math.order alien.libraries -math.parser system make fry arrays libc destructors ; +math.parser system make fry arrays libc destructors +tools.disassembler.utils splitting ; IN: tools.disassembler.udis << @@ -103,19 +104,21 @@ FUNCTION: char* ud_lookup_mnemonic ( int c ) ; dup UD_SYN_INTEL ud_set_syntax ; : with-ud ( quot: ( ud -- ) -- ) - [ [ ] dip call ] with-destructors ; inline + [ [ [ ] dip call ] with-destructors ] with-words-xt ; inline SINGLETON: udis-disassembler : buf/len ( from to -- buf len ) [ drop ] [ swap - ] 2bi ; +: resolve-call ( str -- str' ) "0x" split1-last [ resolve-xt append ] when* ; + : format-disassembly ( lines -- lines' ) dup [ second length ] [ max ] map-reduce '[ [ [ first >hex cell 2 * CHAR: 0 pad-head % ": " % ] [ second _ CHAR: \s pad-tail % " " % ] - [ third % ] + [ third resolve-call % ] tri ] "" make ] map ; diff --git a/basis/tools/disassembler/utils/utils.factor b/basis/tools/disassembler/utils/utils.factor new file mode 100644 index 0000000000..fb936cf08a --- /dev/null +++ b/basis/tools/disassembler/utils/utils.factor @@ -0,0 +1,41 @@ +USING: accessors arrays binary-search kernel math math.order +math.parser namespaces sequences sorting splitting vectors vocabs words ; +IN: tools.disassembler.utils + +SYMBOL: words-xt +SYMBOL: smallest-xt +SYMBOL: greatest-xt + +: (words-xt) ( -- assoc ) + vocabs [ words ] map concat [ [ word-xt ] keep 3array ] map + [ [ first ] bi@ <=> ] sort >vector ; + +: complete-address ( n seq -- str ) + [ first - ] [ third name>> ] bi + over zero? [ nip ] [ swap 16 >base "0x" prepend "+" glue ] if ; + +: search-xt ( n -- str/f ) + dup [ smallest-xt get < ] [ greatest-xt get > ] bi or [ + drop f + ] [ + words-xt get over [ swap first <=> ] curry search nip + 2dup second <= [ + [ complete-address ] [ drop f ] if* + ] [ + 2drop f + ] if + ] if ; + +: resolve-xt ( str -- str' ) + [ "0x" prepend ] [ 16 base> ] bi + [ search-xt [ " (" ")" surround append ] when* ] when* ; + +: resolve-call ( str -- str' ) + "0x" split1-last [ resolve-xt "0x" glue ] when* ; + +: with-words-xt ( quot -- ) + [ (words-xt) + [ words-xt set ] + [ first first smallest-xt set ] + [ last second greatest-xt set ] tri + ] prepose with-scope ; inline From e5897d52b26cc6196e73e41f8c29eb155b14ebcb Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Sat, 29 Aug 2009 21:42:15 +0200 Subject: [PATCH 04/12] Ensure that random-prime result has the right size As noted by Slava, choosing the next prime following a random number with a specified number of bits may give a number one more bit long. --- basis/math/primes/primes.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/basis/math/primes/primes.factor b/basis/math/primes/primes.factor index 7e877a03ce..27743a4a85 100644 --- a/basis/math/primes/primes.factor +++ b/basis/math/primes/primes.factor @@ -56,7 +56,8 @@ PRIVATE> : coprime? ( a b -- ? ) gcd nip 1 = ; foldable : random-prime ( numbits -- p ) - random-bits* next-prime ; + [ ] [ 2^ ] [ random-bits* next-prime ] tri + 2dup < [ 2drop random-prime ] [ 2nip ] if ; : estimated-primes ( m -- n ) dup log / ; foldable From 9d61c162e2fcb20593344fc8dd3653a3e1da14d9 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Aug 2009 21:23:35 -0500 Subject: [PATCH 05/12] benchmark.struct-arrays: doesn't actually need HINTS: --- extra/benchmark/struct-arrays/struct-arrays.factor | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/extra/benchmark/struct-arrays/struct-arrays.factor b/extra/benchmark/struct-arrays/struct-arrays.factor index 827604a39e..faed2f4dca 100644 --- a/extra/benchmark/struct-arrays/struct-arrays.factor +++ b/extra/benchmark/struct-arrays/struct-arrays.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors classes.struct combinators.smart fry kernel math math.functions math.order math.parser sequences -struct-arrays hints io ; +struct-arrays io ; IN: benchmark.struct-arrays STRUCT: point { x float } { y float } { z float } ; @@ -45,8 +45,6 @@ STRUCT: point { x float } { y float } { z float } ; : struct-array-benchmark ( len -- ) make-points [ normalize-points ] [ max-points ] bi print-point ; -HINTS: struct-array-benchmark fixnum ; - : main ( -- ) 5000000 struct-array-benchmark ; MAIN: main From dca528eaef4fa5cab9262642ed6c697394a627e1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Aug 2009 22:09:51 -0500 Subject: [PATCH 06/12] benchmark.terrain-generation: fix type error --- extra/benchmark/terrain-generation/terrain-generation.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/benchmark/terrain-generation/terrain-generation.factor b/extra/benchmark/terrain-generation/terrain-generation.factor index 7fbb0ff43f..623a905bbc 100644 --- a/extra/benchmark/terrain-generation/terrain-generation.factor +++ b/extra/benchmark/terrain-generation/terrain-generation.factor @@ -4,7 +4,7 @@ IN: benchmark.terrain-generation : terrain-generation-benchmark ( -- ) "Generating terrain segment..." write flush yield - { 0.0 0.0 } terrain-segment drop + { 0 0 } terrain-segment drop "done" print ; MAIN: terrain-generation-benchmark From 3e51bde4845d429ed7e462643985f8f7e158e29c Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 29 Aug 2009 22:40:13 -0500 Subject: [PATCH 07/12] change malloc-struct to initialize struct from initial values; add (malloc-struct) and (struct) words that leave their memory uninitialized --- basis/classes/struct/struct-docs.factor | 21 ++++++++++++++++++++- basis/classes/struct/struct-tests.factor | 2 +- basis/classes/struct/struct.factor | 17 +++++++++++------ 3 files changed, 32 insertions(+), 8 deletions(-) diff --git a/basis/classes/struct/struct-docs.factor b/basis/classes/struct/struct-docs.factor index bcc77f1b25..787f03423e 100644 --- a/basis/classes/struct/struct-docs.factor +++ b/basis/classes/struct/struct-docs.factor @@ -9,6 +9,15 @@ HELP: } { $description "This macro implements " { $link boa } " for " { $link struct } " classes. A struct of the given class is constructed, and its slots are initialized using values off the top of the datastack." } ; +HELP: (struct) +{ $values + { "class" class } + { "struct" struct } +} +{ $description "Allocates garbage-collected heap memory for a new " { $link struct } " of the specified " { $snippet "class" } ". The new struct's slots are left uninitialized; in most cases, the " { $link } " word, which initializes the struct's slots with their initial values, should be used instead." } ; + +{ (struct) (malloc-struct) } related-words + HELP: { $values { "class" class } @@ -55,7 +64,14 @@ HELP: malloc-struct { "class" class } { "struct" struct } } -{ $description "Allocates unmanaged C heap memory for a new " { $link struct } " of the specified " { $snippet "class" } ". The new struct's slots are zeroed out. The struct should be " { $link free } "d when it is no longer needed." } ; +{ $description "Allocates unmanaged C heap memory for a new " { $link struct } " of the specified " { $snippet "class" } ". The new struct's slots are initialized to their initial values. The struct should be " { $link free } "d when it is no longer needed." } ; + +HELP: (malloc-struct) +{ $values + { "class" class } + { "struct" struct } +} +{ $description "Allocates unmanaged C heap memory for a new " { $link struct } " of the specified " { $snippet "class" } ". The new struct's slots are left uninitialized; to initialize the allocated memory with the slots' initial values, use " { $link malloc-struct } ". The struct should be " { $link free } "d when it is no longer needed." } ; HELP: memory>struct { $values @@ -80,6 +96,9 @@ ARTICLE: "classes.struct" "Struct classes" { $subsection } { $subsection malloc-struct } { $subsection memory>struct } +"When the contents of a struct will be immediately reset, faster primitive words are available that will create a struct without initializing its contents:" +{ $subsection (struct) } +{ $subsection (malloc-struct) } "Structs have literal syntax like tuples:" { $subsection POSTPONE: S{ } "Union structs are also supported, which behave like structs but share the same memory for all the type's slots." diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index 2995e9d6d6..52e766a682 100644 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -63,7 +63,7 @@ UNION-STRUCT: struct-test-float-and-bits [ 1.0 ] [ struct-test-float-and-bits 1.0 float>bits >>bits f>> ] unit-test [ 4 ] [ struct-test-float-and-bits heap-size ] unit-test -[ ] [ [ struct-test-foo malloc-struct &free drop ] with-destructors ] unit-test +[ 123 ] [ [ struct-test-foo malloc-struct &free y>> ] with-destructors ] unit-test STRUCT: struct-test-string-ptr { x char* } ; diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 45ad3c62bb..94eebca081 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -37,6 +37,8 @@ M: struct equal? [ [ >c-ptr ] [ [ >c-ptr ] [ byte-length ] bi ] bi* memory= ] } 2&& ; +: struct-prototype ( class -- prototype ) "prototype" word-prop ; foldable + : memory>struct ( ptr class -- struct ) [ 1array ] dip slots>tuple ; @@ -44,17 +46,20 @@ M: struct equal? dup struct-class? [ '[ _ boa ] ] [ drop f ] if ] 1 define-partial-eval +: (init-struct) ( class with-prototype: ( prototype -- alien ) sans-prototype: ( class -- alien ) -- alien ) + '[ dup struct-prototype _ _ ?if ] keep memory>struct ; inline + +: (malloc-struct) ( class -- struct ) + [ heap-size malloc ] keep memory>struct ; inline + : malloc-struct ( class -- struct ) - [ 1 swap heap-size calloc ] keep memory>struct ; inline + [ >c-ptr malloc-byte-array ] [ 1 swap heap-size calloc ] (init-struct) ; : (struct) ( class -- struct ) - [ heap-size ] keep memory>struct ; inline - -: struct-prototype ( class -- prototype ) "prototype" word-prop ; foldable + [ heap-size (byte-array) ] keep memory>struct ; inline : ( class -- struct ) - dup struct-prototype - [ >c-ptr clone swap memory>struct ] [ (struct) ] if* ; inline + [ >c-ptr clone ] [ heap-size ] (init-struct) ; MACRO: ( class -- quot: ( ... -- struct ) ) [ From 4d8ed23db5e6cd0ec309ef06bedd309e91609233 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 29 Aug 2009 22:42:48 -0500 Subject: [PATCH 08/12] add non-initializing (malloc-array) and (malloc-object) for kicks --- basis/alien/c-types/c-types.factor | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 13607566e0..d75a4898c5 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -265,9 +265,15 @@ M: f byte-length drop 0 ; inline : malloc-array ( n type -- alien ) [ heap-size calloc ] [ ] 2bi ; inline +: (malloc-array) ( n type -- alien ) + [ heap-size * malloc ] [ ] 2bi ; inline + : malloc-object ( type -- alien ) 1 swap heap-size calloc ; inline +: (malloc-object) ( type -- alien ) + heap-size malloc ; inline + : malloc-byte-array ( byte-array -- alien ) dup byte-length [ nip malloc dup ] 2keep memcpy ; From 20aa00f8df1363c212b1c452ddfecbddf70ed11e Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 29 Aug 2009 22:54:56 -0500 Subject: [PATCH 09/12] implement clone on struct classes to copy the struct contents --- basis/classes/struct/struct-tests.factor | 4 +++- basis/classes/struct/struct.factor | 3 +++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index 52e766a682..0cd91da370 100644 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -1,5 +1,5 @@ ! (c)Joe Groff bsd license -USING: accessors alien.c-types alien.libraries +USING: accessors alien alien.c-types alien.libraries 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 @@ -203,3 +203,5 @@ STRUCT: struct-test-optimization ] unit-test [ f ] [ [ memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test + +[ f ] [ struct-test-foo dup clone [ >c-ptr ] bi@ eq? ] unit-test diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 94eebca081..4cb275f86f 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -46,6 +46,9 @@ M: struct equal? dup struct-class? [ '[ _ boa ] ] [ drop f ] if ] 1 define-partial-eval +M: struct clone + [ >c-ptr ] [ byte-length memory>byte-array ] [ class memory>struct ] tri ; + : (init-struct) ( class with-prototype: ( prototype -- alien ) sans-prototype: ( class -- alien ) -- alien ) '[ dup struct-prototype _ _ ?if ] keep memory>struct ; inline From 32f014a030041203a5bae592e42522d9bb8e24cb Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 29 Aug 2009 22:59:13 -0500 Subject: [PATCH 10/12] privatize classes.struct's shameful bits --- basis/classes/struct/struct.factor | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 4cb275f86f..4238230e16 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -49,8 +49,10 @@ M: struct equal? M: struct clone [ >c-ptr ] [ byte-length memory>byte-array ] [ class memory>struct ] tri ; +struct ; inline +PRIVATE> : (malloc-struct) ( class -- struct ) [ heap-size malloc ] keep memory>struct ; inline @@ -74,6 +76,7 @@ MACRO: ( class -- quot: ( ... -- struct ) ) ] bi ] [ ] output>sequence ; +> ] map over length tail append ] keep ; @@ -90,6 +93,7 @@ MACRO: ( class -- quot: ( ... -- struct ) ) : (unboxer-quot) ( class -- quot ) drop [ >c-ptr ] ; +PRIVATE> M: struct-class boa>object swap pad-struct-slots @@ -106,6 +110,7 @@ M: struct-class reader-quot M: struct-class writer-quot nip (writer-quot) ; +> reader-word 1quotation ] map @@ -120,8 +125,6 @@ M: struct-class writer-quot [ \ byte-length create-method-in ] [ heap-size \ drop swap [ ] 2sequence ] bi define ; -! Struct as c-type - : slot>field ( slot -- field ) field-spec new swap { [ name>> >>name ] @@ -163,6 +166,7 @@ M: struct-class writer-quot : struct-align ( slots -- align ) [ c-type>> c-type-align ] [ max ] map-reduce ; +PRIVATE> M: struct-class c-type name>> c-type ; @@ -188,6 +192,7 @@ M: struct-class heap-size ! class definition + ] [ memory>struct ] @@ -227,6 +232,7 @@ M: struct-class heap-size (struct-word-props) ] [ drop define-struct-for-class ] 2tri ; inline +PRIVATE> : define-struct-class ( class slots -- ) [ struct-offsets ] (define-struct-class) ; @@ -236,6 +242,7 @@ M: struct-class heap-size ERROR: invalid-struct-slot token ; + [ parse-struct-slots ] [ ] while >array ; +PRIVATE> SYNTAX: STRUCT: parse-struct-definition define-struct-class ; @@ -267,6 +275,9 @@ SYNTAX: UNION-STRUCT: SYNTAX: S{ scan-word dup struct-slots parse-tuple-literal-slots parsed ; +! functor support + +array ] [ >string-param ] if ; @@ -288,6 +299,7 @@ SYNTAX: S{ { "{" [ parse-struct-slot` t ] } [ invalid-struct-slot ] } case ; +PRIVATE> FUNCTOR-SYNTAX: STRUCT: scan-param parsed From be406fa9649dac538f6ae80bc1108368f8a49ca3 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 29 Aug 2009 23:18:31 -0500 Subject: [PATCH 11/12] fix alien.complex unboxer --- basis/alien/complex/functor/functor.factor | 4 ++-- basis/classes/struct/struct.factor | 2 ++ 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/basis/alien/complex/functor/functor.factor b/basis/alien/complex/functor/functor.factor index cb66175a29..b05059e9cb 100644 --- a/basis/alien/complex/functor/functor.factor +++ b/basis/alien/complex/functor/functor.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.structs alien.c-types classes.struct math +USING: accessors alien alien.structs alien.c-types classes.struct math math.functions sequences arrays kernel functors vocabs.parser namespaces quotations ; IN: alien.complex.functor @@ -17,7 +17,7 @@ WHERE STRUCT: T-class { real N } { imaginary N } ; : ( z -- alien ) - >rect T-class ; + >rect T-class >c-ptr ; : *T ( alien -- z ) T-class memory>struct [ real>> ] [ imaginary>> ] bi rect> ; inline diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 4238230e16..99150e9bb6 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -110,6 +110,8 @@ M: struct-class reader-quot M: struct-class writer-quot nip (writer-quot) ; +! c-types + Date: Sun, 30 Aug 2009 17:29:40 +0900 Subject: [PATCH 12/12] Better error images for non-baseline JPEGs. bugfix: Handles more than one table per DHT chunk. --- basis/images/jpeg/jpeg.factor | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/basis/images/jpeg/jpeg.factor b/basis/images/jpeg/jpeg.factor index 776f768036..f0280e46de 100644 --- a/basis/images/jpeg/jpeg.factor +++ b/basis/images/jpeg/jpeg.factor @@ -6,7 +6,7 @@ images.processing io io.binary io.encodings.binary io.files io.streams.byte-array kernel locals math math.bitwise math.constants math.functions math.matrices math.order math.ranges math.vectors memoize multiline namespaces -sequences sequences.deep images.loader ; +sequences sequences.deep images.loader io.streams.limited ; IN: images.jpeg QUALIFIED-WITH: bitstreams bs @@ -118,18 +118,18 @@ TUPLE: jpeg-color-info ] with-byte-reader ; : decode-huff-table ( chunk -- ) - data>> - binary - [ - 1 ! %fixme: Should handle multiple tables at once + data>> [ binary ] [ length ] bi + stream-throws limit + [ + [ input-stream get [ count>> ] [ limit>> ] bi < ] [ read4/4 swap 2 * + 16 read dup [ ] [ + ] map-reduce read binary [ [ read [ B{ } ] unless* ] { } map-as ] with-byte-reader swap jpeg> huff-tables>> set-nth - ] times - ] with-byte-reader ; + ] while + ] with-input-stream* ; : decode-scan ( chunk -- ) data>> @@ -148,7 +148,10 @@ TUPLE: jpeg-color-info : singleton-first ( seq -- elt ) [ length 1 assert= ] [ first ] bi ; +ERROR: not-a-baseline-jpeg-image ; + : baseline-parse ( -- ) + jpeg> headers>> [ type>> { SOF 0 } = ] any? [ not-a-baseline-jpeg-image ] unless jpeg> headers>> { [ [ type>> { SOF 0 } = ] filter singleton-first decode-frame ] @@ -221,7 +224,7 @@ MEMO: dct-matrix-blas ( -- m ) dct-matrix >float-blas-matrix ; : V.M ( x A -- x.A ) Mtranspose swap M.V ; : idct-blas ( b -- b' ) >float-blas-vector dct-matrix-blas V.M ; -: idct ( b -- b' ) idct-blas ; +: idct ( b -- b' ) idct-factor ; :: draw-block ( block x,y color-id jpeg-image -- ) block dup length>> sqrt >fixnum group flip