From fefea85514bd5b3caba1514eb16b16e6ff64d51d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 30 Jun 2009 14:56:58 -0500 Subject: [PATCH 1/4] working on imagebin --- extra/webapps/imagebin/imagebin.factor | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) diff --git a/extra/webapps/imagebin/imagebin.factor b/extra/webapps/imagebin/imagebin.factor index f347377d95..7c63c51eee 100755 --- a/extra/webapps/imagebin/imagebin.factor +++ b/extra/webapps/imagebin/imagebin.factor @@ -1,10 +1,15 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel furnace.actions html.forms -http.server.dispatchers db db.tuples db.types urls -furnace.redirection multiline http namespaces ; +USING: accessors db db.tuples db.types furnace.actions +furnace.redirection html.forms http http.server +http.server.dispatchers io.directories io.pathnames kernel +multiline namespaces urls ; IN: webapps.imagebin +SYMBOL: image-directory + +image-directory [ "resource:images" ] initialize + TUPLE: imagebin < dispatcher ; TUPLE: image id path ; @@ -16,24 +21,32 @@ image "IMAGE" { : ( -- action ) + image-directory get >>temporary-directory { imagebin "uploaded-image" } >>template ; SYMBOL: my-post-data : ( -- action ) { imagebin "upload-image" } >>template + image-directory get >>temporary-directory [ - - ! request get post-data>> my-post-data set-global + "file1" param [ + temporary-path>> image-directory get move-file + ] when* ! image new ! "file" value ! insert-tuple "uploaded-image" ] >>submit ; +: initialize-image-directory ( -- ) + image-directory get make-directories ; + : ( -- responder ) imagebin new-dispatcher "" add-responder "upload-image" add-responder "uploaded-image" add-responder ; +initialize-image-directory + main-responder set-global From e8390ebace0233bd87035e041c482b8f310bed34 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 30 Jun 2009 17:39:36 -0500 Subject: [PATCH 2/4] imagebin does the right thing now --- extra/webapps/imagebin/imagebin.factor | 55 ++++++++++------------- extra/webapps/imagebin/uploaded-image.xml | 2 +- 2 files changed, 25 insertions(+), 32 deletions(-) diff --git a/extra/webapps/imagebin/imagebin.factor b/extra/webapps/imagebin/imagebin.factor index 7c63c51eee..bb8720466c 100755 --- a/extra/webapps/imagebin/imagebin.factor +++ b/extra/webapps/imagebin/imagebin.factor @@ -1,52 +1,45 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors db db.tuples db.types furnace.actions -furnace.redirection html.forms http http.server -http.server.dispatchers io.directories io.pathnames kernel -multiline namespaces urls ; +USING: accessors furnace.actions furnace.redirection +html.forms http http.server http.server.dispatchers +io.directories io.encodings.utf8 io.files io.pathnames +kernel math.parser multiline namespaces sequences urls ; IN: webapps.imagebin -SYMBOL: image-directory - -image-directory [ "resource:images" ] initialize - -TUPLE: imagebin < dispatcher ; - -TUPLE: image id path ; - -image "IMAGE" { - { "id" "ID" INTEGER +db-assigned-id+ } - { "path" "PATH" { VARCHAR 256 } +not-null+ } -} define-persistent +TUPLE: imagebin < dispatcher path n ; : ( -- action ) - image-directory get >>temporary-directory { imagebin "uploaded-image" } >>template ; -SYMBOL: my-post-data +: next-image-path ( -- path ) + imagebin get + [ path>> ] [ n>> number>string ] bi append-path ; + +M: imagebin call-responder* + [ imagebin set ] [ call-next-method ] bi ; + +: move-image ( mime-file -- ) + next-image-path + [ [ temporary-path>> ] dip move-file ] + [ [ filename>> ] dip ".txt" append utf8 set-file-contents ] 2bi ; + : ( -- action ) { imagebin "upload-image" } >>template - image-directory get >>temporary-directory [ - "file1" param [ - temporary-path>> image-directory get move-file - ] when* - ! image new - ! "file" value - ! insert-tuple + "file1" param [ move-image ] when* + "file2" param [ move-image ] when* + "file3" param [ move-image ] when* "uploaded-image" ] >>submit ; -: initialize-image-directory ( -- ) - image-directory get make-directories ; - -: ( -- responder ) +: ( image-directory -- responder ) imagebin new-dispatcher + swap [ make-directories ] [ >>path ] bi + 0 >>n "" add-responder "upload-image" add-responder "uploaded-image" add-responder ; -initialize-image-directory - main-responder set-global +"resource:images" main-responder set-global diff --git a/extra/webapps/imagebin/uploaded-image.xml b/extra/webapps/imagebin/uploaded-image.xml index 903be5cca4..79dfabc924 100644 --- a/extra/webapps/imagebin/uploaded-image.xml +++ b/extra/webapps/imagebin/uploaded-image.xml @@ -2,6 +2,6 @@ Uploaded -hi from uploaded-image +You uploaded something! From 97cd0d584e9c270795fe7ce932e5016e7b044e2f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 30 Jun 2009 18:47:24 -0500 Subject: [PATCH 3/4] make commutative operations with immediates output the same IR --- .../cfg/intrinsics/fixnum/fixnum.factor | 43 +++++++++++++------ .../compiler/cfg/intrinsics/intrinsics.factor | 10 ++--- 2 files changed, 36 insertions(+), 17 deletions(-) diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor index cb5f2e926d..a93fa5d902 100644 --- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor +++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor @@ -18,13 +18,14 @@ IN: compiler.cfg.intrinsics.fixnum 0 cc= ^^compare-imm ds-push ; -: (emit-fixnum-imm-op) ( infos insn -- dst ) - ds-drop - [ ds-pop ] - [ second literal>> [ tag-fixnum ] [ \ f tag-number ] if* ] - [ ] - tri* - call ; inline +: tag-literal ( n -- tagged ) + literal>> [ tag-fixnum ] [ \ f tag-number ] if* ; + +: emit-fixnum-imm-op1 ( infos insn -- dst ) + [ ds-pop ds-drop ] [ first tag-literal ] [ ] tri* call ; inline + +: emit-fixnum-imm-op2 ( infos insn -- dst ) + [ ds-drop ds-pop ] [ second tag-literal ] [ ] tri* call ; inline : (emit-fixnum-op) ( insn -- dst ) [ 2inputs ] dip call ; inline @@ -32,9 +33,22 @@ IN: compiler.cfg.intrinsics.fixnum :: emit-fixnum-op ( node insn imm-insn -- ) [let | infos [ node node-input-infos ] | infos second value-info-small-tagged? - [ infos imm-insn (emit-fixnum-imm-op) ] - [ insn (emit-fixnum-op) ] - if + [ infos imm-insn emit-fixnum-imm-op2 ] + [ insn (emit-fixnum-op) ] if + ds-push + ] ; inline + +:: emit-commutative-fixnum-op ( node insn imm-insn -- ) + [let | infos [ node node-input-infos ] | + infos first value-info-small-tagged? + [ infos imm-insn emit-fixnum-imm-op1 ] + [ + infos second value-info-small-tagged? [ + infos imm-insn emit-fixnum-imm-op2 + ] [ + insn (emit-fixnum-op) + ] if + ] if ds-push ] ; inline @@ -69,9 +83,14 @@ IN: compiler.cfg.intrinsics.fixnum [ (emit-fixnum*fast-imm) ] [ drop (emit-fixnum*fast) ] if ds-push ; +: (emit-fixnum-comparison) ( cc -- quot1 quot2 ) + [ ^^compare ] [ ^^compare-imm ] bi-curry ; inline + +: emit-eq ( node cc -- ) + (emit-fixnum-comparison) emit-commutative-fixnum-op ; + : emit-fixnum-comparison ( node cc -- ) - [ ^^compare ] [ ^^compare-imm ] bi-curry - emit-fixnum-op ; + (emit-fixnum-comparison) emit-fixnum-op ; : emit-bignum>fixnum ( -- ) ds-pop ^^bignum>integer ^^tag-fixnum ds-push ; diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index ec819f9440..15c9c0cef3 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -103,11 +103,11 @@ IN: compiler.cfg.intrinsics { \ math.private:fixnum+ [ drop [ ##fixnum-add ] [ ##fixnum-add-tail ] emit-fixnum-overflow-op ] } { \ math.private:fixnum- [ drop [ ##fixnum-sub ] [ ##fixnum-sub-tail ] emit-fixnum-overflow-op ] } { \ math.private:fixnum* [ drop [ i i ##fixnum-mul ] [ i i ##fixnum-mul-tail ] emit-fixnum-overflow-op ] } - { \ math.private:fixnum+fast [ [ ^^add ] [ ^^add-imm ] emit-fixnum-op iterate-next ] } + { \ math.private:fixnum+fast [ [ ^^add ] [ ^^add-imm ] emit-commutative-fixnum-op iterate-next ] } { \ math.private:fixnum-fast [ [ ^^sub ] [ ^^sub-imm ] emit-fixnum-op iterate-next ] } - { \ math.private:fixnum-bitand [ [ ^^and ] [ ^^and-imm ] emit-fixnum-op iterate-next ] } - { \ math.private:fixnum-bitor [ [ ^^or ] [ ^^or-imm ] emit-fixnum-op iterate-next ] } - { \ math.private:fixnum-bitxor [ [ ^^xor ] [ ^^xor-imm ] emit-fixnum-op iterate-next ] } + { \ math.private:fixnum-bitand [ [ ^^and ] [ ^^and-imm ] emit-commutative-fixnum-op iterate-next ] } + { \ math.private:fixnum-bitor [ [ ^^or ] [ ^^or-imm ] emit-commutative-fixnum-op iterate-next ] } + { \ math.private:fixnum-bitxor [ [ ^^xor ] [ ^^xor-imm ] emit-commutative-fixnum-op iterate-next ] } { \ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast iterate-next ] } { \ math.private:fixnum-bitnot [ drop emit-fixnum-bitnot iterate-next ] } { \ math.integers.private:fixnum-log2 [ drop emit-fixnum-log2 iterate-next ] } @@ -116,7 +116,7 @@ IN: compiler.cfg.intrinsics { \ math.private:fixnum<= [ cc<= emit-fixnum-comparison iterate-next ] } { \ math.private:fixnum>= [ cc>= emit-fixnum-comparison iterate-next ] } { \ math.private:fixnum> [ cc> emit-fixnum-comparison iterate-next ] } - { \ kernel:eq? [ cc= emit-fixnum-comparison iterate-next ] } + { \ kernel:eq? [ cc= emit-eq iterate-next ] } { \ math.private:bignum>fixnum [ drop emit-bignum>fixnum iterate-next ] } { \ math.private:fixnum>bignum [ drop emit-fixnum>bignum iterate-next ] } { \ math.private:float+ [ drop [ ^^add-float ] emit-float-op iterate-next ] } From 2cd202d1752c87f17799c6e02075e4878fa1245e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 30 Jun 2009 18:48:52 -0500 Subject: [PATCH 4/4] remove duplicate using --- basis/compiler/cfg/optimizer/optimizer-tests.factor | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/basis/compiler/cfg/optimizer/optimizer-tests.factor b/basis/compiler/cfg/optimizer/optimizer-tests.factor index b95a8c79ea..ee601f2337 100644 --- a/basis/compiler/cfg/optimizer/optimizer-tests.factor +++ b/basis/compiler/cfg/optimizer/optimizer-tests.factor @@ -1,6 +1,7 @@ -USING: arrays sequences tools.test compiler.cfg.checker compiler.cfg.debugger -compiler.cfg.def-use sets kernel kernel.private fry slots.private vectors -sequences.private math sbufs math.private slots.private strings ; +USING: arrays sequences tools.test compiler.cfg.checker +compiler.cfg.debugger compiler.cfg.def-use sets kernel +kernel.private fry slots.private vectors sequences.private +math sbufs math.private strings ; IN: compiler.cfg.optimizer.tests ! Miscellaneous tests