From de64b18158bf358eca853f3906f92296a7d998d1 Mon Sep 17 00:00:00 2001 From: James Cash Date: Sun, 16 Nov 2008 17:34:53 -0500 Subject: [PATCH 01/25] Missing in extra/webapps/user-admin/new-user.xml --- extra/webapps/user-admin/new-user.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/webapps/user-admin/new-user.xml b/extra/webapps/user-admin/new-user.xml index d3cf681165..313c8e2702 100644 --- a/extra/webapps/user-admin/new-user.xml +++ b/extra/webapps/user-admin/new-user.xml @@ -37,7 +37,7 @@ Capabilities: -

  • +

    • From 553bc1fb7a7055bd2d9ce650e89299c8f7f96b55 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 07:17:05 -0600 Subject: [PATCH 02/25] Fix +

    diff --git a/basis/furnace/auth/features/recover-password/recover-1.xml b/basis/furnace/auth/features/recover-password/recover-1.xml index a8b67513a4..6dc882538e 100644 --- a/basis/furnace/auth/features/recover-password/recover-1.xml +++ b/basis/furnace/auth/features/recover-password/recover-1.xml @@ -32,7 +32,7 @@ - + diff --git a/basis/furnace/auth/features/recover-password/recover-3.xml b/basis/furnace/auth/features/recover-password/recover-3.xml index 2df400ffe2..ec68e27947 100644 --- a/basis/furnace/auth/features/recover-password/recover-3.xml +++ b/basis/furnace/auth/features/recover-password/recover-3.xml @@ -31,7 +31,7 @@

    - +

    diff --git a/basis/furnace/auth/features/registration/register.xml b/basis/furnace/auth/features/registration/register.xml index 45c090905e..1e2fec6dd0 100644 --- a/basis/furnace/auth/features/registration/register.xml +++ b/basis/furnace/auth/features/registration/register.xml @@ -62,7 +62,7 @@

    - +

    diff --git a/basis/furnace/auth/login/login.xml b/basis/furnace/auth/login/login.xml index 917c182fb3..9a37174e95 100644 --- a/basis/furnace/auth/login/login.xml +++ b/basis/furnace/auth/login/login.xml @@ -35,7 +35,7 @@

    - +

    diff --git a/extra/webapps/help/search.xml b/extra/webapps/help/search.xml index e5fa5d3901..bcaed59ea4 100644 --- a/extra/webapps/help/search.xml +++ b/extra/webapps/help/search.xml @@ -30,7 +30,7 @@ - + diff --git a/extra/webapps/pastebin/new-paste.xml b/extra/webapps/pastebin/new-paste.xml index 96339b6cf8..9866c8819a 100644 --- a/extra/webapps/pastebin/new-paste.xml +++ b/extra/webapps/pastebin/new-paste.xml @@ -18,6 +18,6 @@ -

    +

    diff --git a/extra/webapps/pastebin/paste.xml b/extra/webapps/pastebin/paste.xml index 8fe672049f..a48d2ea42d 100644 --- a/extra/webapps/pastebin/paste.xml +++ b/extra/webapps/pastebin/paste.xml @@ -52,7 +52,7 @@ -

    +

    diff --git a/extra/webapps/wee-url/shorten.xml b/extra/webapps/wee-url/shorten.xml index 53f611a8d8..3dda556aa2 100644 --- a/extra/webapps/wee-url/shorten.xml +++ b/extra/webapps/wee-url/shorten.xml @@ -4,7 +4,7 @@

    Shorten URL:

    - +     diff --git a/extra/webapps/wiki/edit.xml b/extra/webapps/wiki/edit.xml index 9cb2e92f93..f8c593cf2f 100644 --- a/extra/webapps/wiki/edit.xml +++ b/extra/webapps/wiki/edit.xml @@ -16,7 +16,7 @@

    - +

    diff --git a/extra/webapps/wiki/revisions.xml b/extra/webapps/wiki/revisions.xml index 1d9c01fd65..759cc77449 100644 --- a/extra/webapps/wiki/revisions.xml +++ b/extra/webapps/wiki/revisions.xml @@ -32,7 +32,7 @@ - + From c0b56c4d3ba4ef7f4fc70584a1ba923a89960e17 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 08:47:08 -0600 Subject: [PATCH 03/25] 'see' now shows declarations on methods --- basis/prettyprint/prettyprint-tests.factor | 10 ++++++++++ basis/prettyprint/prettyprint.factor | 3 +++ 2 files changed, 13 insertions(+) diff --git a/basis/prettyprint/prettyprint-tests.factor b/basis/prettyprint/prettyprint-tests.factor index 6a4ac71eb8..8eaaab3c1d 100644 --- a/basis/prettyprint/prettyprint-tests.factor +++ b/basis/prettyprint/prettyprint-tests.factor @@ -355,3 +355,13 @@ INTERSECTION: intersection-see-test sequence number ; [ ] [ \ curry see ] unit-test [ "POSTPONE: [" ] [ \ [ unparse ] unit-test + +TUPLE: started-out-hustlin' ; + +GENERIC: ended-up-ballin' + +M: started-out-hustlin' ended-up-ballin' ; inline + +[ "USING: prettyprint.tests ;\nM: started-out-hustlin' ended-up-ballin' ; inline\n" ] [ + [ { started-out-hustlin' ended-up-ballin' } see ] with-string-writer +] unit-test diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor index b0293a8759..3befdaff2b 100644 --- a/basis/prettyprint/prettyprint.factor +++ b/basis/prettyprint/prettyprint.factor @@ -253,6 +253,9 @@ M: object see block> ] with-use nl ; +M: method-spec see + first2 method see ; + GENERIC: see-class* ( word -- ) M: union-class see-class* From 543ef13a7d30ad86ed398de5a6ec8b20af38109f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 09:01:01 -0600 Subject: [PATCH 04/25] Shorter help filenames --- basis/help/html/html.factor | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index 4100a34d72..d2d0725a1e 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -10,17 +10,15 @@ IN: help.html : escape-char ( ch -- ) dup H{ - { CHAR: " "__quote__" } + { CHAR: " "__quo__" } { CHAR: * "__star__" } { CHAR: : "__colon__" } { CHAR: < "__lt__" } { CHAR: > "__gt__" } - { CHAR: ? "__question__" } - { CHAR: \\ "__backslash__" } + { CHAR: ? "__que__" } + { CHAR: \\ "__back__" } { CHAR: | "__pipe__" } - { CHAR: _ "__underscore__" } { CHAR: / "__slash__" } - { CHAR: \\ "__backslash__" } { CHAR: , "__comma__" } { CHAR: @ "__at__" } } at [ % ] [ , ] ?if ; From 672f9e400e4845f1cda10efc3cc985c13e38dee4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 11:16:32 -0600 Subject: [PATCH 05/25] Better error message --- basis/stack-checker/errors/errors.factor | 6 ++++++ basis/stack-checker/known-words/known-words.factor | 2 +- basis/stack-checker/stack-checker-tests.factor | 2 ++ 3 files changed, 9 insertions(+), 1 deletion(-) diff --git a/basis/stack-checker/errors/errors.factor b/basis/stack-checker/errors/errors.factor index 9fb2b59f6c..31ae0a6789 100644 --- a/basis/stack-checker/errors/errors.factor +++ b/basis/stack-checker/errors/errors.factor @@ -108,3 +108,9 @@ M: inconsistent-recursive-call-error error. "The recursive word " write word>> pprint " calls itself with a different set of quotation parameters than were input" print ; + +TUPLE: unknown-primitive-error ; + +M: unknown-primitive-error error. + drop + "Cannot determine stack effect statically" print ; diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 4aea0f2d28..f1034f2ca6 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -162,7 +162,7 @@ M: object infer-call* { \ load-locals [ infer-load-locals ] } { \ get-local [ infer-get-local ] } { \ drop-locals [ infer-drop-locals ] } - { \ do-primitive [ \ do-primitive cannot-infer-effect ] } + { \ do-primitive [ unknown-primitive-error inference-error ] } { \ alien-invoke [ infer-alien-invoke ] } { \ alien-indirect [ infer-alien-indirect ] } { \ alien-callback [ infer-alien-callback ] } diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index 9bf8ed62f0..defcde53f0 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -580,3 +580,5 @@ DEFER: eee' dup "A" throw [ bogus-error ] [ drop ] if ; inline recursive [ bogus-error ] must-infer + +[ [ clear ] infer. ] [ inference-error? ] must-fail-with From a166db313aaf090048914b85c2fd38bf387672df Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 12:23:12 -0600 Subject: [PATCH 06/25] Inferring set-datastack is just a warning not an error --- basis/stack-checker/known-words/known-words.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index f1034f2ca6..fdc4b4b35c 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -162,7 +162,7 @@ M: object infer-call* { \ load-locals [ infer-load-locals ] } { \ get-local [ infer-get-local ] } { \ drop-locals [ infer-drop-locals ] } - { \ do-primitive [ unknown-primitive-error inference-error ] } + { \ do-primitive [ unknown-primitive-error inference-warning ] } { \ alien-invoke [ infer-alien-invoke ] } { \ alien-indirect [ infer-alien-indirect ] } { \ alien-callback [ infer-alien-callback ] } From 14246fde379df2117238498b2094920c417af33b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 12:23:44 -0600 Subject: [PATCH 07/25] Better FFI unit tests expose a new problem --- basis/compiler/tests/alien.factor | 14 +++++++++++--- vm/ffi_test.c | 12 +++++++++++- vm/ffi_test.h | 3 ++- 3 files changed, 24 insertions(+), 5 deletions(-) diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index d7e82402d5..3ca6fc87f3 100644 --- a/basis/compiler/tests/alien.factor +++ b/basis/compiler/tests/alien.factor @@ -146,13 +146,21 @@ FUNCTION: void ffi_test_20 double x1, double x2, double x3, ! Make sure XT doesn't get clobbered in stack frame -: ffi_test_31 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a ptr -- result y ) - "void" +: ffi_test_31 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result y ) + "int" f "ffi_test_31" { "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" } alien-invoke gc 3 ; -[ 3 ] [ 42 [ ] each ffi_test_31 ] unit-test +[ 861 3 ] [ 42 [ ] each ffi_test_31 ] unit-test + +: ffi_test_31_point_5 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result ) + "float" + f "ffi_test_31_point_5" + { "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" } + alien-invoke ; + +[ 861.0 ] [ 42 [ >float ] each ffi_test_31_point_5 ] unit-test FUNCTION: longlong ffi_test_21 long x long y ; diff --git a/vm/ffi_test.c b/vm/ffi_test.c index 081ae42ebf..7ae4491d80 100755 --- a/vm/ffi_test.c +++ b/vm/ffi_test.c @@ -224,7 +224,17 @@ struct test_struct_7 ffi_test_30(void) return s; } -void ffi_test_31(int x0, int x1, int x2, int x3, int x4, int x5, int x6, int x7, int x8, int x9, int x10, int x11, int x12, int x13, int x14, int x15, int x16, int x17, int x18, int x19, int x20, int x21, int x22, int x23, int x24, int x25, int x26, int x27, int x28, int x29, int x30, int x31, int x32, int x33, int x34, int x35, int x36, int x37, int x38, int x39, int x40, int x41) { } +int ffi_test_31(int x0, int x1, int x2, int x3, int x4, int x5, int x6, int x7, int x8, int x9, int x10, int x11, int x12, int x13, int x14, int x15, int x16, int x17, int x18, int x19, int x20, int x21, int x22, int x23, int x24, int x25, int x26, int x27, int x28, int x29, int x30, int x31, int x32, int x33, int x34, int x35, int x36, int x37, int x38, int x39, int x40, int x41) +{ + printf("ffi_test_31(%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d)\n",x0,x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21,x22,x23,x24,x25,x26,x27,x28,x29,x30,x31,x32,x33,x34,x35,x36,x37,x38,x39,x40,x41); + return x0 + x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + x10 + x11 + x12 + x13 + x14 + x15 + x16 + x17 + x18 + x19 + x20 + x21 + x22 + x23 + x24 + x25 + x26 + x27 + x28 + x29 + x30 + x31 + x32 + x33 + x34 + x35 + x36 + x37 + x38 + x39 + x40 + x41; +} + +float ffi_test_31_point_5(float x0, float x1, float x2, float x3, float x4, float x5, float x6, float x7, float x8, float x9, float x10, float x11, float x12, float x13, float x14, float x15, float x16, float x17, float x18, float x19, float x20, float x21, float x22, float x23, float x24, float x25, float x26, float x27, float x28, float x29, float x30, float x31, float x32, float x33, float x34, float x35, float x36, float x37, float x38, float x39, float x40, float x41) +{ + printf("ffi_test_31_point_5(%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f)\n",x0,x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21,x22,x23,x24,x25,x26,x27,x28,x29,x30,x31,x32,x33,x34,x35,x36,x37,x38,x39,x40,x41); + return x0 + x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + x10 + x11 + x12 + x13 + x14 + x15 + x16 + x17 + x18 + x19 + x20 + x21 + x22 + x23 + x24 + x25 + x26 + x27 + x28 + x29 + x30 + x31 + x32 + x33 + x34 + x35 + x36 + x37 + x38 + x39 + x40 + x41; +} double ffi_test_32(struct test_struct_8 x, int y) { diff --git a/vm/ffi_test.h b/vm/ffi_test.h index f9195a4285..7c51261157 100755 --- a/vm/ffi_test.h +++ b/vm/ffi_test.h @@ -48,7 +48,8 @@ struct test_struct_6 { char x, y, z, a, b, c; }; DLLEXPORT struct test_struct_6 ffi_test_29(void); struct test_struct_7 { char x, y, z, a, b, c, d; }; DLLEXPORT struct test_struct_7 ffi_test_30(void); -DLLEXPORT void ffi_test_31(int x0, int x1, int x2, int x3, int x4, int x5, int x6, int x7, int x8, int x9, int x10, int x11, int x12, int x13, int x14, int x15, int x16, int x17, int x18, int x19, int x20, int x21, int x22, int x23, int x24, int x25, int x26, int x27, int x28, int x29, int x30, int x31, int x32, int x33, int x34, int x35, int x36, int x37, int x38, int x39, int x40, int x41); +DLLEXPORT int ffi_test_31(int x0, int x1, int x2, int x3, int x4, int x5, int x6, int x7, int x8, int x9, int x10, int x11, int x12, int x13, int x14, int x15, int x16, int x17, int x18, int x19, int x20, int x21, int x22, int x23, int x24, int x25, int x26, int x27, int x28, int x29, int x30, int x31, int x32, int x33, int x34, int x35, int x36, int x37, int x38, int x39, int x40, int x41); +DLLEXPORT float ffi_test_31_point_5(float x0, float x1, float x2, float x3, float x4, float x5, float x6, float x7, float x8, float x9, float x10, float x11, float x12, float x13, float x14, float x15, float x16, float x17, float x18, float x19, float x20, float x21, float x22, float x23, float x24, float x25, float x26, float x27, float x28, float x29, float x30, float x31, float x32, float x33, float x34, float x35, float x36, float x37, float x38, float x39, float x40, float x41); struct test_struct_8 { double x; double y; }; DLLEXPORT double ffi_test_32(struct test_struct_8 x, int y); struct test_struct_9 { float x; float y; }; From 20f5541d35c6a064d328b9da568298b02aa49ccf Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 13:34:37 -0600 Subject: [PATCH 08/25] Refactoring FFI for Win64 --- basis/alien/c-types/c-types.factor | 2 +- basis/alien/structs/structs.factor | 28 ++++++++++++---------- basis/compiler/codegen/codegen.factor | 4 ++-- basis/cpu/architecture/architecture.factor | 17 +++---------- basis/cpu/ppc/linux/linux.factor | 2 +- basis/cpu/ppc/macosx/macosx.factor | 2 +- basis/cpu/x86/64/winnt/winnt.factor | 5 ++-- basis/cpu/x86/x86.factor | 2 +- 8 files changed, 27 insertions(+), 35 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index a93c87611d..b4e4d05f2e 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -164,7 +164,7 @@ GENERIC: stack-size ( type -- size ) foldable M: string stack-size c-type stack-size ; -M: c-type stack-size size>> ; +M: c-type stack-size size>> cell align ; GENERIC: byte-length ( seq -- n ) flushable diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor index ce30a2ee25..adb25aa977 100644 --- a/basis/alien/structs/structs.factor +++ b/basis/alien/structs/structs.factor @@ -1,14 +1,10 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays generic hashtables kernel kernel.private -math namespaces parser sequences strings words libc +math namespaces parser sequences strings words libc fry alien.c-types alien.structs.fields cpu.architecture ; IN: alien.structs -: if-value-structs? ( ctype true false -- ) - value-structs? - [ drop call ] [ >r 2drop "void*" r> call ] if ; inline - TUPLE: struct-type size align fields ; M: struct-type heap-size size>> ; @@ -17,20 +13,26 @@ M: struct-type c-type-align align>> ; M: struct-type c-type-stack-align? drop f ; -M: struct-type unbox-parameter - [ %unbox-struct ] [ unbox-parameter ] if-value-structs? ; +: if-value-struct ( ctype true false -- ) + [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline -M: struct-type unbox-return - f swap %unbox-struct ; +M: struct-type unbox-parameter + [ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ; M: struct-type box-parameter - [ %box-struct ] [ box-parameter ] if-value-structs? ; + [ %box-large-struct ] [ box-parameter ] if-value-struct ; + +: if-small-struct ( c-type true false -- ? ) + [ dup struct-small-enough? ] 2dip '[ f swap @ ] if ; inline + +M: struct-type unbox-return + [ %unbox-small-struct ] [ %unbox-large-struct ] if-small-struct ; M: struct-type box-return - f swap %box-struct ; + [ %box-small-struct ] [ %box-large-struct ] if-small-struct ; M: struct-type stack-size - [ heap-size ] [ stack-size ] if-value-structs? ; + [ heap-size ] [ stack-size ] if-value-struct ; : c-struct? ( type -- ? ) (c-type) struct-type? ; @@ -40,7 +42,7 @@ M: struct-type stack-size -rot define-c-type ; : define-struct-early ( name vocab fields -- fields ) - -rot [ rot first2 ] 2curry map ; + [ first2 ] with with map ; : compute-struct-align ( types -- n ) [ c-type-align ] map supremum ; diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 0d45b28126..9f6e8e9c9b 100644 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -235,7 +235,7 @@ M: float-regs reg-class-variable drop float-regs ; GENERIC: inc-reg-class ( register-class -- ) : ?dummy-stack-params ( reg-class -- ) - dummy-stack-params? [ reg-size stack-params +@ ] [ drop ] if ; + dummy-stack-params? [ reg-size cell align stack-params +@ ] [ drop ] if ; : ?dummy-int-params ( reg-class -- ) dummy-int-params? [ reg-size cell /i 1 max int-regs +@ ] [ drop ] if ; @@ -264,7 +264,7 @@ M: object reg-class-full? : spill-param ( reg-class -- n reg-class ) stack-params get - >r reg-size stack-params +@ r> + >r reg-size cell align stack-params +@ r> stack-params ; : fastcall-param ( reg-class -- n reg-class ) diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 96dd577c10..d26e7f6ff7 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -141,10 +141,10 @@ HOOK: %loop-entry cpu ( -- ) HOOK: small-enough? cpu ( n -- ? ) ! Is this structure small enough to be returned in registers? -HOOK: struct-small-enough? cpu ( heap-size -- ? ) +HOOK: struct-small-enough? cpu ( c-type -- ? ) -! Do we pass value structs by value or hidden reference? -HOOK: value-structs? cpu ( -- ? ) +! Do we pass this struct by value or hidden reference? +HOOK: value-struct? cpu ( c-type -- ? ) ! If t, all parameters are shadowed by dummy stack parameters HOOK: dummy-stack-params? cpu ( -- ? ) @@ -207,14 +207,3 @@ M: object %callback-return drop %return ; M: stack-params param-reg drop ; M: stack-params param-regs drop f ; - -: if-small-struct ( n size true false -- ? ) - [ 2dup [ not ] [ struct-small-enough? ] bi* and ] 2dip - [ '[ nip @ ] ] dip if ; - inline - -: %unbox-struct ( n c-type -- ) - [ %unbox-small-struct ] [ %unbox-large-struct ] if-small-struct ; - -: %box-struct ( n c-type -- ) - [ %box-small-struct ] [ %box-large-struct ] if-small-struct ; diff --git a/basis/cpu/ppc/linux/linux.factor b/basis/cpu/ppc/linux/linux.factor index 090495aa11..5cfa1391c4 100644 --- a/basis/cpu/ppc/linux/linux.factor +++ b/basis/cpu/ppc/linux/linux.factor @@ -15,7 +15,7 @@ M: linux lr-save 1 cells ; M: float-regs param-regs drop { 1 2 3 4 5 6 7 8 } ; -M: ppc value-structs? f ; +M: ppc value-struct? drop f ; M: ppc dummy-stack-params? f ; diff --git a/basis/cpu/ppc/macosx/macosx.factor b/basis/cpu/ppc/macosx/macosx.factor index 877fb37d31..c742cf2ddc 100644 --- a/basis/cpu/ppc/macosx/macosx.factor +++ b/basis/cpu/ppc/macosx/macosx.factor @@ -16,7 +16,7 @@ M: macosx lr-save 2 cells ; M: float-regs param-regs drop { 1 2 3 4 5 6 7 8 9 10 11 12 13 } ; -M: ppc value-structs? t ; +M: ppc value-struct? drop t ; M: ppc dummy-stack-params? t ; diff --git a/basis/cpu/x86/64/winnt/winnt.factor b/basis/cpu/x86/64/winnt/winnt.factor index 0124c40877..92560ef5e9 100644 --- a/basis/cpu/x86/64/winnt/winnt.factor +++ b/basis/cpu/x86/64/winnt/winnt.factor @@ -10,8 +10,9 @@ M: float-regs param-regs drop { XMM0 XMM1 XMM2 XMM3 } ; M: x86.64 reserved-area-size 4 cells ; -M: x86.64 struct-small-enough? ( size -- ? ) - heap-size cell <= ; +M: x86.64 struct-small-enough? heap-size { 1 2 4 8 } member? ; + +M: x86.64 value-struct? heap-size { 1 2 4 8 } member? ; M: x86.64 dummy-stack-params? f ; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index dfe3d3e55e..58d95ffcde 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -507,7 +507,7 @@ M: x86 %prepare-alien-invoke temp-reg-1 2 cells [+] ds-reg MOV temp-reg-1 3 cells [+] rs-reg MOV ; -M: x86 value-structs? t ; +M: x86 value-struct? drop t ; M: x86 small-enough? ( n -- ? ) HEX: -80000000 HEX: 7fffffff between? ; From 7815560f30c19699d44e251acf18b4f69d937651 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 17:28:44 -0600 Subject: [PATCH 09/25] Fix index paths --- basis/help/html/html.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index d2d0725a1e..82e83e60e0 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -115,10 +115,10 @@ M: result link-href href>> ; [ [ title>> ] compare ] sort ; : article-apropos ( string -- results ) - "articles.idx" temp-file offline-apropos ; + "docs/articles.idx" temp-file offline-apropos ; : word-apropos ( string -- results ) - "words.idx" temp-file offline-apropos ; + "docs/words.idx" temp-file offline-apropos ; : vocab-apropos ( string -- results ) - "vocabs.idx" temp-file offline-apropos ; + "docs/vocabs.idx" temp-file offline-apropos ; From b50d4c9b36621be6e96eff3d935d48454e49c39f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 17:30:47 -0600 Subject: [PATCH 10/25] Fix help search again --- basis/help/html/html.factor | 6 +++--- extra/webapps/help/help.factor | 8 +++++--- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index 82e83e60e0..6b90ba6937 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -115,10 +115,10 @@ M: result link-href href>> ; [ [ title>> ] compare ] sort ; : article-apropos ( string -- results ) - "docs/articles.idx" temp-file offline-apropos ; + "articles.idx" offline-apropos ; : word-apropos ( string -- results ) - "docs/words.idx" temp-file offline-apropos ; + "words.idx" offline-apropos ; : vocab-apropos ( string -- results ) - "docs/vocabs.idx" temp-file offline-apropos ; + "vocabs.idx" offline-apropos ; diff --git a/extra/webapps/help/help.factor b/extra/webapps/help/help.factor index c209fe222e..3072f5d024 100644 --- a/extra/webapps/help/help.factor +++ b/extra/webapps/help/help.factor @@ -18,9 +18,11 @@ TUPLE: help-webapp < dispatcher ; help-dir set-current-directory - "search" value article-apropos "articles" set-value - "search" value word-apropos "words" set-value - "search" value vocab-apropos "vocabs" set-value + help-dir [ + "search" value article-apropos "articles" set-value + "search" value word-apropos "words" set-value + "search" value vocab-apropos "vocabs" set-value + ] with-directory { help-webapp "search" } ] >>submit ; From 4d0b5cf7e74c793b1a1b75ff3ea052b24c3b9348 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 17:35:39 -0600 Subject: [PATCH 11/25] Clean up --- extra/webapps/help/help.factor | 2 -- 1 file changed, 2 deletions(-) diff --git a/extra/webapps/help/help.factor b/extra/webapps/help/help.factor index 3072f5d024..6f2c4f0042 100644 --- a/extra/webapps/help/help.factor +++ b/extra/webapps/help/help.factor @@ -16,8 +16,6 @@ TUPLE: help-webapp < dispatcher ; { "search" [ 1 v-min-length 50 v-max-length v-one-line ] } } validate-params - help-dir set-current-directory - help-dir [ "search" value article-apropos "articles" set-value "search" value word-apropos "words" set-value From ff7358beb31d6eac72073ca8aa5bb31e2ede13d0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 17:48:06 -0600 Subject: [PATCH 12/25] Fix typo --- basis/compiler/compiler-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/compiler/compiler-docs.factor b/basis/compiler/compiler-docs.factor index 6cb860d33f..512d26f4bf 100644 --- a/basis/compiler/compiler-docs.factor +++ b/basis/compiler/compiler-docs.factor @@ -6,7 +6,7 @@ HELP: enable-compiler { $description "Enables the optimizing compiler." } ; HELP: disable-compiler -{ $description "Enables the optimizing compiler." } ; +{ $description "Disable the optimizing compiler." } ; ARTICLE: "compiler-usage" "Calling the optimizing compiler" "Normally, new word definitions are recompiled automatically. This can be changed:" From eea93234d05abd58a8512d05985541f436ff4652 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:41:53 -0600 Subject: [PATCH 13/25] Fix some types for Win64 --- basis/windows/kernel32/kernel32.factor | 10 +++++----- basis/windows/types/types.factor | 9 +++++---- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index 462377e85c..96301dbbe4 100644 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -199,11 +199,11 @@ TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION : THREAD_PRIORITY_TIME_CRITICAL 15 ; inline C-STRUCT: OVERLAPPED - { "int" "internal" } - { "int" "internal-high" } - { "int" "offset" } - { "int" "offset-high" } - { "void*" "event" } ; + { "UINT_PTR" "internal" } + { "UINT_PTR" "internal-high" } + { "DWORD" "offset" } + { "DWORD" "offset-high" } + { "HANDLE" "event" } ; C-STRUCT: SYSTEMTIME { "WORD" "wYear" } diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor index 0ac8409016..6b1a57a098 100644 --- a/basis/windows/types/types.factor +++ b/basis/windows/types/types.factor @@ -40,10 +40,11 @@ TYPEDEF: void* LPVOID TYPEDEF: void* LPCVOID TYPEDEF: float FLOAT -TYPEDEF: short HALF_PTR -TYPEDEF: ushort UHALF_PTR -TYPEDEF: int INT_PTR -TYPEDEF: uint UINT_PTR + +TYPEDEF: intptr_t HALF_PTR +TYPEDEF: intptr_t UHALF_PTR +TYPEDEF: intptr_t INT_PTR +TYPEDEF: intptr_t UINT_PTR TYPEDEF: int LONG_PTR TYPEDEF: ulong ULONG_PTR From ccd13ce975fe4461de7ffe903b8fd4b8cd1408b5 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:42:10 -0600 Subject: [PATCH 14/25] Define intptr_t type --- basis/alien/c-types/c-types.factor | 2 +- basis/cpu/x86/64/winnt/winnt.factor | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index b4e4d05f2e..543af8dee8 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -436,6 +436,6 @@ M: long-long-type box-return ( type -- ) "double" define-primitive-type "long" "ptrdiff_t" typedef - + "long" "intptr_t" typedef "ulong" "size_t" typedef ] with-compilation-unit diff --git a/basis/cpu/x86/64/winnt/winnt.factor b/basis/cpu/x86/64/winnt/winnt.factor index 92560ef5e9..9108c0e8f7 100644 --- a/basis/cpu/x86/64/winnt/winnt.factor +++ b/basis/cpu/x86/64/winnt/winnt.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel layouts system math alien.c-types +USING: kernel layouts system math alien.c-types sequences compiler.cfg.registers cpu.architecture cpu.x86.assembler cpu.x86 ; IN: cpu.x86.64.winnt @@ -22,6 +22,7 @@ M: x86.64 dummy-fp-params? t ; << "longlong" "ptrdiff_t" typedef +"longlong" "intptr_t" typedef "int" "long" typedef "uint" "ulong" typedef >> From efb2e49c50c318f598508d6e62da53ebcf056a21 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:42:21 -0600 Subject: [PATCH 15/25] Fix freetype for Win64 --- basis/freetype/freetype.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/freetype/freetype.factor b/basis/freetype/freetype.factor index 8572a8bd91..683169e394 100644 --- a/basis/freetype/freetype.factor +++ b/basis/freetype/freetype.factor @@ -64,7 +64,7 @@ C-STRUCT: glyph { "FT_Pos" "advance-x" } { "FT_Pos" "advance-y" } - { "long" "format" } + { "intptr_t" "format" } { "int" "bitmap-rows" } { "int" "bitmap-width" } From d0139671802d194732d31d3ef60f202e9e33af88 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:42:44 -0600 Subject: [PATCH 16/25] Make io.servers.connection work if SSL is not available --- basis/io/servers/connection/connection.factor | 30 ++++++++++++------- 1 file changed, 20 insertions(+), 10 deletions(-) diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor index 674ed8803c..942bdb041d 100644 --- a/basis/io/servers/connection/connection.factor +++ b/basis/io/servers/connection/connection.factor @@ -114,19 +114,29 @@ M: threaded-server handle-client* handler>> call ; ] when* ] unless ; +: (start-server) ( threaded-server -- ) + init-server + dup threaded-server [ + dup name>> [ + [ listen-on [ start-accept-loop ] parallel-each ] + [ ready>> raise-flag ] + bi + ] with-logging + ] with-variable ; + PRIVATE> : start-server ( threaded-server -- ) - init-server - dup secure-config>> [ - dup threaded-server [ - dup name>> [ - [ listen-on [ start-accept-loop ] parallel-each ] - [ ready>> raise-flag ] - bi - ] with-logging - ] with-variable - ] with-secure-context ; + #! Only create a secure-context if we want to listen on + #! a secure port, otherwise start-server won't work at + #! all if SSL is not available. + dup secure>> [ + dup secure-config>> [ + (start-server) + ] with-secure-context + ] [ + (start-server) + ] if ; : wait-for-server ( threaded-server -- ) ready>> wait-for-flag ; From 1c33e993daa0093db9efcff32a577e9d2f0c4251 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:43:10 -0600 Subject: [PATCH 17/25] Tweak launcher test: it failed without cygwin --- .../windows/nt/launcher/launcher-tests.factor | 314 +++++++++--------- 1 file changed, 157 insertions(+), 157 deletions(-) diff --git a/basis/io/windows/nt/launcher/launcher-tests.factor b/basis/io/windows/nt/launcher/launcher-tests.factor index 949b0a7961..cbae2f5eca 100644 --- a/basis/io/windows/nt/launcher/launcher-tests.factor +++ b/basis/io/windows/nt/launcher/launcher-tests.factor @@ -1,157 +1,157 @@ -USING: io.launcher tools.test calendar accessors environment -namespaces kernel system arrays io io.files io.encodings.ascii -sequences parser assocs hashtables math continuations eval ; -IN: io.windows.launcher.nt.tests - -[ ] [ - - "notepad" >>command - 1/2 seconds >>timeout - "notepad" set -] unit-test - -[ f ] [ "notepad" get process-running? ] unit-test - -[ f ] [ "notepad" get process-started? ] unit-test - -[ ] [ "notepad" [ run-detached ] change ] unit-test - -[ "notepad" get wait-for-process ] must-fail - -[ t ] [ "notepad" get killed>> ] unit-test - -[ f ] [ "notepad" get process-running? ] unit-test - -[ ] [ - - vm "-quiet" "-run=hello-world" 3array >>command - "out.txt" temp-file >>stdout - try-process -] unit-test - -[ "Hello world" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ ] [ - - vm "-run=listener" 2array >>command - +closed+ >>stdin - try-process -] unit-test - -[ ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "stderr.factor" 3array >>command - "out.txt" temp-file >>stdout - "err.txt" temp-file >>stderr - try-process - ] with-directory -] unit-test - -[ "output" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ "error" ] [ - "err.txt" temp-file ascii file-lines first -] unit-test - -[ ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "stderr.factor" 3array >>command - "out.txt" temp-file >>stdout - +stdout+ >>stderr - try-process - ] with-directory -] unit-test - -[ "outputerror" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ "output" ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "stderr.factor" 3array >>command - "err2.txt" temp-file >>stderr - ascii lines first - ] with-directory -] unit-test - -[ "error" ] [ - "err2.txt" temp-file ascii file-lines first -] unit-test - -[ t ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - ascii contents - ] with-directory eval - - os-envs = -] unit-test - -[ t ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - +replace-environment+ >>environment-mode - os-envs >>environment - ascii contents - ] with-directory eval - - os-envs = -] unit-test - -[ "B" ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - { { "A" "B" } } >>environment - ascii contents - ] with-directory eval - - "A" swap at -] unit-test - -[ f ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - { { "HOME" "XXX" } } >>environment - +prepend-environment+ >>environment-mode - ascii contents - ] with-directory eval - - "HOME" swap at "XXX" = -] unit-test - -2 [ - [ ] [ - - "cmd.exe /c dir" >>command - "dir.txt" temp-file >>stdout - try-process - ] unit-test - - [ ] [ "dir.txt" temp-file delete-file ] unit-test -] times - -[ "append-test" temp-file delete-file ] ignore-errors - -[ "Hello appender\r\nHello appender\r\n" ] [ - 2 [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "append.factor" 3array >>command - "append-test" temp-file >>stdout - try-process - ] with-directory - ] times - - "append-test" temp-file ascii file-contents -] unit-test +USING: io.launcher tools.test calendar accessors environment +namespaces kernel system arrays io io.files io.encodings.ascii +sequences parser assocs hashtables math continuations eval ; +IN: io.windows.launcher.nt.tests + +[ ] [ + + "notepad" >>command + 1/2 seconds >>timeout + "notepad" set +] unit-test + +[ f ] [ "notepad" get process-running? ] unit-test + +[ f ] [ "notepad" get process-started? ] unit-test + +[ ] [ "notepad" [ run-detached ] change ] unit-test + +[ "notepad" get wait-for-process ] must-fail + +[ t ] [ "notepad" get killed>> ] unit-test + +[ f ] [ "notepad" get process-running? ] unit-test + +[ ] [ + + vm "-quiet" "-run=hello-world" 3array >>command + "out.txt" temp-file >>stdout + try-process +] unit-test + +[ "Hello world" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ ] [ + + vm "-run=listener" 2array >>command + +closed+ >>stdin + try-process +] unit-test + +[ ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "stderr.factor" 3array >>command + "out.txt" temp-file >>stdout + "err.txt" temp-file >>stderr + try-process + ] with-directory +] unit-test + +[ "output" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ "error" ] [ + "err.txt" temp-file ascii file-lines first +] unit-test + +[ ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "stderr.factor" 3array >>command + "out.txt" temp-file >>stdout + +stdout+ >>stderr + try-process + ] with-directory +] unit-test + +[ "outputerror" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ "output" ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "stderr.factor" 3array >>command + "err2.txt" temp-file >>stderr + ascii lines first + ] with-directory +] unit-test + +[ "error" ] [ + "err2.txt" temp-file ascii file-lines first +] unit-test + +[ t ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "env.factor" 3array >>command + ascii contents + ] with-directory eval + + os-envs = +] unit-test + +[ t ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "env.factor" 3array >>command + +replace-environment+ >>environment-mode + os-envs >>environment + ascii contents + ] with-directory eval + + os-envs = +] unit-test + +[ "B" ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "env.factor" 3array >>command + { { "A" "B" } } >>environment + ascii contents + ] with-directory eval + + "A" swap at +] unit-test + +[ f ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "env.factor" 3array >>command + { { "USERPROFILE" "XXX" } } >>environment + +prepend-environment+ >>environment-mode + ascii contents + ] with-directory eval + + "USERPROFILE" swap at "XXX" = +] unit-test + +2 [ + [ ] [ + + "cmd.exe /c dir" >>command + "dir.txt" temp-file >>stdout + try-process + ] unit-test + + [ ] [ "dir.txt" temp-file delete-file ] unit-test +] times + +[ "append-test" temp-file delete-file ] ignore-errors + +[ "Hello appender\r\nHello appender\r\n" ] [ + 2 [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "append.factor" 3array >>command + "append-test" temp-file >>stdout + try-process + ] with-directory + ] times + + "append-test" temp-file ascii file-contents +] unit-test From b8487ffcb0c1bbb8bdb134017a17fd457a66e152 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:43:33 -0600 Subject: [PATCH 18/25] Download Windows DLLs from builder, so that we don't need wget to build Factor --- extra/mason/child/child.factor | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/extra/mason/child/child.factor b/extra/mason/child/child.factor index 2bc6b191c4..0c9669ed5a 100644 --- a/extra/mason/child/child.factor +++ b/extra/mason/child/child.factor @@ -2,14 +2,26 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces make debugger sequences io.files io.launcher arrays accessors calendar continuations -combinators.short-circuit mason.common mason.report mason.platform ; +combinators.short-circuit mason.common mason.report +mason.platform mason.config http.client ; IN: mason.child : make-cmd ( -- args ) - [ gnu-make , "clean" , platform , ] { } make ; + gnu-make platform 2array ; + +: download-dlls ( -- ) + target-os get "winnt" = [ + "http://factorcode.org/dlls/" + target-cpu get "x86.64" = [ "64/" append ] when + [ "freetype6.dll" append ] + [ "zlib1.dll" append ] bi + [ download ] bi@ + ] when ; : make-vm ( -- ) "factor" [ + download-dlls + make-cmd >>command "../compile-log" >>stdout From 93c8f5a2f4ad2448018c7ce715495ab678661525 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:43:59 -0600 Subject: [PATCH 19/25] Use our MD5 library instead of OpenSSL so that we can run builder without OpenSSL being installed --- basis/bootstrap/image/download/download.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/bootstrap/image/download/download.factor b/basis/bootstrap/image/download/download.factor index 71aa2e8adc..f9b7b56779 100644 --- a/basis/bootstrap/image/download/download.factor +++ b/basis/bootstrap/image/download/download.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: http.client checksums checksums.openssl splitting assocs +USING: http.client checksums checksums.md5 splitting assocs kernel io.files bootstrap.image sequences io urls ; IN: bootstrap.image.download @@ -13,7 +13,7 @@ IN: bootstrap.image.download : need-new-image? ( image -- ? ) dup exists? [ - [ openssl-md5 checksum-file hex-string ] + [ md5 checksum-file hex-string ] [ download-checksums at ] bi = not ] [ drop t ] if ; From ddd28c7d12fff8bf6ed4fa757e63c9eb24f9247c Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:44:06 -0600 Subject: [PATCH 20/25] Fix Win64 type issue --- vm/math.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vm/math.c b/vm/math.c index 388a472f2e..c6b91bc8f7 100644 --- a/vm/math.c +++ b/vm/math.c @@ -109,7 +109,7 @@ void primitive_fixnum_shift(void) } else if(y < WORD_SIZE - TAG_BITS) { - F_FIXNUM mask = -(1L << (WORD_SIZE - 1 - TAG_BITS - y)); + F_FIXNUM mask = -((F_FIXNUM)1 << (WORD_SIZE - 1 - TAG_BITS - y)); if((x > 0 && (x & mask) == 0) || (x & mask) == mask) { dpush(tag_fixnum(x << y)); From a9a28a3231e08a5eff92e0ad033d1d70a02c3b48 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 20:28:52 -0600 Subject: [PATCH 21/25] Trying to blindly fix Win64 unit tests --- basis/html/templates/fhtml/fhtml-tests.factor | 6 ++++-- core/io/io-tests.factor | 7 ++++++- core/io/test/separator-test.txt | 1 - extra/benchmark/regex-dna/regex-dna-tests.factor | 6 +++--- extra/contributors/contributors.factor | 2 +- extra/mason/child/child-tests.factor | 6 +++--- 6 files changed, 17 insertions(+), 11 deletions(-) delete mode 100644 core/io/test/separator-test.txt diff --git a/basis/html/templates/fhtml/fhtml-tests.factor b/basis/html/templates/fhtml/fhtml-tests.factor index b863087a92..d314a60124 100644 --- a/basis/html/templates/fhtml/fhtml-tests.factor +++ b/basis/html/templates/fhtml/fhtml-tests.factor @@ -1,6 +1,6 @@ USING: io io.files io.streams.string io.encodings.utf8 html.templates html.templates.fhtml kernel -tools.test sequences parser ; +tools.test sequences parser splitting prettyprint ; IN: html.templates.fhtml.tests : test-template ( path -- ? ) @@ -8,8 +8,10 @@ IN: html.templates.fhtml.tests prepend [ ".fhtml" append [ call-template ] with-string-writer + lines ] keep - ".html" append utf8 file-contents = ; + ".html" append utf8 file-lines + [ . . ] [ = ] 2bi ; [ t ] [ "example" test-template ] unit-test [ t ] [ "bug" test-template ] unit-test diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index c38a7c9ebc..18cde1a35c 100644 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -25,6 +25,11 @@ IN: io.tests ! Make sure we use correct to_c_string form when writing [ ] [ "\0" write ] unit-test +[ ] [ + "It seems Jobs has lost his grasp on reality again.\n" + "separator-test.txt" temp-file latin1 set-file-contents +] unit-test + [ { { "It seems " CHAR: J } @@ -33,7 +38,7 @@ IN: io.tests } ] [ [ - "resource:core/io/test/separator-test.txt" + "separator-test.txt" temp-file latin1 [ "J" read-until 2array , "i" read-until 2array , diff --git a/core/io/test/separator-test.txt b/core/io/test/separator-test.txt deleted file mode 100644 index c3568f6ea0..0000000000 --- a/core/io/test/separator-test.txt +++ /dev/null @@ -1 +0,0 @@ -It seems Jobs has lost his grasp on reality again. diff --git a/extra/benchmark/regex-dna/regex-dna-tests.factor b/extra/benchmark/regex-dna/regex-dna-tests.factor index f1d4b7f627..79765849b5 100644 --- a/extra/benchmark/regex-dna/regex-dna-tests.factor +++ b/extra/benchmark/regex-dna/regex-dna-tests.factor @@ -1,10 +1,10 @@ USING: benchmark.regex-dna io io.files io.encodings.ascii -io.streams.string kernel tools.test ; +io.streams.string kernel tools.test splitting ; IN: benchmark.regex-dna.tests [ t ] [ "resource:extra/benchmark/regex-dna/regex-dna-test-in.txt" - [ regex-dna ] with-string-writer + [ regex-dna ] with-string-writer string-lines "resource:extra/benchmark/regex-dna/regex-dna-test-out.txt" - ascii file-contents = + ascii file-lines = ] unit-test diff --git a/extra/contributors/contributors.factor b/extra/contributors/contributors.factor index 9f2d5a55fa..f6fcac5297 100755 --- a/extra/contributors/contributors.factor +++ b/extra/contributors/contributors.factor @@ -7,7 +7,7 @@ IN: contributors : changelog ( -- authors ) image parent-directory [ - "git-log --pretty=format:%an" ascii lines + "git log --pretty=format:%an" ascii lines ] with-directory ; : patch-counts ( authors -- assoc ) diff --git a/extra/mason/child/child-tests.factor b/extra/mason/child/child-tests.factor index 7913d05b26..104360e1fa 100644 --- a/extra/mason/child/child-tests.factor +++ b/extra/mason/child/child-tests.factor @@ -1,7 +1,7 @@ IN: mason.child.tests USING: mason.child mason.config tools.test namespaces ; -[ { "make" "clean" "winnt-x86-32" } ] [ +[ { "make" "winnt-x86-32" } ] [ [ "winnt" target-os set "x86.32" target-cpu set @@ -9,7 +9,7 @@ USING: mason.child mason.config tools.test namespaces ; ] with-scope ] unit-test -[ { "make" "clean" "macosx-x86-32" } ] [ +[ { "make" "macosx-x86-32" } ] [ [ "macosx" target-os set "x86.32" target-cpu set @@ -17,7 +17,7 @@ USING: mason.child mason.config tools.test namespaces ; ] with-scope ] unit-test -[ { "gmake" "clean" "netbsd-ppc" } ] [ +[ { "gmake" "netbsd-ppc" } ] [ [ "netbsd" target-os set "ppc" target-cpu set From b0821229a1debae326f568c108e90541bda7eb23 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Tue, 18 Nov 2008 03:47:13 +0100 Subject: [PATCH 22/25] Emacs factor mode: indentation improvements. --- misc/factor.el | 107 +++++++++++++++++++++++++++++++------------------ 1 file changed, 67 insertions(+), 40 deletions(-) diff --git a/misc/factor.el b/misc/factor.el index 393ed26ae0..6204bdbef6 100644 --- a/misc/factor.el +++ b/misc/factor.el @@ -317,10 +317,9 @@ value from the existing code in the buffer." ;;; Factor mode indentation: -(defvar factor-indent-width factor-default-indent-width - "Indentation width in factor buffers. A local variable.") - -(make-variable-buffer-local 'factor-indent-width) +(make-variable-buffer-local + (defvar factor-indent-width factor-default-indent-width + "Indentation width in factor buffers. A local variable.")) (defconst factor--regexp-word-start (let ((sws '("" ":" "TUPLE" "MACRO" "MACRO:" "M"))) @@ -340,45 +339,67 @@ value from the existing code in the buffer." (setq iw (current-indentation)))))) iw)) -(defun factor--brackets-depth () - "Returns number of brackets, not closed on previous lines." - (syntax-ppss-depth - (save-excursion - (syntax-ppss (line-beginning-position))))) +(defsubst factor--ppss-brackets-depth () + (nth 0 (syntax-ppss))) + +(defsubst factor--ppss-brackets-start () + (nth 1 (syntax-ppss))) + +(defsubst factor--line-indent (pos) + (save-excursion (goto-char pos) (current-indentation))) + +(defconst factor--regex-closing-paren "[])}]") +(defsubst factor--at-closing-paren-p () + (looking-at factor--regex-closing-paren)) + +(defsubst factor--at-first-char-p () + (= (- (point) (line-beginning-position)) (current-indentation))) + +(defconst factor--regex-single-liner + (format "^%s" (regexp-opt '("USE:" "IN:" "PRIVATE>" " (factor--ppss-brackets-depth) 0)) + (let ((op (factor--ppss-brackets-start))) + (when (> (line-number-at-pos) (line-number-at-pos op)) + (if (factor--at-closing-paren-p) + (factor--line-indent op) + (+ (factor--line-indent op) factor-indent-width))))))) + +(defun factor--indent-definition () + (save-excursion + (beginning-of-line) + (when (looking-at "\\([^ ]\\|^\\)+:") 0))) + +(defun factor--indent-continuation () + (save-excursion + (forward-line -1) + (beginning-of-line) + (if (bobp) 0 + (if (looking-at "^[ \t]*$") + (factor--indent-continuation) + (if (factor--at-end-of-def) + (- (current-indentation) factor-indent-width) + (if (factor--indent-definition) + (+ (current-indentation) factor-indent-width) + (current-indentation))))))) (defun factor--calculate-indentation () "Calculate Factor indentation for line at point." - (let ((not-indented t) - (cur-indent 0)) - (save-excursion - (beginning-of-line) - (if (bobp) - (setq cur-indent 0) - (save-excursion - (while not-indented - ;; Check that we are inside open brackets - (save-excursion - (let ((cur-depth (factor--brackets-depth))) - (forward-line -1) - (setq cur-indent (+ (current-indentation) - (* factor-indent-width - (- cur-depth (factor--brackets-depth))))) - (setq not-indented nil))) - (forward-line -1) - ;; Check that we are after the end of previous word - (if (looking-at ".*;[ \t]*$") - (progn - (setq cur-indent (- (current-indentation) factor-indent-width)) - (setq not-indented nil)) - ;; Check that we are after the start of word - (if (looking-at factor--regexp-word-start) - (progn - (message "inword") - (setq cur-indent (+ (current-indentation) factor-indent-width)) - (setq not-indented nil)) - (if (bobp) - (setq not-indented nil)))))))) - cur-indent)) + (or (and (bobp) 0) + (factor--indent-definition) + (factor--indent-in-brackets) + (factor--indent-continuation) + 0)) (defun factor-indent-line () "Indent current line as Factor code" @@ -420,11 +441,15 @@ value from the existing code in the buffer." ;;; Factor listener mode +;;;###autoload (define-derived-mode factor-listener-mode comint-mode "Factor Listener") (define-key factor-listener-mode-map [f8] 'factor-refresh-all) +;;;###autoload (defun run-factor () + "Start a factor listener inside emacs, or switch to it if it +already exists." (interactive) (switch-to-buffer (make-comint-in-buffer "factor" nil (expand-file-name factor-binary) nil @@ -433,6 +458,8 @@ value from the existing code in the buffer." (factor-listener-mode)) (defun factor-refresh-all () + "Reload source files and documentation for all loaded +vocabularies which have been modified on disk." (interactive) (comint-send-string "*factor*" "refresh-all\n")) From 5697b75394ca218ed6041b3a4411d19dfddb9d46 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 20:48:02 -0600 Subject: [PATCH 23/25] Fix user-admin/new-user template --- extra/webapps/user-admin/new-user.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/webapps/user-admin/new-user.xml b/extra/webapps/user-admin/new-user.xml index 313c8e2702..0820dbcb64 100644 --- a/extra/webapps/user-admin/new-user.xml +++ b/extra/webapps/user-admin/new-user.xml @@ -37,7 +37,7 @@ Capabilities: -

    • +
    From d6dd9ea2a31bda9e6d6613945883e2f88cdcef5d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 21:21:57 -0600 Subject: [PATCH 24/25] Add workaround for Windows bttray.exe issue --- vm/os-windows-nt.c | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/vm/os-windows-nt.c b/vm/os-windows-nt.c index 54afd1c147..e22ea1446b 100755 --- a/vm/os-windows-nt.c +++ b/vm/os-windows-nt.c @@ -29,7 +29,13 @@ long exception_handler(PEXCEPTION_POINTERS pe) signal_number = ERROR_DIVIDE_BY_ZERO; c->EIP = (CELL)divide_by_zero_signal_handler_impl; } - else + /* If the Widcomm bluetooth stack is installed, the BTTray.exe process + injects code into running programs. For some reason this results in + random SEH exceptions with this (undocumented) exception code being + raised. The workaround seems to be ignoring this altogether, since that + is what happens if SEH is not enabled. Don't really have any idea what + this exception means. */ + else if(e->ExceptionCode != 0x40010006) { signal_number = 11; c->EIP = (CELL)misc_signal_handler_impl; From 930f3d0edc786e42c23ff352722f0d452b33e7a7 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 17 Nov 2008 21:26:16 -0600 Subject: [PATCH 25/25] locals: Allow 'local-reader' in literals --- basis/locals/locals.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor index e74ecf3dc9..7de9d10436 100644 --- a/basis/locals/locals.factor +++ b/basis/locals/locals.factor @@ -229,6 +229,8 @@ M: tuple rewrite-element M: local rewrite-element , ; +M: local-reader rewrite-element , ; + M: word rewrite-element literalize , ; M: object rewrite-element , ;