From dd57fe7a2310c58ce10ea8e53916dc0b9d593580 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 12 Feb 2009 02:19:31 -0600 Subject: [PATCH 01/14] editors: better error message if definition does not have an associated source file when editing a word-link, go to the word itself if the word has no help --- basis/editors/editors.factor | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/basis/editors/editors.factor b/basis/editors/editors.factor index 53887bd353..d060a3dfe6 100644 --- a/basis/editors/editors.factor +++ b/basis/editors/editors.factor @@ -1,9 +1,10 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: parser lexer kernel namespaces sequences definitions io.files io.backend io.pathnames io summary continuations tools.crossref tools.vocabs prettyprint source-files assocs -vocabs vocabs.loader splitting accessors ; +vocabs vocabs.loader splitting accessors debugger prettyprint +help.topics ; IN: editors TUPLE: no-edit-hook ; @@ -29,11 +30,21 @@ SYMBOL: edit-hook [ (normalize-path) ] dip edit-hook get-global [ call ] [ no-edit-hook edit-location ] if* ; +ERROR: cannot-find-source definition ; + +M: cannot-find-source error. + "Cannot find source for ``" write + definition>> pprint-short + "''" print ; + : edit ( defspec -- ) - where [ first2 edit-location ] when* ; + dup where + [ first2 edit-location ] + [ dup word-link? [ name>> edit ] [ cannot-find-source ] if ] + ?if ; : edit-vocab ( name -- ) - vocab-source-path 1 edit-location ; + >vocab-link edit ; GENERIC: error-file ( error -- file ) From 13af3b48019a91d27d32b30136f96865c7de6cad Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 12 Feb 2009 02:19:41 -0600 Subject: [PATCH 02/14] combinators.smart: add map-reduce-outputs --- basis/combinators/smart/smart-tests.factor | 4 +++- basis/combinators/smart/smart.factor | 6 ++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/basis/combinators/smart/smart-tests.factor b/basis/combinators/smart/smart-tests.factor index 69a3a821e5..1cca697dde 100644 --- a/basis/combinators/smart/smart-tests.factor +++ b/basis/combinators/smart/smart-tests.factor @@ -44,4 +44,6 @@ IN: combinators.smart.tests \ nested-smart-combo-test must-infer -[ { { 1 2 } { 3 4 } } ] [ nested-smart-combo-test ] unit-test \ No newline at end of file +[ { { 1 2 } { 3 4 } } ] [ nested-smart-combo-test ] unit-test + +[ 14 ] [ [ 1 2 3 ] [ sq ] [ + ] map-reduce-outputs ] unit-test \ No newline at end of file diff --git a/basis/combinators/smart/smart.factor b/basis/combinators/smart/smart.factor index e93d84e394..e7bdd75ced 100644 --- a/basis/combinators/smart/smart.factor +++ b/basis/combinators/smart/smart.factor @@ -21,6 +21,12 @@ MACRO: reduce-outputs ( quot operation -- newquot ) : sum-outputs ( quot -- n ) [ + ] reduce-outputs ; inline +MACRO: map-reduce-outputs ( quot mapper reducer -- newquot ) + [ dup infer out>> ] 2dip + [ swap '[ _ _ napply ] ] + [ [ 1 [-] ] dip n*quot ] bi-curry* bi + '[ @ @ @ ] ; + MACRO: append-outputs-as ( quot exemplar -- newquot ) [ dup infer out>> ] dip '[ @ _ _ nappend-as ] ; From 22205159470b9ea159dfb6209bc9609eb83e2a5e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 12 Feb 2009 02:41:37 -0600 Subject: [PATCH 03/14] Re-organize images and images.backend into images and images.loader --- basis/images/backend/authors.txt | 1 - basis/images/backend/backend.factor | 51 ----------------- basis/images/bitmap/bitmap-tests.factor | 8 +-- basis/images/bitmap/bitmap.factor | 4 +- basis/images/images.factor | 52 +++++++++++++----- basis/images/loader/authors.txt | 1 + basis/images/loader/loader.factor | 21 +++++++ {extra => basis}/images/test-images/1bit.bmp | Bin .../images/test-images/octagon.tiff | Bin {extra => basis}/images/test-images/rgb.tiff | Bin .../images/test-images/rgb4bit.bmp | Bin .../images/test-images/rgb8bit.bmp | Bin .../images/test-images/thiswayup24.bmp | Bin basis/images/tiff/tiff.factor | 8 +-- extra/images/viewer/viewer.factor | 2 +- 15 files changed, 71 insertions(+), 77 deletions(-) delete mode 100644 basis/images/backend/authors.txt delete mode 100644 basis/images/backend/backend.factor create mode 100644 basis/images/loader/authors.txt create mode 100644 basis/images/loader/loader.factor rename {extra => basis}/images/test-images/1bit.bmp (100%) rename {extra => basis}/images/test-images/octagon.tiff (100%) rename {extra => basis}/images/test-images/rgb.tiff (100%) rename {extra => basis}/images/test-images/rgb4bit.bmp (100%) rename {extra => basis}/images/test-images/rgb8bit.bmp (100%) rename {extra => basis}/images/test-images/thiswayup24.bmp (100%) diff --git a/basis/images/backend/authors.txt b/basis/images/backend/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/basis/images/backend/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/basis/images/backend/backend.factor b/basis/images/backend/backend.factor deleted file mode 100644 index 756b98efee..0000000000 --- a/basis/images/backend/backend.factor +++ /dev/null @@ -1,51 +0,0 @@ -! Copyright (C) 2009 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel grouping fry sequences combinators -math ; -IN: images.backend - -SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR ; - -TUPLE: image dim component-order bitmap ; - -TUPLE: normalized-image < image ; - -GENERIC: load-image* ( path tuple -- image ) - -GENERIC: >image ( object -- image ) - -: no-op ( -- ) ; - -: normalize-component-order ( image -- image ) - dup component-order>> - { - { RGBA [ no-op ] } - { BGRA [ - [ - [ 4 [ [ 0 3 ] dip reverse-here ] each ] - [ RGBA >>component-order ] bi - ] change-bitmap - ] } - { RGB [ - [ 3 [ 255 suffix ] map concat ] change-bitmap - ] } - { BGR [ - [ - 3 dup [ [ 0 3 ] dip reverse-here ] each - [ 255 suffix ] map concat - ] change-bitmap - ] } - } case RGBA >>component-order ; - -GENERIC: normalize-scan-line-order ( image -- image ) - -M: image normalize-scan-line-order ; -: normalize-image ( image -- image ) - normalize-component-order - normalize-scan-line-order ; - -: new-image ( dim component-order bitmap class -- image ) - new - swap >>bitmap - swap >>component-order - swap >>dim ; inline diff --git a/basis/images/bitmap/bitmap-tests.factor b/basis/images/bitmap/bitmap-tests.factor index a7deae3178..102c13c295 100644 --- a/basis/images/bitmap/bitmap-tests.factor +++ b/basis/images/bitmap/bitmap-tests.factor @@ -3,16 +3,16 @@ io.files io.files.unique kernel tools.test ; IN: images.bitmap.tests : test-bitmap24 ( -- path ) - "resource:extra/images/test-images/thiswayup24.bmp" ; + "resource:basis/images/test-images/thiswayup24.bmp" ; : test-bitmap8 ( -- path ) - "resource:extra/images/test-images/rgb8bit.bmp" ; + "resource:basis/images/test-images/rgb8bit.bmp" ; : test-bitmap4 ( -- path ) - "resource:extra/images/test-images/rgb4bit.bmp" ; + "resource:basis/images/test-images/rgb4bit.bmp" ; : test-bitmap1 ( -- path ) - "resource:extra/images/test-images/1bit.bmp" ; + "resource:basis/images/test-images/1bit.bmp" ; [ t ] [ diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor index 46f90e33f8..5530fa12b7 100755 --- a/basis/images/bitmap/bitmap.factor +++ b/basis/images/bitmap/bitmap.factor @@ -4,7 +4,7 @@ USING: accessors alien alien.c-types arrays byte-arrays columns combinators fry grouping io io.binary io.encodings.binary io.files kernel libc macros math math.bitwise math.functions namespaces opengl opengl.gl prettyprint sequences strings -summary ui ui.gadgets.panes images.backend ; +summary ui ui.gadgets.panes images ; IN: images.bitmap TUPLE: bitmap-image < image ; @@ -102,7 +102,7 @@ ERROR: unknown-component-order bitmap ; [ unknown-component-order ] } case ; -M: bitmap >image ( bitmap -- bitmap-image ) +: >image ( bitmap -- bitmap-image ) { [ [ width>> ] [ height>> ] bi 2array ] [ bitmap>component-order ] diff --git a/basis/images/images.factor b/basis/images/images.factor index 3df7b5d2d1..9f4d14e7bf 100644 --- a/basis/images/images.factor +++ b/basis/images/images.factor @@ -1,21 +1,45 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: constructors kernel splitting unicode.case combinators -accessors images.bitmap images.tiff images.backend io.backend -io.pathnames ; IN: images -ERROR: unknown-image-extension extension ; +SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR ; -: image-class ( path -- class ) - file-extension >lower { - { "bmp" [ bitmap-image ] } - { "tiff" [ tiff-image ] } - [ unknown-image-extension ] - } case ; +TUPLE: image dim component-order bitmap ; -: load-image ( path -- image ) - dup image-class new load-image* ; +GENERIC: load-image* ( path tuple -- image ) -: ( path -- image ) - load-image normalize-image ; +: normalize-component-order ( image -- image ) + dup component-order>> + { + { RGBA [ ] } + { BGRA [ + [ + [ 4 [ [ 0 3 ] dip reverse-here ] each ] + [ RGBA >>component-order ] bi + ] change-bitmap + ] } + { RGB [ + [ 3 [ 255 suffix ] map concat ] change-bitmap + ] } + { BGR [ + [ + 3 dup [ [ 0 3 ] dip reverse-here ] each + [ 255 suffix ] map concat + ] change-bitmap + ] } + } case + RGBA >>component-order ; + +GENERIC: normalize-scan-line-order ( image -- image ) + +M: image normalize-scan-line-order ; + +: normalize-image ( image -- image ) + normalize-component-order + normalize-scan-line-order ; + +: new-image ( dim component-order bitmap class -- image ) + new + swap >>bitmap + swap >>component-order + swap >>dim ; inline diff --git a/basis/images/loader/authors.txt b/basis/images/loader/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/images/loader/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/images/loader/loader.factor b/basis/images/loader/loader.factor new file mode 100644 index 0000000000..7aeba9f24a --- /dev/null +++ b/basis/images/loader/loader.factor @@ -0,0 +1,21 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: constructors kernel splitting unicode.case combinators +accessors images.bitmap images.tiff images io.backend +io.pathnames ; +IN: images.loader + +ERROR: unknown-image-extension extension ; + +: image-class ( path -- class ) + file-extension >lower { + { "bmp" [ bitmap-image ] } + { "tiff" [ tiff-image ] } + [ unknown-image-extension ] + } case ; + +: load-image ( path -- image ) + dup image-class new load-image* ; + +: ( path -- image ) + load-image normalize-image ; diff --git a/extra/images/test-images/1bit.bmp b/basis/images/test-images/1bit.bmp similarity index 100% rename from extra/images/test-images/1bit.bmp rename to basis/images/test-images/1bit.bmp diff --git a/extra/images/test-images/octagon.tiff b/basis/images/test-images/octagon.tiff similarity index 100% rename from extra/images/test-images/octagon.tiff rename to basis/images/test-images/octagon.tiff diff --git a/extra/images/test-images/rgb.tiff b/basis/images/test-images/rgb.tiff similarity index 100% rename from extra/images/test-images/rgb.tiff rename to basis/images/test-images/rgb.tiff diff --git a/extra/images/test-images/rgb4bit.bmp b/basis/images/test-images/rgb4bit.bmp similarity index 100% rename from extra/images/test-images/rgb4bit.bmp rename to basis/images/test-images/rgb4bit.bmp diff --git a/extra/images/test-images/rgb8bit.bmp b/basis/images/test-images/rgb8bit.bmp similarity index 100% rename from extra/images/test-images/rgb8bit.bmp rename to basis/images/test-images/rgb8bit.bmp diff --git a/extra/images/test-images/thiswayup24.bmp b/basis/images/test-images/thiswayup24.bmp similarity index 100% rename from extra/images/test-images/thiswayup24.bmp rename to basis/images/test-images/thiswayup24.bmp diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor index dac071b4b4..c81d052a7f 100755 --- a/basis/images/tiff/tiff.factor +++ b/basis/images/tiff/tiff.factor @@ -3,7 +3,7 @@ USING: accessors combinators io io.encodings.binary io.files kernel pack endian constructors sequences arrays math.order math.parser prettyprint classes io.binary assocs math math.bitwise byte-arrays -grouping images.backend ; +grouping images ; IN: images.tiff TUPLE: tiff-image < image ; @@ -268,14 +268,14 @@ ERROR: unknown-component-order ifd ; [ unknown-component-order ] } case ; -M: ifd >image ( ifd -- image ) +: ifd>image ( ifd -- image ) { [ [ image-width find-tag ] [ image-length find-tag ] bi 2array ] [ ifd-component-order ] [ bitmap>> ] } cleave tiff-image new-image ; -M: parsed-tiff >image ( image -- image ) +: tiff>image ( image -- image ) ifds>> [ >image ] map first ; : load-tiff ( path -- parsed-tiff ) @@ -289,4 +289,4 @@ M: parsed-tiff >image ( image -- image ) ! tiff files can store several images -- we just take the first for now M: tiff-image load-image* ( path tiff-image -- image ) - drop load-tiff >image ; + drop load-tiff tiff>image ; diff --git a/extra/images/viewer/viewer.factor b/extra/images/viewer/viewer.factor index 92277dfdef..0795900150 100644 --- a/extra/images/viewer/viewer.factor +++ b/extra/images/viewer/viewer.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors images images.backend io.pathnames kernel +USING: accessors images images.loader io.pathnames kernel namespaces opengl opengl.gl sequences strings ui ui.gadgets ui.gadgets.panes ui.render ; IN: images.viewer From 7361bb90fa79283b6eea5b373e7b385382cc41e3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 12 Feb 2009 02:41:47 -0600 Subject: [PATCH 04/14] images: fix load errors --- basis/images/images.factor | 1 + basis/images/tiff/tiff.factor | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/basis/images/images.factor b/basis/images/images.factor index 9f4d14e7bf..5fdc9ee5e9 100644 --- a/basis/images/images.factor +++ b/basis/images/images.factor @@ -1,5 +1,6 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. +USING: kernel accessors grouping sequences combinators ; IN: images SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR ; diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor index c81d052a7f..dd4319a474 100755 --- a/basis/images/tiff/tiff.factor +++ b/basis/images/tiff/tiff.factor @@ -276,7 +276,7 @@ ERROR: unknown-component-order ifd ; } cleave tiff-image new-image ; : tiff>image ( image -- image ) - ifds>> [ >image ] map first ; + ifds>> [ ifd>image ] map first ; : load-tiff ( path -- parsed-tiff ) binary [ From 421631eebbe226c01f2cc8c3aecf5309cd1f55f3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 12 Feb 2009 04:16:08 -0600 Subject: [PATCH 05/14] bootstrap.image: update documentation (found by mnestic) --- basis/bootstrap/image/image-docs.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/bootstrap/image/image-docs.factor b/basis/bootstrap/image/image-docs.factor index 3856382ffb..835c39c171 100644 --- a/basis/bootstrap/image/image-docs.factor +++ b/basis/bootstrap/image/image-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax io io.files io.pathnames ; +USING: help.markup help.syntax io io.files io.pathnames strings ; IN: bootstrap.image ARTICLE: "bootstrap.image" "Bootstrapping new images" @@ -14,7 +14,7 @@ $nl ABOUT: "bootstrap.image" HELP: make-image -{ $values { "arch" "a string" } } +{ $values { "arch" string } } { $description "Creates a bootstrap image from sources, where " { $snippet "architecture" } " is one of the following:" -{ $code "x86.32" "x86.64" "ppc" "arm" } +{ $code "x86.32" "unix-x86.64" "winnt-x86.64" "macosx-ppc" "linux-ppc" } "The new image file is written to the " { $link resource-path } " and is named " { $snippet "boot." { $emphasis "architecture" } ".image" } "." } ; From a550c9874c2ffc9c1f43e59c989f2c1951f43d63 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 12 Feb 2009 04:23:35 -0600 Subject: [PATCH 06/14] kernel: add {bi,tri}-curry{,*,@} combinators from new_ui branch --- core/kernel/kernel.factor | 111 ++++++++++++++++++++++---------------- 1 file changed, 65 insertions(+), 46 deletions(-) diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index be1de76650..06fe289281 100644 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2008 Slava Pestov. +! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel.private slots.private math.private classes.tuple.private ; @@ -51,7 +51,7 @@ DEFER: if ! Default : ?if ( default cond true false -- ) - pick [ roll 2drop call ] [ 2nip call ] if ; inline + pick [ drop [ drop ] 2dip call ] [ 2nip call ] if ; inline ! Slippers and dippers. ! Not declared inline because the compiler special-cases them @@ -138,6 +138,69 @@ DEFER: if : 2tri@ ( u v w y x z quot -- ) dup dup 2tri* ; inline +! Quotation building +: 2curry ( obj1 obj2 quot -- curry ) + curry curry ; inline + +: 3curry ( obj1 obj2 obj3 quot -- curry ) + curry curry curry ; inline + +: with ( param obj quot -- obj curry ) + swapd [ swapd call ] 2curry ; inline + +: prepose ( quot1 quot2 -- compose ) + swap compose ; inline + +! Curried cleavers + + +: bi-curry ( x p q -- p' q' ) [ [curry] ] bi@ bi ; inline + +: tri-curry ( x p q r -- p' q' r' ) [ [curry] ] tri@ tri ; inline + +: bi-curry* ( x y p q -- p' q' ) [ [curry] ] bi@ bi* ; inline + +: tri-curry* ( x y z p q r -- p' q' r' ) [ [curry] ] tri@ tri* ; inline + +: bi-curry@ ( x y q -- p' q' ) [curry] bi@ ; inline + +: tri-curry@ ( x y z q -- p' q' r' ) [curry] tri@ ; inline + +! Booleans +: not ( obj -- ? ) [ f ] [ t ] if ; inline + +: and ( obj1 obj2 -- ? ) over ? ; inline + +: >boolean ( obj -- ? ) [ t ] [ f ] if ; inline + +: or ( obj1 obj2 -- ? ) dupd ? ; inline + +: xor ( obj1 obj2 -- ? ) [ f swap ? ] when* ; inline + +: both? ( x y quot -- ? ) bi@ and ; inline + +: either? ( x y quot -- ? ) bi@ or ; inline + +: most ( x y quot -- z ) + [ 2dup ] dip call [ drop ] [ nip ] if ; inline + +! Loops +: loop ( pred: ( -- ? ) -- ) + [ call ] keep [ loop ] curry when ; inline recursive + +: do ( pred body tail -- pred body tail ) + over 3dip ; inline + +: while ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- ) + [ pick 3dip [ do while ] 3curry ] keep if ; inline recursive + +: until ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- ) + [ [ not ] compose ] 2dip while ; inline + ! Object protocol GENERIC: hashcode* ( depth obj -- code ) @@ -171,50 +234,6 @@ GENERIC: new ( class -- tuple ) GENERIC: boa ( ... class -- tuple ) -! Quotation building -: 2curry ( obj1 obj2 quot -- curry ) - curry curry ; inline - -: 3curry ( obj1 obj2 obj3 quot -- curry ) - curry curry curry ; inline - -: with ( param obj quot -- obj curry ) - swapd [ swapd call ] 2curry ; inline - -: prepose ( quot1 quot2 -- compose ) - swap compose ; inline - -! Booleans -: not ( obj -- ? ) [ f ] [ t ] if ; inline - -: and ( obj1 obj2 -- ? ) over ? ; inline - -: >boolean ( obj -- ? ) [ t ] [ f ] if ; inline - -: or ( obj1 obj2 -- ? ) dupd ? ; inline - -: xor ( obj1 obj2 -- ? ) [ f swap ? ] when* ; inline - -: both? ( x y quot -- ? ) bi@ and ; inline - -: either? ( x y quot -- ? ) bi@ or ; inline - -: most ( x y quot -- z ) - [ 2dup ] dip call [ drop ] [ nip ] if ; inline - -! Loops -: loop ( pred: ( -- ? ) -- ) - dup slip swap [ loop ] [ drop ] if ; inline recursive - -: do ( pred body tail -- pred body tail ) - over 3dip ; inline - -: while ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- ) - [ pick 3dip [ do while ] 3curry ] keep if ; inline recursive - -: until ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- ) - [ [ not ] compose ] 2dip while ; inline - ! Error handling -- defined early so that other files can ! throw errors before continuations are loaded : throw ( error -- * ) 5 getenv [ die ] or 1 (throw) ; From cf9e7d1e75e748319123f5addaabc90f4594e50c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 12 Feb 2009 04:25:33 -0600 Subject: [PATCH 07/14] Add byte-order slot to image tuple; rename to load-image, add for making images from scratch --- basis/images/bitmap/bitmap.factor | 10 +++++----- basis/images/images.factor | 10 +++------- basis/images/loader/loader.factor | 5 +---- basis/images/tiff/tiff.factor | 3 ++- extra/images/viewer/viewer.factor | 6 +++--- 5 files changed, 14 insertions(+), 20 deletions(-) diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor index 5530fa12b7..c9bb15192b 100755 --- a/basis/images/bitmap/bitmap.factor +++ b/basis/images/bitmap/bitmap.factor @@ -1,10 +1,9 @@ ! Copyright (C) 2007, 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien alien.c-types arrays byte-arrays columns -combinators fry grouping io io.binary io.encodings.binary -io.files kernel libc macros math math.bitwise math.functions -namespaces opengl opengl.gl prettyprint sequences strings -summary ui ui.gadgets.panes images ; +combinators fry grouping io io.binary io.encodings.binary io.files +kernel macros math math.bitwise math.functions namespaces sequences +strings images endian summary ; IN: images.bitmap TUPLE: bitmap-image < image ; @@ -106,8 +105,9 @@ ERROR: unknown-component-order bitmap ; { [ [ width>> ] [ height>> ] bi 2array ] [ bitmap>component-order ] + [ drop little-endian ] ! XXX [ buffer>> ] - } cleave bitmap-image new-image ; + } cleave bitmap-image boa ; M: bitmap-image load-image* ( path bitmap -- bitmap-image ) drop load-bitmap >image ; diff --git a/basis/images/images.factor b/basis/images/images.factor index 5fdc9ee5e9..a2d90cc131 100644 --- a/basis/images/images.factor +++ b/basis/images/images.factor @@ -5,7 +5,9 @@ IN: images SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR ; -TUPLE: image dim component-order bitmap ; +TUPLE: image dim component-order byte-order bitmap ; + +: ( -- image ) image new ; inline GENERIC: load-image* ( path tuple -- image ) @@ -38,9 +40,3 @@ M: image normalize-scan-line-order ; : normalize-image ( image -- image ) normalize-component-order normalize-scan-line-order ; - -: new-image ( dim component-order bitmap class -- image ) - new - swap >>bitmap - swap >>component-order - swap >>dim ; inline diff --git a/basis/images/loader/loader.factor b/basis/images/loader/loader.factor index 7aeba9f24a..9e3f901269 100644 --- a/basis/images/loader/loader.factor +++ b/basis/images/loader/loader.factor @@ -15,7 +15,4 @@ ERROR: unknown-image-extension extension ; } case ; : load-image ( path -- image ) - dup image-class new load-image* ; - -: ( path -- image ) - load-image normalize-image ; + dup image-class new load-image* normalize-image ; diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor index dd4319a474..b4daf675f1 100755 --- a/basis/images/tiff/tiff.factor +++ b/basis/images/tiff/tiff.factor @@ -272,8 +272,9 @@ ERROR: unknown-component-order ifd ; { [ [ image-width find-tag ] [ image-length find-tag ] bi 2array ] [ ifd-component-order ] + [ drop big-endian ] ! XXX [ bitmap>> ] - } cleave tiff-image new-image ; + } cleave tiff-image boa ; : tiff>image ( image -- image ) ifds>> [ ifd>image ] map first ; diff --git a/extra/images/viewer/viewer.factor b/extra/images/viewer/viewer.factor index 0795900150..06e4c686f3 100644 --- a/extra/images/viewer/viewer.factor +++ b/extra/images/viewer/viewer.factor @@ -23,15 +23,15 @@ M: image-gadget draw-gadget* ( gadget -- ) swap >>image ; : image-window ( path -- gadget ) - [ dup ] [ open-window ] bi ; + [ load-image dup ] [ open-window ] bi ; GENERIC: image. ( object -- ) : default-image. ( path -- ) gadget. ; -M: string image. ( image -- ) default-image. ; +M: string image. ( image -- ) load-image default-image. ; -M: pathname image. ( image -- ) default-image. ; +M: pathname image. ( image -- ) load-image default-image. ; M: image image. ( image -- ) default-image. ; From facd455e9229d54a916781b1de30549913d61459 Mon Sep 17 00:00:00 2001 From: sheeple Date: Thu, 12 Feb 2009 06:25:07 -0600 Subject: [PATCH 08/14] Working on complex float support in FFI on NetBSD --- basis/alien/structs/structs.factor | 5 +++-- basis/compiler/alien/alien.factor | 2 +- basis/cpu/architecture/architecture.factor | 2 +- basis/cpu/ppc/ppc.factor | 2 +- basis/cpu/x86/32/32.factor | 9 ++++++--- basis/cpu/x86/64/unix/unix.factor | 2 +- basis/cpu/x86/64/winnt/winnt.factor | 3 ++- 7 files changed, 15 insertions(+), 10 deletions(-) diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor index 8ec694198d..9c28b71cc6 100755 --- a/basis/alien/structs/structs.factor +++ b/basis/alien/structs/structs.factor @@ -13,7 +13,8 @@ fields { boxer-quot callable } { unboxer-quot callable } { getter callable } -{ setter callable } ; +{ setter callable } +return-in-registers ; M: struct-type heap-size size>> ; @@ -37,7 +38,7 @@ M: struct-type box-parameter [ %box-large-struct ] [ box-parameter ] if-value-struct ; : if-small-struct ( c-type true false -- ? ) - [ dup struct-small-enough? ] 2dip '[ f swap @ ] if ; inline + [ dup return-struct-in-registers? ] 2dip '[ f swap @ ] if ; inline M: struct-type unbox-return [ %unbox-small-struct ] [ %unbox-large-struct ] if-small-struct ; diff --git a/basis/compiler/alien/alien.factor b/basis/compiler/alien/alien.factor index 4a41014ab2..59901cf79a 100644 --- a/basis/compiler/alien/alien.factor +++ b/basis/compiler/alien/alien.factor @@ -5,7 +5,7 @@ alien.c-types alien.structs cpu.architecture ; IN: compiler.alien : large-struct? ( ctype -- ? ) - dup c-struct? [ struct-small-enough? not ] [ drop f ] if ; + dup c-struct? [ return-struct-in-registers? not ] [ drop f ] if ; : alien-parameters ( params -- seq ) dup parameters>> diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 5670110f04..2c9675426b 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -152,7 +152,7 @@ HOOK: %loop-entry cpu ( -- ) HOOK: small-enough? cpu ( n -- ? ) ! Is this structure small enough to be returned in registers? -HOOK: struct-small-enough? cpu ( c-type -- ? ) +HOOK: return-struct-in-registers? cpu ( c-type -- ? ) ! Do we pass this struct by value or hidden reference? HOOK: value-struct? cpu ( c-type -- ? ) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index b177c71d77..f245bcb7e1 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -659,7 +659,7 @@ M: ppc %callback-value ( ctype -- ) M: ppc small-enough? ( n -- ? ) -32768 32767 between? ; -M: ppc struct-small-enough? ( size -- ? ) drop f ; +M: ppc return-struct-in-registers? ( c-type -- ? ) drop f ; M: ppc %box-small-struct drop "No small structs" throw ; diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index affd39ffc5..c409cfb164 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -48,9 +48,12 @@ M: x86.32 %alien-invoke (CALL) rel-dlsym ; M: x86.32 %alien-invoke-tail (JMP) rel-dlsym ; -M: x86.32 struct-small-enough? ( size -- ? ) - heap-size { 1 2 4 8 } member? - os { linux netbsd solaris } member? not and ; +M: x86.32 return-struct-in-registers? ( c-type -- ? ) + c-type + [ return-in-registers?>> ] + [ heap-size { 1 2 4 8 } member? ] bi + os { linux netbsd solaris } member? not + and and ; : struct-return@ ( n -- operand ) [ next-stack@ ] [ stack-frame get params>> stack@ ] if* ; diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor index f5fb5b9640..eea960d03d 100644 --- a/basis/cpu/x86/64/unix/unix.factor +++ b/basis/cpu/x86/64/unix/unix.factor @@ -44,7 +44,7 @@ M: struct-type flatten-value-type ( type -- seq ) flatten-small-struct ] if ; -M: x86.64 struct-small-enough? ( size -- ? ) +M: x86.64 return-struct-in-registers? ( c-type -- ? ) heap-size 2 cells <= ; M: x86.64 dummy-stack-params? f ; diff --git a/basis/cpu/x86/64/winnt/winnt.factor b/basis/cpu/x86/64/winnt/winnt.factor index 4c6af6c1e7..8091be65ae 100644 --- a/basis/cpu/x86/64/winnt/winnt.factor +++ b/basis/cpu/x86/64/winnt/winnt.factor @@ -10,7 +10,8 @@ M: float-regs param-regs drop { XMM0 XMM1 XMM2 XMM3 } ; M: x86.64 reserved-area-size 4 cells ; -M: x86.64 struct-small-enough? heap-size { 1 2 4 8 } member? ; +M: x86.64 return-struct-in-registers? ( c-type -- ? ) + heap-size { 1 2 4 8 } member? ; M: x86.64 value-struct? heap-size { 1 2 4 8 } member? ; From 3c1ddde1f903f9feab002865bd6817677dbc9d23 Mon Sep 17 00:00:00 2001 From: sheeple Date: Thu, 12 Feb 2009 08:10:21 -0600 Subject: [PATCH 09/14] Fix complex float support on NetBSD --- basis/alien/complex/complex.factor | 11 +++++++++-- basis/alien/structs/structs.factor | 4 +++- basis/cpu/x86/32/32.factor | 2 +- 3 files changed, 13 insertions(+), 4 deletions(-) diff --git a/basis/alien/complex/complex.factor b/basis/alien/complex/complex.factor index 60a84b9394..079ad57aa5 100644 --- a/basis/alien/complex/complex.factor +++ b/basis/alien/complex/complex.factor @@ -1,6 +1,13 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.complex.functor sequences kernel ; +USING: alien.c-types alien.complex.functor accessors +sequences kernel ; IN: alien.complex -<< { "float" "double" } [ dup "complex-" prepend define-complex-type ] each >> \ No newline at end of file +<< +{ "float" "double" } [ dup "complex-" prepend define-complex-type ] each + +! This overrides the fact that small structures are never returned +! in registers on NetBSD, Linux and Solaris running on 32-bit x86. +"complex-float" c-type t >>return-in-registers? drop + >> diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor index 9c28b71cc6..3e26e4fb39 100755 --- a/basis/alien/structs/structs.factor +++ b/basis/alien/structs/structs.factor @@ -14,7 +14,9 @@ fields { unboxer-quot callable } { getter callable } { setter callable } -return-in-registers ; +return-in-registers? ; + +M: struct-type c-type ; M: struct-type heap-size size>> ; diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index c409cfb164..f881792ac6 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -53,7 +53,7 @@ M: x86.32 return-struct-in-registers? ( c-type -- ? ) [ return-in-registers?>> ] [ heap-size { 1 2 4 8 } member? ] bi os { linux netbsd solaris } member? not - and and ; + and or ; : struct-return@ ( n -- operand ) [ next-stack@ ] [ stack-frame get params>> stack@ ] if* ; From 76ae3fd22448f7166e19f7f594f24794bed0c8ae Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 12 Feb 2009 08:39:52 -0600 Subject: [PATCH 10/14] Fix compile error in ui.render.test; images API changed... --- extra/ui/render/test/test.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/ui/render/test/test.factor b/extra/ui/render/test/test.factor index dcbc5b9600..bd3c082652 100755 --- a/extra/ui/render/test/test.factor +++ b/extra/ui/render/test/test.factor @@ -4,7 +4,7 @@ USING: accessors colors arrays kernel sequences math byte-arrays namespaces grouping fry cap images.bitmap ui.gadgets ui.gadgets.packs ui.gadgets.borders ui.gadgets.grids ui.gadgets.grid-lines ui.gadgets.labels ui.gadgets.buttons -ui.render ui opengl opengl.gl images ; +ui.render ui opengl opengl.gl images images.loader ; IN: ui.render.test SINGLETON: line-test @@ -38,7 +38,7 @@ SYMBOL: render-output screenshot [ render-output set-global ] [ - "resource:extra/ui/render/test/reference.bmp" + "resource:extra/ui/render/test/reference.bmp" load-image bitmap= "is perfect" "needs work" ? "Your UI rendering " prepend message-window From 2c88d339d0c70fa965350a4d015d600fc0f5acff Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 12 Feb 2009 09:20:32 -0600 Subject: [PATCH 11/14] Improve type inference for struct returns --- basis/alien/structs/structs.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor index 8ec694198d..234ad64a34 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 ; +quotations byte-arrays ; IN: alien.structs TUPLE: struct-type @@ -17,7 +17,7 @@ fields M: struct-type heap-size size>> ; -M: struct-type c-type-class drop object ; +M: struct-type c-type-class drop byte-array ; M: struct-type c-type-align align>> ; From 489bb32a9848baf04c336c03c08a16c0c445847e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 12 Feb 2009 09:48:50 -0600 Subject: [PATCH 12/14] Fix potential load order issue with alien.complex; it used a slot defined in alien.structs but didn't reference that file by name --- basis/alien/complex/complex.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/alien/complex/complex.factor b/basis/alien/complex/complex.factor index 079ad57aa5..c80ead73f0 100644 --- a/basis/alien/complex/complex.factor +++ b/basis/alien/complex/complex.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types alien.complex.functor accessors +USING: alien.c-types alien.structs alien.complex.functor accessors sequences kernel ; IN: alien.complex From d46764d34612c2232edd78a424d74080171bb7bc Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 12 Feb 2009 16:36:29 -0600 Subject: [PATCH 13/14] use CONSTANT: in db --- basis/db/postgresql/ffi/ffi.factor | 98 +++++++++++++++--------------- basis/db/sqlite/ffi/ffi.factor | 96 ++++++++++++++--------------- 2 files changed, 97 insertions(+), 97 deletions(-) diff --git a/basis/db/postgresql/ffi/ffi.factor b/basis/db/postgresql/ffi/ffi.factor index 4358d7f3de..fc407b06bd 100644 --- a/basis/db/postgresql/ffi/ffi.factor +++ b/basis/db/postgresql/ffi/ffi.factor @@ -11,46 +11,46 @@ IN: db.postgresql.ffi } cond "cdecl" add-library >> ! ConnSatusType -: CONNECTION_OK HEX: 0 ; inline -: CONNECTION_BAD HEX: 1 ; inline -: CONNECTION_STARTED HEX: 2 ; inline -: CONNECTION_MADE HEX: 3 ; inline -: CONNECTION_AWAITING_RESPONSE HEX: 4 ; inline -: CONNECTION_AUTH_OK HEX: 5 ; inline -: CONNECTION_SETENV HEX: 6 ; inline -: CONNECTION_SSL_STARTUP HEX: 7 ; inline -: CONNECTION_NEEDED HEX: 8 ; inline +CONSTANT: CONNECTION_OK HEX: 0 +CONSTANT: CONNECTION_BAD HEX: 1 +CONSTANT: CONNECTION_STARTED HEX: 2 +CONSTANT: CONNECTION_MADE HEX: 3 +CONSTANT: CONNECTION_AWAITING_RESPONSE HEX: 4 +CONSTANT: CONNECTION_AUTH_OK HEX: 5 +CONSTANT: CONNECTION_SETENV HEX: 6 +CONSTANT: CONNECTION_SSL_STARTUP HEX: 7 +CONSTANT: CONNECTION_NEEDED HEX: 8 ! PostgresPollingStatusType -: PGRES_POLLING_FAILED HEX: 0 ; inline -: PGRES_POLLING_READING HEX: 1 ; inline -: PGRES_POLLING_WRITING HEX: 2 ; inline -: PGRES_POLLING_OK HEX: 3 ; inline -: PGRES_POLLING_ACTIVE HEX: 4 ; inline +CONSTANT: PGRES_POLLING_FAILED HEX: 0 +CONSTANT: PGRES_POLLING_READING HEX: 1 +CONSTANT: PGRES_POLLING_WRITING HEX: 2 +CONSTANT: PGRES_POLLING_OK HEX: 3 +CONSTANT: PGRES_POLLING_ACTIVE HEX: 4 ! ExecStatusType; -: PGRES_EMPTY_QUERY HEX: 0 ; inline -: PGRES_COMMAND_OK HEX: 1 ; inline -: PGRES_TUPLES_OK HEX: 2 ; inline -: PGRES_COPY_OUT HEX: 3 ; inline -: PGRES_COPY_IN HEX: 4 ; inline -: PGRES_BAD_RESPONSE HEX: 5 ; inline -: PGRES_NONFATAL_ERROR HEX: 6 ; inline -: PGRES_FATAL_ERROR HEX: 7 ; inline +CONSTANT: PGRES_EMPTY_QUERY HEX: 0 +CONSTANT: PGRES_COMMAND_OK HEX: 1 +CONSTANT: PGRES_TUPLES_OK HEX: 2 +CONSTANT: PGRES_COPY_OUT HEX: 3 +CONSTANT: PGRES_COPY_IN HEX: 4 +CONSTANT: PGRES_BAD_RESPONSE HEX: 5 +CONSTANT: PGRES_NONFATAL_ERROR HEX: 6 +CONSTANT: PGRES_FATAL_ERROR HEX: 7 ! PGTransactionStatusType; -: PQTRANS_IDLE HEX: 0 ; inline -: PQTRANS_ACTIVE HEX: 1 ; inline -: PQTRANS_INTRANS HEX: 2 ; inline -: PQTRANS_INERROR HEX: 3 ; inline -: PQTRANS_UNKNOWN HEX: 4 ; inline +CONSTANT: PQTRANS_IDLE HEX: 0 +CONSTANT: PQTRANS_ACTIVE HEX: 1 +CONSTANT: PQTRANS_INTRANS HEX: 2 +CONSTANT: PQTRANS_INERROR HEX: 3 +CONSTANT: PQTRANS_UNKNOWN HEX: 4 ! PGVerbosity; -: PQERRORS_TERSE HEX: 0 ; inline -: PQERRORS_DEFAULT HEX: 1 ; inline -: PQERRORS_VERBOSE HEX: 2 ; inline +CONSTANT: PQERRORS_TERSE HEX: 0 +CONSTANT: PQERRORS_DEFAULT HEX: 1 +CONSTANT: PQERRORS_VERBOSE HEX: 2 -: InvalidOid 0 ; inline +CONSTANT: InvalidOid 0 TYPEDEF: int ConnStatusType TYPEDEF: int ExecStatusType @@ -348,21 +348,21 @@ FUNCTION: int PQdsplen ( uchar* s, int encoding ) ; FUNCTION: int PQenv2encoding ( ) ; ! From git, include/catalog/pg_type.h -: BOOL-OID 16 ; inline -: BYTEA-OID 17 ; inline -: CHAR-OID 18 ; inline -: NAME-OID 19 ; inline -: INT8-OID 20 ; inline -: INT2-OID 21 ; inline -: INT4-OID 23 ; inline -: TEXT-OID 23 ; inline -: OID-OID 26 ; inline -: FLOAT4-OID 700 ; inline -: FLOAT8-OID 701 ; inline -: VARCHAR-OID 1043 ; inline -: DATE-OID 1082 ; inline -: TIME-OID 1083 ; inline -: TIMESTAMP-OID 1114 ; inline -: TIMESTAMPTZ-OID 1184 ; inline -: INTERVAL-OID 1186 ; inline -: NUMERIC-OID 1700 ; inline +CONSTANT: BOOL-OID 16 +CONSTANT: BYTEA-OID 17 +CONSTANT: CHAR-OID 18 +CONSTANT: NAME-OID 19 +CONSTANT: INT8-OID 20 +CONSTANT: INT2-OID 21 +CONSTANT: INT4-OID 23 +CONSTANT: TEXT-OID 23 +CONSTANT: OID-OID 26 +CONSTANT: FLOAT4-OID 700 +CONSTANT: FLOAT8-OID 701 +CONSTANT: VARCHAR-OID 1043 +CONSTANT: DATE-OID 1082 +CONSTANT: TIME-OID 1083 +CONSTANT: TIMESTAMP-OID 1114 +CONSTANT: TIMESTAMPTZ-OID 1184 +CONSTANT: INTERVAL-OID 1186 +CONSTANT: NUMERIC-OID 1700 diff --git a/basis/db/sqlite/ffi/ffi.factor b/basis/db/sqlite/ffi/ffi.factor index 9f033a1d3c..341995634e 100644 --- a/basis/db/sqlite/ffi/ffi.factor +++ b/basis/db/sqlite/ffi/ffi.factor @@ -13,33 +13,33 @@ IN: db.sqlite.ffi } cond "cdecl" add-library >> ! Return values from sqlite functions -: SQLITE_OK 0 ; inline ! Successful result -: SQLITE_ERROR 1 ; inline ! SQL error or missing database -: SQLITE_INTERNAL 2 ; inline ! An internal logic error in SQLite -: SQLITE_PERM 3 ; inline ! Access permission denied -: SQLITE_ABORT 4 ; inline ! Callback routine requested an abort -: SQLITE_BUSY 5 ; inline ! The database file is locked -: SQLITE_LOCKED 6 ; inline ! A table in the database is locked -: SQLITE_NOMEM 7 ; inline ! A malloc() failed -: SQLITE_READONLY 8 ; inline ! Attempt to write a readonly database -: SQLITE_INTERRUPT 9 ; inline ! Operation terminated by sqlite_interrupt() -: SQLITE_IOERR 10 ; inline ! Some kind of disk I/O error occurred -: SQLITE_CORRUPT 11 ; inline ! The database disk image is malformed -: SQLITE_NOTFOUND 12 ; inline ! (Internal Only) Table or record not found -: SQLITE_FULL 13 ; inline ! Insertion failed because database is full -: SQLITE_CANTOPEN 14 ; inline ! Unable to open the database file -: SQLITE_PROTOCOL 15 ; inline ! Database lock protocol error -: SQLITE_EMPTY 16 ; inline ! (Internal Only) Database table is empty -: SQLITE_SCHEMA 17 ; inline ! The database schema changed -: SQLITE_TOOBIG 18 ; inline ! Too much data for one row of a table -: SQLITE_CONSTRAINT 19 ; inline ! Abort due to contraint violation -: SQLITE_MISMATCH 20 ; inline ! Data type mismatch -: SQLITE_MISUSE 21 ; inline ! Library used incorrectly -: SQLITE_NOLFS 22 ; inline ! Uses OS features not supported on host -: SQLITE_AUTH 23 ; inline ! Authorization denied -: SQLITE_FORMAT 24 ; inline ! Auxiliary database format error -: SQLITE_RANGE 25 ; inline ! 2nd parameter to sqlite3_bind out of range -: SQLITE_NOTADB 26 ; inline ! File opened that is not a database file +CONSTANT: SQLITE_OK 0 ! Successful result +CONSTANT: SQLITE_ERROR 1 ! SQL error or missing database +CONSTANT: SQLITE_INTERNAL 2 ! An internal logic error in SQLite +CONSTANT: SQLITE_PERM 3 ! Access permission denied +CONSTANT: SQLITE_ABORT 4 ! Callback routine requested an abort +CONSTANT: SQLITE_BUSY 5 ! The database file is locked +CONSTANT: SQLITE_LOCKED 6 ! A table in the database is locked +CONSTANT: SQLITE_NOMEM 7 ! A malloc() failed +CONSTANT: SQLITE_READONLY 8 ! Attempt to write a readonly database +CONSTANT: SQLITE_INTERRUPT 9 ! Operation terminated by sqlite_interrupt() +CONSTANT: SQLITE_IOERR 10 ! Some kind of disk I/O error occurred +CONSTANT: SQLITE_CORRUPT 11 ! The database disk image is malformed +CONSTANT: SQLITE_NOTFOUND 12 ! (Internal Only) Table or record not found +CONSTANT: SQLITE_FULL 13 ! Insertion failed because database is full +CONSTANT: SQLITE_CANTOPEN 14 ! Unable to open the database file +CONSTANT: SQLITE_PROTOCOL 15 ! Database lock protocol error +CONSTANT: SQLITE_EMPTY 16 ! (Internal Only) Database table is empty +CONSTANT: SQLITE_SCHEMA 17 ! The database schema changed +CONSTANT: SQLITE_TOOBIG 18 ! Too much data for one row of a table +CONSTANT: SQLITE_CONSTRAINT 19 ! Abort due to contraint violation +CONSTANT: SQLITE_MISMATCH 20 ! Data type mismatch +CONSTANT: SQLITE_MISUSE 21 ! Library used incorrectly +CONSTANT: SQLITE_NOLFS 22 ! Uses OS features not supported on host +CONSTANT: SQLITE_AUTH 23 ! Authorization denied +CONSTANT: SQLITE_FORMAT 24 ! Auxiliary database format error +CONSTANT: SQLITE_RANGE 25 ! 2nd parameter to sqlite3_bind out of range +CONSTANT: SQLITE_NOTADB 26 ! File opened that is not a database file : sqlite-error-messages ( -- seq ) { "Successful result" @@ -72,32 +72,32 @@ IN: db.sqlite.ffi } ; ! Return values from sqlite3_step -: SQLITE_ROW 100 ; inline -: SQLITE_DONE 101 ; inline +CONSTANT: SQLITE_ROW 100 +CONSTANT: SQLITE_DONE 101 ! Return values from the sqlite3_column_type function -: SQLITE_INTEGER 1 ; inline -: SQLITE_FLOAT 2 ; inline -: SQLITE_TEXT 3 ; inline -: SQLITE_BLOB 4 ; inline -: SQLITE_NULL 5 ; inline +CONSTANT: SQLITE_INTEGER 1 +CONSTANT: SQLITE_FLOAT 2 +CONSTANT: SQLITE_TEXT 3 +CONSTANT: SQLITE_BLOB 4 +CONSTANT: SQLITE_NULL 5 ! Values for the 'destructor' parameter of the 'bind' routines. -: SQLITE_STATIC 0 ; inline -: SQLITE_TRANSIENT -1 ; inline +CONSTANT: SQLITE_STATIC 0 +CONSTANT: SQLITE_TRANSIENT -1 -: SQLITE_OPEN_READONLY HEX: 00000001 ; inline -: SQLITE_OPEN_READWRITE HEX: 00000002 ; inline -: SQLITE_OPEN_CREATE HEX: 00000004 ; inline -: SQLITE_OPEN_DELETEONCLOSE HEX: 00000008 ; inline -: SQLITE_OPEN_EXCLUSIVE HEX: 00000010 ; inline -: SQLITE_OPEN_MAIN_DB HEX: 00000100 ; inline -: SQLITE_OPEN_TEMP_DB HEX: 00000200 ; inline -: SQLITE_OPEN_TRANSIENT_DB HEX: 00000400 ; inline -: SQLITE_OPEN_MAIN_JOURNAL HEX: 00000800 ; inline -: SQLITE_OPEN_TEMP_JOURNAL HEX: 00001000 ; inline -: SQLITE_OPEN_SUBJOURNAL HEX: 00002000 ; inline -: SQLITE_OPEN_MASTER_JOURNAL HEX: 00004000 ; inline +CONSTANT: SQLITE_OPEN_READONLY HEX: 00000001 +CONSTANT: SQLITE_OPEN_READWRITE HEX: 00000002 +CONSTANT: SQLITE_OPEN_CREATE HEX: 00000004 +CONSTANT: SQLITE_OPEN_DELETEONCLOSE HEX: 00000008 +CONSTANT: SQLITE_OPEN_EXCLUSIVE HEX: 00000010 +CONSTANT: SQLITE_OPEN_MAIN_DB HEX: 00000100 +CONSTANT: SQLITE_OPEN_TEMP_DB HEX: 00000200 +CONSTANT: SQLITE_OPEN_TRANSIENT_DB HEX: 00000400 +CONSTANT: SQLITE_OPEN_MAIN_JOURNAL HEX: 00000800 +CONSTANT: SQLITE_OPEN_TEMP_JOURNAL HEX: 00001000 +CONSTANT: SQLITE_OPEN_SUBJOURNAL HEX: 00002000 +CONSTANT: SQLITE_OPEN_MASTER_JOURNAL HEX: 00004000 TYPEDEF: void sqlite3 TYPEDEF: void sqlite3_stmt From 1f6c50fd9192a2614d88830c5c04eb0d18cab1e3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 12 Feb 2009 16:40:45 -0600 Subject: [PATCH 14/14] use constant in tar, remove ignore-errors --- extra/tar/tar.factor | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index a4413c07b3..37c022fe43 100755 --- a/extra/tar/tar.factor +++ b/extra/tar/tar.factor @@ -5,8 +5,8 @@ system tools.hexdump io.encodings.binary summary accessors io.backend byte-arrays ; IN: tar -: zero-checksum 256 ; inline -: block-size 512 ; inline +CONSTANT: zero-checksum 256 +CONSTANT: block-size 512 TUPLE: tar-header name mode uid gid size mtime checksum typeflag linkname magic version uname gname devmajor devminor prefix ; @@ -89,8 +89,7 @@ M: unknown-typeflag summary ( obj -- str ) ! Symlink : typeflag-2 ( header -- ) - [ name>> ] [ linkname>> ] bi - [ make-link ] 2curry ignore-errors ; + [ name>> ] [ linkname>> ] bi make-link ; ! character special : typeflag-3 ( header -- ) unknown-typeflag ;