From 1c6df27d3ca0992a02a13d184f81047568a3527f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 Jan 2009 00:45:23 -0600 Subject: [PATCH 1/8] Minor documentation fixes --- basis/refs/refs-docs.factor | 2 +- core/sequences/sequences-docs.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/refs/refs-docs.factor b/basis/refs/refs-docs.factor index 0034b7e566..b6f222cce9 100644 --- a/basis/refs/refs-docs.factor +++ b/basis/refs/refs-docs.factor @@ -14,7 +14,7 @@ ARTICLE: "refs" "References to assoc entries" "References to values:" { $subsection value-ref } { $subsection } -"References are used by the inspector." ; +"References are used by the UI inspector." ; ABOUT: "refs" diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 1aeed75470..ea7cf829c4 100644 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -1096,7 +1096,7 @@ HELP: set-fourth HELP: replicate { $values - { "seq" sequence } { "quot" quotation } + { "seq" sequence } { "quot" { $quotation "( -- elt )" } } { "newseq" sequence } } { $description "Calls the quotation for every element of the sequence in order. However, the element is not passed to the quotation -- it is dropped, and the quotation produces an element of its own that is collected into a sequence of the same class as the input sequence." } { $examples From 99cd66496187edf6e2c360c1a4d85475ac7df30e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 21 Jan 2009 15:02:27 -0600 Subject: [PATCH 2/8] better save_image that doesn't corrupt your factor image if you're out of disk space. should throw exception instead of printing error messages if saving fails.. --- vm/image.c | 12 +++++++++++- vm/os-unix.h | 2 ++ vm/os-windows.h | 2 ++ 3 files changed, 15 insertions(+), 1 deletion(-) diff --git a/vm/image.c b/vm/image.c index 5f4492e537..08aae5898c 100755 --- a/vm/image.c +++ b/vm/image.c @@ -112,7 +112,9 @@ bool save_image(const F_CHAR *filename) FILE* file; F_HEADER h; - file = OPEN_WRITE(filename); + F_CHAR temporary_filename[] = "##saving-factor-image##"; + + file = OPEN_WRITE(temporary_filename); if(file == NULL) { print_string("Cannot open image file: "); print_native_string(filename); nl(); @@ -163,6 +165,14 @@ bool save_image(const F_CHAR *filename) return false; } + if(MOVE_FILE_FAILS(temporary_filename, filename)) + { + print_string("Failed to rename tempoarary image file: "); print_string(strerror(errno)); nl(); + if(DELETE_FILE_FAILS(temporary_filename)) + print_string("Failed to clean up temporary image file: "); print_string(strerror(errno)); nl(); + return false; + } + return true; } diff --git a/vm/os-unix.h b/vm/os-unix.h index d2f34b4bc4..9f911acded 100755 --- a/vm/os-unix.h +++ b/vm/os-unix.h @@ -22,6 +22,8 @@ typedef char F_SYMBOL; #define STRCMP strcmp #define STRNCMP strncmp #define STRDUP strdup +#define MOVE_FILE_FAILS(old,new) (rename((old),(new)) < 0) +#define DELETE_FILE_FAILS(old) (unlink((old)) < 0) #define FIXNUM_FORMAT "%ld" #define CELL_FORMAT "%lu" diff --git a/vm/os-windows.h b/vm/os-windows.h index a9c3f6d803..beec7ad37c 100755 --- a/vm/os-windows.h +++ b/vm/os-windows.h @@ -19,6 +19,8 @@ typedef wchar_t F_CHAR; #define STRCMP wcscmp #define STRNCMP wcsncmp #define STRDUP _wcsdup +#define MOVE_FILE_FAILS(old,new) (MoveFile((old),(new)) == 0) +#define DELETE_FILE_FAILS(old) (DeleteFile((old)) == 0) #ifdef WIN64 #define CELL_FORMAT "%Iu" From a9277c71fd734ece4b78f8e915f49cf547709c23 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 21 Jan 2009 18:07:26 -0600 Subject: [PATCH 3/8] fix macosx initialization of executable_path --- vm/factor.c | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/vm/factor.c b/vm/factor.c index b3020e3171..d9042c9455 100755 --- a/vm/factor.c +++ b/vm/factor.c @@ -53,8 +53,7 @@ INLINE bool factor_arg(const F_CHAR* str, const F_CHAR* arg, CELL* value) void init_parameters_from_args(F_PARAMETERS *p, int argc, F_CHAR **argv) { default_parameters(p); - const F_CHAR *executable_path = vm_executable_path(); - p->executable_path = executable_path ? executable_path : argv[0]; + p->executable_path = argv[0]; int i = 0; @@ -106,6 +105,11 @@ void init_factor(F_PARAMETERS *p) /* OS-specific initialization */ early_init(); + const F_CHAR *executable_path = vm_executable_path(); + + if(executable_path) + p->executable_path = executable_path; + if(p->image_path == NULL) p->image_path = default_image_path(); From 3150722c7fe4939653e97b9bf50cc44cc07eefc1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 21 Jan 2009 19:55:25 -0600 Subject: [PATCH 4/8] better http.server that handles multipart data in the same way as regular form data. fix http client for changes --- basis/http/client/client.factor | 28 ++++++++++++++++++++++------ basis/http/http-tests.factor | 2 +- basis/http/http.factor | 9 +++------ basis/http/server/cgi/cgi.factor | 4 ++-- basis/http/server/server.factor | 13 ++++++------- 5 files changed, 34 insertions(+), 22 deletions(-) diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor index fc6e296a4f..f2c0a862eb 100644 --- a/basis/http/client/client.factor +++ b/basis/http/client/client.factor @@ -25,7 +25,7 @@ IN: http.client dup header>> >hashtable over url>> host>> [ over url>> url-host "host" pick set-at ] when over post-data>> [ - [ raw>> length "content-length" pick set-at ] + [ data>> length "content-length" pick set-at ] [ content-type>> "content-type" pick set-at ] bi ] when* @@ -36,19 +36,35 @@ GENERIC: >post-data ( object -- post-data ) M: post-data >post-data ; -M: string >post-data utf8 encode "application/octet-stream" ; +M: string >post-data + utf8 encode + "application/octet-stream" + swap >>data ; -M: byte-array >post-data "application/octet-stream" ; +M: byte-array >post-data + "application/octet-stream" + swap >>data ; -M: assoc >post-data assoc>query ascii encode "application/x-www-form-urlencoded" ; +M: assoc >post-data + "application/x-www-form-urlencoded" + swap >>params ; M: f >post-data ; +: normalize-post-data ( request -- request ) + dup post-data>> [ + dup params>> [ + assoc>query ascii encode >>data + ] when* drop + ] when* ; + : unparse-post-data ( request -- request ) - [ >post-data ] change-post-data ; + [ >post-data ] change-post-data + normalize-post-data ; : write-post-data ( request -- request ) - dup method>> [ "POST" = ] [ "PUT" = ] bi or [ dup post-data>> raw>> write ] when ; + dup method>> [ "POST" = ] [ "PUT" = ] bi or + [ dup post-data>> data>> write ] when ; : write-request ( request -- ) unparse-post-data diff --git a/basis/http/http-tests.factor b/basis/http/http-tests.factor index 92a296c2d3..6fa23b4b1f 100644 --- a/basis/http/http-tests.factor +++ b/basis/http/http-tests.factor @@ -35,7 +35,7 @@ blah { method "POST" } { version "1.1" } { header H{ { "some-header" "1; 2" } { "content-length" "4" } { "content-type" "application/octet-stream" } } } - { post-data T{ post-data { content "blah" } { raw "blah" } { content-type "application/octet-stream" } } } + { post-data T{ post-data { data "blah" } { content-type "application/octet-stream" } } } { cookies V{ } } } ] [ diff --git a/basis/http/http.factor b/basis/http/http.factor index b29f5222db..c85cfc9c41 100755 --- a/basis/http/http.factor +++ b/basis/http/http.factor @@ -213,14 +213,11 @@ body ; raw-response new "1.1" >>version ; -TUPLE: post-data raw content content-type form-variables uploaded-files ; +TUPLE: post-data data params content-type content-encoding ; -: ( form-variables uploaded-files raw content-type -- post-data ) +: ( content-type -- post-data ) post-data new - swap >>content-type - swap >>raw - swap >>uploaded-files - swap >>form-variables ; + swap >>content-type ; : parse-content-type-attributes ( string -- attributes ) " " split harvest [ "=" split1 [ >lower ] dip ] { } map>assoc ; diff --git a/basis/http/server/cgi/cgi.factor b/basis/http/server/cgi/cgi.factor index 0c2f639cba..959642b706 100644 --- a/basis/http/server/cgi/cgi.factor +++ b/basis/http/server/cgi/cgi.factor @@ -34,7 +34,7 @@ IN: http.server.cgi request get "accept" header "HTTP_ACCEPT" set post-request? [ - request get post-data>> raw>> + request get post-data>> data>> [ "CONTENT_TYPE" set ] [ length number>string "CONTENT_LENGTH" set ] bi @@ -54,7 +54,7 @@ IN: http.server.cgi swap '[ binary encode-output _ output-stream get swap binary [ - post-request? [ request get post-data>> raw>> write flush ] when + post-request? [ request get post-data>> data>> write flush ] when input-stream get swap (stream-copy) ] with-stream ] >>body ; diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor index 1c516e9051..c328e1d6a3 100755 --- a/basis/http/server/server.factor +++ b/basis/http/server/server.factor @@ -55,18 +55,17 @@ ERROR: no-boundary ; : read-content ( request -- bytes ) "content-length" header string>number read ; -: parse-content ( request content-type -- form-variables uploaded-files raw ) - { - { "multipart/form-data" [ read-multipart-data f ] } - { "application/x-www-form-urlencoded" [ read-content [ f f ] dip ] } - [ drop read-content [ f f ] dip ] +: parse-content ( request content-type -- post-data ) + [ swap ] keep { + { "multipart/form-data" [ read-multipart-data assoc-union >>params ] } + { "application/x-www-form-urlencoded" [ read-content query>assoc >>params ] } + [ drop read-content >>data ] } case ; : read-post-data ( request -- request ) dup method>> "POST" = [ dup dup "content-type" header - [ ";" split1 drop parse-content ] keep - >>post-data + ";" split1 drop parse-content >>post-data ] when ; : extract-host ( request -- request ) From 71bc5e9e1022690c7035a8581aac7186cc930bea Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 Jan 2009 19:55:33 -0600 Subject: [PATCH 5/8] Fix &: to throw an error if the symbol does not exist --- basis/alien/c-types/c-types-tests.factor | 4 ---- basis/alien/syntax/syntax.factor | 11 ++++++----- 2 files changed, 6 insertions(+), 9 deletions(-) diff --git a/basis/alien/c-types/c-types-tests.factor b/basis/alien/c-types/c-types-tests.factor index 31542b2699..40171f56e7 100644 --- a/basis/alien/c-types/c-types-tests.factor +++ b/basis/alien/c-types/c-types-tests.factor @@ -8,10 +8,6 @@ sequences system libc alien.strings io.encodings.utf8 ; [ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test -: foo ( -- n ) &: fdafd [ 123 ] unless* ; - -[ 123 ] [ foo ] unit-test - [ -1 ] [ -1 *char ] unit-test [ -1 ] [ -1 *short ] unit-test [ -1 ] [ -1 *int ] unit-test diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index a02d2f3cb4..bed454e81d 100644 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -4,7 +4,7 @@ USING: accessors arrays alien alien.c-types alien.structs alien.arrays alien.strings kernel math namespaces parser sequences words quotations math.parser splitting grouping effects assocs combinators lexer strings.parser alien.parser -fry vocabs.parser ; +fry vocabs.parser words.constant ; IN: alien.syntax : DLL" lexer get skip-blank parse-string dlopen parsed ; parsing @@ -31,10 +31,11 @@ IN: alien.syntax : C-ENUM: ";" parse-tokens - dup length - [ [ create-in ] dip 1quotation define ] 2each ; + [ [ create-in ] dip define-constant ] each-index ; parsing +: address-of ( name library -- value ) + load-library dlsym [ "No such symbol" throw ] unless* ; + : &: - scan "c-library" get - '[ _ _ load-library dlsym ] over push-all ; parsing + scan "c-library" get '[ _ _ address-of ] over push-all ; parsing From 2dc0757850f3c714592309a8abe2cf8789d0e7f5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 Jan 2009 19:55:47 -0600 Subject: [PATCH 6/8] Cleanups --- basis/heaps/heaps-tests.factor | 6 ++---- core/slots/slots.factor | 6 +++--- 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/basis/heaps/heaps-tests.factor b/basis/heaps/heaps-tests.factor index 8fa6a274e7..7e780cbe5e 100644 --- a/basis/heaps/heaps-tests.factor +++ b/basis/heaps/heaps-tests.factor @@ -32,10 +32,8 @@ IN: heaps.tests : random-alist ( n -- alist ) [ - [ - 32 random-bits dup number>string swap set - ] times - ] H{ } make-assoc ; + drop 32 random-bits dup number>string + ] H{ } map>assoc ; : test-heap-sort ( n -- ? ) random-alist dup >alist sort-keys swap heap-sort = ; diff --git a/core/slots/slots.factor b/core/slots/slots.factor index 99766cadc2..f166378d9d 100644 --- a/core/slots/slots.factor +++ b/core/slots/slots.factor @@ -1,9 +1,9 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays byte-arrays kernel kernel.private math namespaces make sequences strings words effects generic generic.standard classes classes.algebra slots.private combinators accessors -words sequences.private assocs alien quotations ; +words sequences.private assocs alien quotations hashtables ; IN: slots TUPLE: slot-spec name offset class initial read-only ; @@ -86,7 +86,7 @@ ERROR: bad-slot-value value class ; ] [ ] make ; : writer-props ( slot-spec -- assoc ) - [ "writing" set ] H{ } make-assoc ; + "writing" associate ; : define-writer ( class slot-spec -- ) [ name>> writer-word ] [ writer-quot ] [ writer-props ] tri From c63b27a5bf8444f115d045f98c54b77180f38003 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 21 Jan 2009 19:58:32 -0600 Subject: [PATCH 7/8] fix furnace.utilities for file uploads --- basis/furnace/utilities/utilities.factor | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/basis/furnace/utilities/utilities.factor b/basis/furnace/utilities/utilities.factor index 7f71a131ed..f84519b9c1 100644 --- a/basis/furnace/utilities/utilities.factor +++ b/basis/furnace/utilities/utilities.factor @@ -96,11 +96,7 @@ M: object modify-form drop ; dup method>> { { "GET" [ url>> query>> ] } { "HEAD" [ url>> query>> ] } - { "POST" [ - post-data>> - dup content-type>> "application/x-www-form-urlencoded" = - [ content>> ] [ drop f ] if - ] } + { "POST" [ post-data>> params>> ] } } case ; : referrer ( -- referrer/f ) From 1dc7ecfdc5b7388bc1f6771328770c18aad2f372 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 21 Jan 2009 20:12:09 -0600 Subject: [PATCH 8/8] lol the hak...fix coming up --- vm/image.c | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/vm/image.c b/vm/image.c index 08aae5898c..f7ecd34aa8 100755 --- a/vm/image.c +++ b/vm/image.c @@ -112,9 +112,10 @@ bool save_image(const F_CHAR *filename) FILE* file; F_HEADER h; - F_CHAR temporary_filename[] = "##saving-factor-image##"; + F_CHAR temporary_filename[] = STRING_LITERAL("##saving-factor-image##"); - file = OPEN_WRITE(temporary_filename); + file = OPEN_WRITE(filename); + //file = OPEN_WRITE(temporary_filename); if(file == NULL) { print_string("Cannot open image file: "); print_native_string(filename); nl(); @@ -165,11 +166,13 @@ bool save_image(const F_CHAR *filename) return false; } + return true; + if(MOVE_FILE_FAILS(temporary_filename, filename)) { print_string("Failed to rename tempoarary image file: "); print_string(strerror(errno)); nl(); - if(DELETE_FILE_FAILS(temporary_filename)) - print_string("Failed to clean up temporary image file: "); print_string(strerror(errno)); nl(); + //if(DELETE_FILE_FAILS(temporary_filename)) + //print_string("Failed to clean up temporary image file: "); print_string(strerror(errno)); nl(); return false; }