From 6b2192bde0dfc9ee36ebe432793e707164638537 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 20 May 2009 20:01:21 -0400 Subject: [PATCH 01/22] Fix compile error on GCC 4.x --- vm/callstack.cpp | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/vm/callstack.cpp b/vm/callstack.cpp index 38fb1e2b33..39988ae976 100755 --- a/vm/callstack.cpp +++ b/vm/callstack.cpp @@ -110,16 +110,18 @@ cell frame_scan(stack_frame *frame) switch(frame_type(frame)) { case QUOTATION_TYPE: - cell quot = frame_executing(frame); - if(quot == F) - return F; - else { - char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame); - char *quot_xt = (char *)(frame_code(frame) + 1); + cell quot = frame_executing(frame); + if(quot == F) + return F; + else + { + char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame); + char *quot_xt = (char *)(frame_code(frame) + 1); - return tag_fixnum(quot_code_offset_to_scan( - quot,(cell)(return_addr - quot_xt))); + return tag_fixnum(quot_code_offset_to_scan( + quot,(cell)(return_addr - quot_xt))); + } } case WORD_TYPE: return F; From 91834fb3360445c4574552bb1fd0eb5b43caa747 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 20 May 2009 19:30:35 -0500 Subject: [PATCH 02/22] fix error handling in random.windows if acquiring the crypto context fails --- basis/random/windows/windows.factor | 46 +++++++++++++++++--------- basis/windows/advapi32/advapi32.factor | 34 +++++++++++++++++++ 2 files changed, 65 insertions(+), 15 deletions(-) diff --git a/basis/random/windows/windows.factor b/basis/random/windows/windows.factor index 488deef41f..981b8ec14e 100644 --- a/basis/random/windows/windows.factor +++ b/basis/random/windows/windows.factor @@ -1,6 +1,7 @@ -USING: accessors alien.c-types byte-arrays continuations -kernel windows.advapi32 init namespaces random destructors -locals windows.errors ; +USING: accessors alien.c-types byte-arrays +combinators.short-circuit continuations destructors init kernel +locals namespaces random windows.advapi32 windows.errors +windows.kernel32 ; IN: random.windows TUPLE: windows-rng provider type ; @@ -12,22 +13,37 @@ C: windows-crypto-context M: windows-crypto-context dispose ( tuple -- ) handle>> 0 CryptReleaseContext win32-error=0/f ; -: factor-crypto-container ( -- string ) "FactorCryptoContainer" ; inline +CONSTANT: factor-crypto-container "FactorCryptoContainer" -:: (acquire-crypto-context) ( provider type flags -- handle ) - [let | handle [ "HCRYPTPROV" ] | - handle - factor-crypto-container - provider - type - flags - CryptAcquireContextW win32-error=0/f - handle *void* ] ; +:: (acquire-crypto-context) ( provider type flags -- handle ret ) + "HCRYPTPROV" :> handle + handle + factor-crypto-container + provider + type + flags + CryptAcquireContextW handle swap ; : acquire-crypto-context ( provider type -- handle ) - [ 0 (acquire-crypto-context) ] - [ drop CRYPT_NEWKEYSET (acquire-crypto-context) ] recover ; + 0 (acquire-crypto-context) + 0 = [ + GetLastError NTE_BAD_KEYSET = + [ drop f ] [ win32-error-string throw ] if + ] [ + *void* + ] if ; +: create-crypto-context ( provider type -- handle ) + CRYPT_NEWKEYSET (acquire-crypto-context) win32-error=0/f *void* ; + +ERROR: acquire-crypto-context-failed provider type ; + +: attempt-crypto-context ( provider type -- handle ) + { + [ acquire-crypto-context ] + [ create-crypto-context ] + [ acquire-crypto-context-failed ] + } 2|| ; : windows-crypto-context ( provider type -- context ) acquire-crypto-context ; diff --git a/basis/windows/advapi32/advapi32.factor b/basis/windows/advapi32/advapi32.factor index fd037cb2a0..6e040871f8 100644 --- a/basis/windows/advapi32/advapi32.factor +++ b/basis/windows/advapi32/advapi32.factor @@ -291,6 +291,40 @@ CONSTANT: SE_GROUP_ENABLED 4 CONSTANT: SE_GROUP_OWNER 8 CONSTANT: SE_GROUP_LOGON_ID -1073741824 +CONSTANT: NTE_BAD_UID HEX: 80090001 +CONSTANT: NTE_BAD_HASH HEX: 80090002 +CONSTANT: NTE_BAD_KEY HEX: 80090003 +CONSTANT: NTE_BAD_LEN HEX: 80090004 +CONSTANT: NTE_BAD_DATA HEX: 80090005 +CONSTANT: NTE_BAD_SIGNATURE HEX: 80090006 +CONSTANT: NTE_BAD_VER HEX: 80090007 +CONSTANT: NTE_BAD_ALGID HEX: 80090008 +CONSTANT: NTE_BAD_FLAGS HEX: 80090009 +CONSTANT: NTE_BAD_TYPE HEX: 8009000A +CONSTANT: NTE_BAD_KEY_STATE HEX: 8009000B +CONSTANT: NTE_BAD_HASH_STATE HEX: 8009000C +CONSTANT: NTE_NO_KEY HEX: 8009000D +CONSTANT: NTE_NO_MEMORY HEX: 8009000E +CONSTANT: NTE_EXISTS HEX: 8009000F +CONSTANT: NTE_PERM HEX: 80090010 +CONSTANT: NTE_NOT_FOUND HEX: 80090011 +CONSTANT: NTE_DOUBLE_ENCRYPT HEX: 80090012 +CONSTANT: NTE_BAD_PROVIDER HEX: 80090013 +CONSTANT: NTE_BAD_PROV_TYPE HEX: 80090014 +CONSTANT: NTE_BAD_PUBLIC_KEY HEX: 80090015 +CONSTANT: NTE_BAD_KEYSET HEX: 80090016 +CONSTANT: NTE_PROV_TYPE_NOT_DEF HEX: 80090017 +CONSTANT: NTE_PROV_TYPE_ENTRY_BAD HEX: 80090018 +CONSTANT: NTE_KEYSET_NOT_DEF HEX: 80090019 +CONSTANT: NTE_KEYSET_ENTRY_BAD HEX: 8009001A +CONSTANT: NTE_PROV_TYPE_NO_MATCH HEX: 8009001B +CONSTANT: NTE_SIGNATURE_FILE_BAD HEX: 8009001C +CONSTANT: NTE_PROVIDER_DLL_FAIL HEX: 8009001D +CONSTANT: NTE_PROV_DLL_NOT_FOUND HEX: 8009001E +CONSTANT: NTE_BAD_KEYSET_PARAM HEX: 8009001F +CONSTANT: NTE_FAIL HEX: 80090020 +CONSTANT: NTE_SYS_ERR HEX: 80090021 + ! SID is a variable length structure TYPEDEF: void* PSID From 52e959e6a1920ea5df3a40f2da8e632d187b74d7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 20 May 2009 19:40:52 -0500 Subject: [PATCH 03/22] call the word that attempts both crypto contexts --- basis/random/windows/windows.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/random/windows/windows.factor b/basis/random/windows/windows.factor index 981b8ec14e..c8e08c9abe 100644 --- a/basis/random/windows/windows.factor +++ b/basis/random/windows/windows.factor @@ -46,7 +46,7 @@ ERROR: acquire-crypto-context-failed provider type ; } 2|| ; : windows-crypto-context ( provider type -- context ) - acquire-crypto-context ; + attempt-crypto-context ; M: windows-rng random-bytes* ( n tuple -- bytes ) [ From ef3656aea866e1983ebdd9786fe0eb7b038459cf Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 20 May 2009 20:06:05 -0500 Subject: [PATCH 04/22] try to fall back on AES if RSA isn't found --- basis/random/windows/windows.factor | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/basis/random/windows/windows.factor b/basis/random/windows/windows.factor index c8e08c9abe..aa9404fbb2 100644 --- a/basis/random/windows/windows.factor +++ b/basis/random/windows/windows.factor @@ -60,9 +60,13 @@ M: windows-rng random-bytes* ( n tuple -- bytes ) MS_DEF_PROV PROV_RSA_FULL system-random-generator set-global - MS_STRONG_PROV - PROV_RSA_FULL secure-random-generator set-global + [ + MS_STRONG_PROV + PROV_RSA_FULL secure-random-generator set-global + ] [ + drop + MS_ENH_RSA_AES_PROV + PROV_RSA_AES secure-random-generator set-global + ] recover - ! MS_ENH_RSA_AES_PROV - ! PROV_RSA_AES secure-random-generator set-global ] "random.windows" add-init-hook From 57d38b1dd0dcf04edc562307440f9e5cce14f764 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 20 May 2009 20:08:26 -0500 Subject: [PATCH 05/22] better factoring --- basis/random/windows/windows.factor | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/basis/random/windows/windows.factor b/basis/random/windows/windows.factor index aa9404fbb2..6dce078d67 100644 --- a/basis/random/windows/windows.factor +++ b/basis/random/windows/windows.factor @@ -60,13 +60,8 @@ M: windows-rng random-bytes* ( n tuple -- bytes ) MS_DEF_PROV PROV_RSA_FULL system-random-generator set-global - [ - MS_STRONG_PROV - PROV_RSA_FULL secure-random-generator set-global - ] [ - drop - MS_ENH_RSA_AES_PROV - PROV_RSA_AES secure-random-generator set-global - ] recover + [ MS_STRONG_PROV PROV_RSA_FULL ] + [ drop MS_ENH_RSA_AES_PROV PROV_RSA_AES ] recover + secure-random-generator set-global ] "random.windows" add-init-hook From 7d328011e8c3c9c23fa8ec9d4f8c036384171261 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 21 May 2009 00:08:43 -0500 Subject: [PATCH 06/22] Working on webapps.mason --- basis/io/launcher/launcher.factor | 2 +- extra/mason/common/common.factor | 11 +- extra/mason/notify/notify.factor | 6 +- extra/mason/notify/server/server.factor | 55 ++++++++-- extra/mason/report/report.factor | 28 ++--- extra/webapps/mason/download.xml | 23 ++++ extra/webapps/mason/mason.factor | 138 +++++++++++++++++++----- 7 files changed, 202 insertions(+), 61 deletions(-) create mode 100644 extra/webapps/mason/download.xml diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor index 7451499978..f4978672d9 100755 --- a/basis/io/launcher/launcher.factor +++ b/basis/io/launcher/launcher.factor @@ -264,7 +264,7 @@ M: output-process-error error. : try-output-process ( command -- ) >process +stdout+ >>stderr - +closed+ >>stdin + [ +closed+ or ] change-stdin utf8 [ stream-contents ] [ dup wait-for-process ] bi* 0 = [ 2drop ] [ output-process-error ] if ; diff --git a/extra/mason/common/common.factor b/extra/mason/common/common.factor index 4ac5767009..d54a17ff91 100755 --- a/extra/mason/common/common.factor +++ b/extra/mason/common/common.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! Copyright (C) 2008, 2009 Eduardo Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces sequences splitting system accessors math.functions make io io.files io.pathnames io.directories @@ -13,10 +13,7 @@ SYMBOL: current-git-id : short-running-process ( command -- ) #! Give network operations and shell commands at most #! 15 minutes to complete, to catch hangs. - >process - 15 minutes >>timeout - +closed+ >>stdin - try-output-process ; + >process 15 minutes >>timeout try-output-process ; HOOK: really-delete-tree os ( path -- ) @@ -45,10 +42,6 @@ M: unix really-delete-tree delete-tree ; dup utf8 file-lines parse-fresh [ "Empty file: " swap append throw ] [ nip first ] if-empty ; -: cat ( file -- ) utf8 file-contents print ; - -: cat-n ( file n -- ) [ utf8 file-lines ] dip short tail* [ print ] each ; - : to-file ( object file -- ) utf8 [ . ] with-file-writer ; : datestamp ( timestamp -- string ) diff --git a/extra/mason/notify/notify.factor b/extra/mason/notify/notify.factor index ccabccdf8b..87447e48cc 100644 --- a/extra/mason/notify/notify.factor +++ b/extra/mason/notify/notify.factor @@ -16,7 +16,7 @@ IN: mason.notify ] { } make prepend [ 5 ] 2dip '[ - _ [ +closed+ ] unless* >>stdin + _ >>stdin _ >>command short-running-process ] retry @@ -49,4 +49,6 @@ IN: mason.notify ] bi ; : notify-release ( archive-name -- ) - "Uploaded " prepend [ print flush ] [ mason-tweet ] bi ; + [ "Uploaded " prepend [ print flush ] [ mason-tweet ] bi ] + [ f swap "release" swap 2array status-notify ] + bi ; diff --git a/extra/mason/notify/server/server.factor b/extra/mason/notify/server/server.factor index cc055e38d8..9ed29aef45 100644 --- a/extra/mason/notify/server/server.factor +++ b/extra/mason/notify/server/server.factor @@ -1,26 +1,44 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors combinators combinators.smart command-line db -db.sqlite db.tuples db.types io kernel namespaces sequences ; +db.sqlite db.tuples db.types io io.encodings.utf8 io.files +present kernel namespaces sequences calendar ; IN: mason.notify.server CONSTANT: +starting+ "starting" CONSTANT: +make-vm+ "make-vm" CONSTANT: +boot+ "boot" CONSTANT: +test+ "test" -CONSTANT: +clean+ "clean" -CONSTANT: +dirty+ "dirty" +CONSTANT: +clean+ "status-clean" +CONSTANT: +dirty+ "status-dirty" +CONSTANT: +error+ "status-error" -TUPLE: builder host-name os cpu clean-git-id last-git-id last-report current-git-id status ; +TUPLE: builder +host-name os cpu +clean-git-id clean-timestamp +last-release release-git-id +last-git-id last-timestamp last-report +current-git-id current-timestamp +status ; builder "BUILDERS" { { "host-name" "HOST_NAME" TEXT +user-assigned-id+ } { "os" "OS" TEXT +user-assigned-id+ } { "cpu" "CPU" TEXT +user-assigned-id+ } + { "clean-git-id" "CLEAN_GIT_ID" TEXT } + { "clean-timestamp" "CLEAN_TIMESTAMP" TIMESTAMP } + + { "last-release" "LAST_RELEASE" TEXT } + { "release-git-id" "RELEASE_GIT_ID" TEXT } + { "last-git-id" "LAST_GIT_ID" TEXT } + { "last-timestamp" "LAST_TIMESTAMP" TIMESTAMP } { "last-report" "LAST_REPORT" TEXT } + { "current-git-id" "CURRENT_GIT_ID" TEXT } + ! Can't name it CURRENT_TIMESTAMP because of bug in db library + { "current-timestamp" "CURR_TIMESTAMP" TIMESTAMP } { "status" "STATUS" TEXT } } define-persistent @@ -49,14 +67,23 @@ SYMBOLS: host-name target-os target-cpu message message-arg ; : make-vm ( builder -- ) +make-vm+ >>status drop ; -: boot ( report -- ) +boot+ >>status drop ; +: boot ( builder -- ) +boot+ >>status drop ; -: test ( report -- ) +test+ >>status drop ; +: test ( builder -- ) +test+ >>status drop ; : report ( builder status content -- ) [ >>status ] [ >>last-report ] bi* - dup status>> +clean+ = [ dup current-git-id>> >>clean-git-id ] when + dup status>> +clean+ = [ + dup current-git-id>> >>clean-git-id + dup current-timestamp>> >>clean-timestamp + ] when dup current-git-id>> >>last-git-id + dup current-timestamp>> >>last-timestamp + drop ; + +: release ( builder name -- ) + >>last-release + dup clean-git-id>> >>release-git-id drop ; : update-builder ( builder -- ) @@ -66,17 +93,25 @@ SYMBOLS: host-name target-os target-cpu message message-arg ; { "boot" [ boot ] } { "test" [ test ] } { "report" [ message-arg get contents report ] } + { "release" [ message-arg get release ] } } case ; : mason-db ( -- db ) "resource:mason.db" ; -: handle-update ( command-line -- ) +: handle-update ( command-line timestamp -- ) mason-db [ - parse-args find-builder + [ parse-args find-builder ] dip >>current-timestamp [ update-builder ] [ update-tuple ] bi ] with-db ; +CONSTANT: log-file "resource:mason.log" + +: log-update ( command-line timestamp -- ) + log-file utf8 [ + present write ": " write " " join print + ] with-file-appender ; + : main ( -- ) - command-line get handle-update ; + command-line get now [ log-update ] [ handle-update ] 2bi ; MAIN: main diff --git a/extra/mason/report/report.factor b/extra/mason/report/report.factor index e74db9a1ae..52237171cf 100644 --- a/extra/mason/report/report.factor +++ b/extra/mason/report/report.factor @@ -59,13 +59,13 @@ IN: mason.report "test-log" "Tests failed" failed-report ; : timings-table ( -- xml ) - { - $ boot-time-file - $ load-time-file - $ test-time-file - $ help-lint-time-file - $ benchmark-time-file - $ html-help-time-file + ${ + boot-time-file + load-time-file + test-time-file + help-lint-time-file + benchmark-time-file + html-help-time-file } [ dup eval-file milli-seconds>time [XML <-><-> XML] @@ -121,13 +121,13 @@ IN: mason.report ] with-report ; : build-clean? ( -- ? ) - { - [ load-all-vocabs-file eval-file empty? ] - [ test-all-vocabs-file eval-file empty? ] - [ help-lint-vocabs-file eval-file empty? ] - [ compiler-errors-file eval-file empty? ] - [ benchmark-error-vocabs-file eval-file empty? ] - } 0&& ; + ${ + load-all-vocabs-file + test-all-vocabs-file + help-lint-vocabs-file + compiler-errors-file + benchmark-error-vocabs-file + } [ eval-file empty? ] all? ; : success ( -- status ) successful-report build-clean? status-clean status-dirty ? ; \ No newline at end of file diff --git a/extra/webapps/mason/download.xml b/extra/webapps/mason/download.xml new file mode 100644 index 0000000000..2b1bb76f64 --- /dev/null +++ b/extra/webapps/mason/download.xml @@ -0,0 +1,23 @@ + + + + + + + Factor binary package for <t:label t:name="platform" /> + + +

Factor binary package for

+ +

Requirements:

+ + +

Download

+ +

This package was built from GIT ID .

+ +

Once you download Factor, you can get started with the language.

+ + + + diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor index 74c459e38e..7e76de736d 100644 --- a/extra/webapps/mason/mason.factor +++ b/extra/webapps/mason/mason.factor @@ -1,11 +1,28 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays combinators db db.tuples furnace.actions -http.server.responses kernel mason.platform mason.notify.server -mason.report math.order sequences sorting splitting xml.syntax -xml.writer io.pathnames io.encodings.utf8 io.files ; +http.server.responses http.server.dispatchers kernel mason.platform +mason.notify.server mason.report math.order sequences sorting +splitting xml.syntax xml.writer io.pathnames io.encodings.utf8 +io.files present validators html.forms furnace.db assocs urls ; IN: webapps.mason +TUPLE: mason-app < dispatcher ; + +: validate-os/cpu ( -- ) + { + { "os" [ v-one-line ] } + { "cpu" [ v-one-line ] } + } validate-params ; + +: current-builder ( -- builder ) + builder new "os" value >>os "cpu" value >>cpu select-tuple ; + +: ( -- action ) + + [ validate-os/cpu ] >>init + [ current-builder last-report>> "text/html" ] >>display ; + : log-file ( -- path ) home "mason.log" append-path ; : recent-events ( -- xml ) @@ -20,24 +37,48 @@ IN: webapps.mason [XML <-> for <-> XML] ; : current-status ( builder -- xml ) - dup status>> { - { "status-dirty" [ drop "Dirty" ] } - { "status-clean" [ drop "Clean" ] } - { "status-error" [ drop "Error" ] } - { "starting" [ "Starting" building ] } - { "make-vm" [ "Compiling VM" building ] } - { "boot" [ "Bootstrapping" building ] } - { "test" [ "Testing" building ] } - [ 2drop "Unknown" ] - } case ; + [ + dup status>> { + { +dirty+ [ drop "Dirty" ] } + { +clean+ [ drop "Clean" ] } + { +error+ [ drop "Error" ] } + { +starting+ [ "Starting build" building ] } + { +make-vm+ [ "Compiling VM" building ] } + { +boot+ [ "Bootstrapping" building ] } + { +test+ [ "Testing" building ] } + [ 2drop "Unknown" ] + } case + ] [ current-timestamp>> present " (as of " ")" surround ] bi 2array ; + +: build-status ( git-id timestamp -- xml ) + over [ [ git-link ] [ present ] bi* " (built on " ")" surround 2array ] [ 2drop f ] if ; + +: binaries-url ( builder -- url ) + [ os>> ] [ cpu>> ] bi (platform) "http://downloads.factorcode.org/" prepend ; + +: url-link ( url -- xml ) + dup [XML ><-> XML] ; + +: latest-binary-link ( builder -- xml ) + [ URL" download" ] dip + [ os>> "os" set-query-param ] + [ cpu>> "cpu" set-query-param ] bi + [XML >Latest download XML] ; : binaries-link ( builder -- link ) - [ os>> ] [ cpu>> ] bi (platform) "http://downloads.factorcode.org/" prepend - dup [XML ><-> XML] ; + binaries-url url-link ; + +: clean-image-url ( builder -- url ) + [ os>> ] [ cpu>> ] bi (platform) "http://factorcode.org/images/clean/" prepend ; : clean-image-link ( builder -- link ) - [ os>> ] [ cpu>> ] bi (platform) "http://factorcode.org/images/clean/" prepend - dup [XML ><-> XML] ; + clean-image-url url-link ; + +: report-link ( builder -- xml ) + [ URL" report" ] dip + [ os>> "os" set-query-param ] + [ cpu>> "cpu" set-query-param ] bi + [XML >Latest build report XML] ; : machine-table ( builder -- xml ) { @@ -45,10 +86,12 @@ IN: webapps.mason [ cpu>> ] [ host-name>> "." split1 drop ] [ current-status ] - [ last-git-id>> dup [ git-link ] when ] - [ clean-git-id>> dup [ git-link ] when ] + [ [ last-git-id>> ] [ last-timestamp>> ] bi build-status ] + [ [ clean-git-id>> ] [ clean-timestamp>> ] bi build-status ] [ binaries-link ] [ clean-image-link ] + [ report-link ] + [ latest-binary-link ] } cleave [XML

<-> / <->

@@ -60,6 +103,8 @@ IN: webapps.mason Binaries:<-> Clean images:<-> + + <-> | <-> XML] ; : machine-report ( -- xml ) @@ -67,7 +112,7 @@ IN: webapps.mason [ [ [ os>> ] [ cpu>> ] bi 2array ] compare ] sort [ machine-table ] map ; -: build-farm-report ( -- xml ) +: build-farm-summary ( -- xml ) recent-events machine-report [XML @@ -77,9 +122,52 @@ IN: webapps.mason XML] ; -: ( -- action ) +: ( -- action ) - [ - mason-db [ build-farm-report xml>string ] with-db - "text/html" - ] >>display ; \ No newline at end of file + [ build-farm-summary xml>string "text/html" ] >>display ; + +TUPLE: builder-link href title ; + +C: builder-link + +: requirements ( builder -- xml ) + [ + os>> { + { "winnt" "Windows XP (also tested on Vista)" } + { "macosx" "Mac OS X 10.5 Leopard" } + { "linux" "Linux 2.6.16 with GLIBC 2.4" } + { "freebsd" "FreeBSD 7.0" } + { "netbsd" "NetBSD 4.0" } + { "openbsd" "OpenBSD 4.2" } + } at + ] [ + dup cpu>> "x86-32" = [ + os>> { + { [ dup { "winnt" "linux" } member? ] [ drop "Intel Pentium 4, Core Duo, or other x86 chip with SSE2 support. Note that 32-bit Athlon XP processors do not support SSE2." ] } + { [ dup { "freebsd" "netbsd" "openbsd" } member? ] [ drop "Intel Pentium Pro or better" ] } + { [ t ] [ drop f ] } + } cond + ] [ drop f ] if + ] bi + 2array sift [ [XML
  • <->
    • XML] ] map [XML
      <->
    XML] ; + +: ( -- action ) + + [ + validate-os/cpu + "os" value "cpu" value (platform) "platform" set-value + current-builder + [ latest-binary-link "package" set-value ] + [ release-git-id>> git-link "git-id" set-value ] + [ requirements "requirements" set-value ] + tri + ] >>init + { mason-app "download" } >>template ; + +: ( -- dispatcher ) + mason-app new-dispatcher + "" add-responder + "report" add-responder + "download" add-responder + mason-db ; + From c5d440700d6395f2c8dfc33817f8a0f7da451619 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 21 May 2009 18:49:22 -0500 Subject: [PATCH 07/22] 0.0 neg ought to be -0.0 --- core/math/math-tests.factor | 3 +++ core/math/math.factor | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/core/math/math-tests.factor b/core/math/math-tests.factor index b7cc51e669..831430cf24 100644 --- a/core/math/math-tests.factor +++ b/core/math/math-tests.factor @@ -26,6 +26,9 @@ IN: math.tests [ f ] [ 0 fp-nan? ] unit-test [ t ] [ 0 fp-infinity? ] unit-test +[ t ] [ 0.0 neg -0.0 fp-bitwise= ] unit-test +[ t ] [ -0.0 neg 0.0 fp-bitwise= ] unit-test + [ 0.0 ] [ -0.0 next-float ] unit-test [ t ] [ 1.0 dup next-float < ] unit-test [ t ] [ -1.0 dup next-float < ] unit-test diff --git a/core/math/math.factor b/core/math/math.factor index da9bc4d1b5..28efbaa26e 100755 --- a/core/math/math.factor +++ b/core/math/math.factor @@ -60,7 +60,7 @@ PRIVATE> : 1- ( x -- y ) 1 - ; inline : 2/ ( x -- y ) -1 shift ; inline : sq ( x -- y ) dup * ; inline -: neg ( x -- -x ) 0 swap - ; inline +: neg ( x -- -x ) -1 * ; inline : recip ( x -- y ) 1 swap / ; inline : sgn ( x -- n ) dup 0 < [ drop -1 ] [ 0 > 1 0 ? ] if ; inline : ?1+ ( x -- y ) [ 1 + ] [ 0 ] if* ; inline From a150fc9a7f5c63c7880738963a228d77c0f2b4cd Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 21 May 2009 19:15:04 -0500 Subject: [PATCH 08/22] webapps.mason: Now renders a download grid with links to build machine status and download pages --- extra/mason/build/build.factor | 20 ++-- extra/mason/child/child.factor | 5 +- extra/mason/report/report.factor | 7 +- extra/webapps/mason/download.xml | 13 +++ extra/webapps/mason/mason.factor | 178 ++++++++++++++++--------------- 5 files changed, 126 insertions(+), 97 deletions(-) diff --git a/extra/mason/build/build.factor b/extra/mason/build/build.factor index a9e32e5315..f2018449fc 100644 --- a/extra/mason/build/build.factor +++ b/extra/mason/build/build.factor @@ -1,12 +1,11 @@ ! Copyright (C) 2008, 2009 Eduardo Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel calendar io.directories io.encodings.utf8 -io.files io.launcher namespaces prettyprint mason.child mason.cleanup -mason.common mason.help mason.release mason.report mason.email -mason.notify ; -IN: mason.build - +io.files io.launcher namespaces prettyprint combinators mason.child +mason.cleanup mason.common mason.help mason.release mason.report +mason.email mason.notify ; QUALIFIED: continuations +IN: mason.build : create-build-dir ( -- ) now datestamp stamp set @@ -18,11 +17,12 @@ QUALIFIED: continuations "git" "clone" builds/factor 3array short-running-process ; : begin-build ( -- ) - "factor" [ git-id ] with-directory - [ "git-id" to-file ] - [ current-git-id set ] - [ notify-begin-build ] - tri ; + "factor" [ git-id ] with-directory { + [ "git-id" to-file ] + [ "factor/git-id" to-file ] + [ current-git-id set ] + [ notify-begin-build ] + } cleave ; : build ( -- ) create-build-dir diff --git a/extra/mason/child/child.factor b/extra/mason/child/child.factor index 8132e62078..4a9a864c40 100755 --- a/extra/mason/child/child.factor +++ b/extra/mason/child/child.factor @@ -64,7 +64,10 @@ IN: mason.child MACRO: recover-cond ( alist -- ) dup { [ length 1 = ] [ first callable? ] } 1&& - [ first ] [ [ first first2 ] [ rest ] bi '[ _ _ [ _ recover-cond ] recover-else ] ] if ; + [ first ] [ + [ first first2 ] [ rest ] bi + '[ _ _ [ _ recover-cond ] recover-else ] + ] if ; : build-child ( -- status ) copy-image diff --git a/extra/mason/report/report.factor b/extra/mason/report/report.factor index 52237171cf..3ed332abf2 100644 --- a/extra/mason/report/report.factor +++ b/extra/mason/report/report.factor @@ -4,13 +4,16 @@ USING: benchmark combinators.smart debugger fry io assocs io.encodings.utf8 io.files io.sockets io.streams.string kernel locals mason.common mason.config mason.platform math namespaces prettyprint sequences xml.syntax xml.writer combinators.short-circuit -literals ; +literals splitting ; IN: mason.report +: short-host-name ( -- string ) + host-name "." split1 drop ; + : common-report ( -- xml ) target-os get target-cpu get - host-name + short-host-name build-dir current-git-id get [XML diff --git a/extra/webapps/mason/download.xml b/extra/webapps/mason/download.xml index 2b1bb76f64..af4ac0214d 100644 --- a/extra/webapps/mason/download.xml +++ b/extra/webapps/mason/download.xml @@ -17,6 +17,19 @@

    This package was built from GIT ID .

    Once you download Factor, you can get started with the language.

    + +

    Build machine information

    + + + + + + + + +
    Host name:
    Current status:
    Last build:
    Last clean build:
    Binaries:
    Clean images:
    + +

    diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor index 7e76de736d..4d42617520 100644 --- a/extra/webapps/mason/mason.factor +++ b/extra/webapps/mason/mason.factor @@ -4,11 +4,66 @@ USING: accessors arrays combinators db db.tuples furnace.actions http.server.responses http.server.dispatchers kernel mason.platform mason.notify.server mason.report math.order sequences sorting splitting xml.syntax xml.writer io.pathnames io.encodings.utf8 -io.files present validators html.forms furnace.db assocs urls ; +io.files present validators html.forms furnace.db urls ; +FROM: assocs => at keys values ; IN: webapps.mason TUPLE: mason-app < dispatcher ; +: link ( url label -- xml ) + [XML ><-> XML] ; + +: download-link ( builder label -- xml ) + [ + [ URL" download" ] dip + [ os>> "os" set-query-param ] + [ cpu>> "cpu" set-query-param ] bi + ] dip link ; + +: download-grid-cell ( cpu os -- xml ) + builder new swap >>os swap >>cpu select-tuple dup + [ + dup last-release>> dup + [ "." split1 drop 16 tail* 6 head* download-link ] [ 2drop f ] if + ] when + [XML <-> XML] ; + +CONSTANT: oses +{ + { "winnt" "Windows" } + { "macosx" "Mac OS X" } + { "linux" "Linux" } + { "freebsd" "FreeBSD" } + { "netbsd" "NetBSD" } + { "openbsd" "OpenBSD" } +} + +CONSTANT: cpus +{ + { "x86.32" "x86" } + { "x86.64" "x86-64" } + { "ppc" "PowerPC" } +} + +: download-grid ( -- xml ) + oses + [ values [ [XML <-> XML] ] map ] + [ + keys + cpus [ + [ nip second ] [ first ] 2bi [ + swap download-grid-cell + ] curry map [XML <-><-> XML] + ] with map + ] bi [XML <->
    <->
    XML] ; + +: ( -- action ) + + [ + download-grid + xml>string "text/html" + ] >>display ; + : validate-os/cpu ( -- ) { { "os" [ v-one-line ] } @@ -23,11 +78,6 @@ TUPLE: mason-app < dispatcher ; [ validate-os/cpu ] >>init [ current-builder last-report>> "text/html" ] >>display ; -: log-file ( -- path ) home "mason.log" append-path ; - -: recent-events ( -- xml ) - log-file utf8 10 file-tail [XML 
    <->
    XML] ; - : git-link ( id -- link ) [ "http://github.com/slavapestov/factor/commit/" prepend ] keep [XML ><-> XML] ; @@ -36,19 +86,22 @@ TUPLE: mason-app < dispatcher ; swap current-git-id>> git-link [XML <-> for <-> XML] ; +: status-string ( builder -- string ) + dup status>> { + { +dirty+ [ drop "Dirty" ] } + { +clean+ [ drop "Clean" ] } + { +error+ [ drop "Error" ] } + { +starting+ [ "Starting build" building ] } + { +make-vm+ [ "Compiling VM" building ] } + { +boot+ [ "Bootstrapping" building ] } + { +test+ [ "Testing" building ] } + [ 2drop "Unknown" ] + } case ; + : current-status ( builder -- xml ) - [ - dup status>> { - { +dirty+ [ drop "Dirty" ] } - { +clean+ [ drop "Clean" ] } - { +error+ [ drop "Error" ] } - { +starting+ [ "Starting build" building ] } - { +make-vm+ [ "Compiling VM" building ] } - { +boot+ [ "Bootstrapping" building ] } - { +test+ [ "Testing" building ] } - [ 2drop "Unknown" ] - } case - ] [ current-timestamp>> present " (as of " ")" surround ] bi 2array ; + [ status-string ] + [ current-timestamp>> present " (as of " ")" surround ] bi + 2array ; : build-status ( git-id timestamp -- xml ) over [ [ git-link ] [ present ] bi* " (built on " ")" surround 2array ] [ 2drop f ] if ; @@ -56,23 +109,17 @@ TUPLE: mason-app < dispatcher ; : binaries-url ( builder -- url ) [ os>> ] [ cpu>> ] bi (platform) "http://downloads.factorcode.org/" prepend ; -: url-link ( url -- xml ) - dup [XML ><-> XML] ; - : latest-binary-link ( builder -- xml ) - [ URL" download" ] dip - [ os>> "os" set-query-param ] - [ cpu>> "cpu" set-query-param ] bi - [XML >Latest download XML] ; + [ binaries-url ] [ last-release>> ] bi [ "/" glue ] keep link ; : binaries-link ( builder -- link ) - binaries-url url-link ; + binaries-url dup link ; : clean-image-url ( builder -- url ) [ os>> ] [ cpu>> ] bi (platform) "http://factorcode.org/images/clean/" prepend ; : clean-image-link ( builder -- link ) - clean-image-url url-link ; + clean-image-url dup link ; : report-link ( builder -- xml ) [ URL" report" ] dip @@ -80,56 +127,6 @@ TUPLE: mason-app < dispatcher ; [ cpu>> "cpu" set-query-param ] bi [XML >Latest build report XML] ; -: machine-table ( builder -- xml ) - { - [ os>> ] - [ cpu>> ] - [ host-name>> "." split1 drop ] - [ current-status ] - [ [ last-git-id>> ] [ last-timestamp>> ] bi build-status ] - [ [ clean-git-id>> ] [ clean-timestamp>> ] bi build-status ] - [ binaries-link ] - [ clean-image-link ] - [ report-link ] - [ latest-binary-link ] - } cleave - [XML -

    <-> / <->

    - - - - - - - -
    Host name:<->
    Current status:<->
    Last build:<->
    Last clean build:<->
    Binaries:<->
    Clean images:<->
    - - <-> | <-> - XML] ; - -: machine-report ( -- xml ) - builder new select-tuples - [ [ [ os>> ] [ cpu>> ] bi 2array ] compare ] sort - [ machine-table ] map ; - -: build-farm-summary ( -- xml ) - recent-events - machine-report - [XML - - Factor build farm -

    Recent events

    <->

    Machine status

    <-> - - XML] ; - -: ( -- action ) - - [ build-farm-summary xml>string "text/html" ] >>display ; - -TUPLE: builder-link href title ; - -C: builder-link - : requirements ( builder -- xml ) [ os>> { @@ -141,7 +138,7 @@ C: builder-link { "openbsd" "OpenBSD 4.2" } } at ] [ - dup cpu>> "x86-32" = [ + dup cpu>> "x86.32" = [ os>> { { [ dup { "winnt" "linux" } member? ] [ drop "Intel Pentium 4, Core Duo, or other x86 chip with SSE2 support. Note that 32-bit Athlon XP processors do not support SSE2." ] } { [ dup { "freebsd" "netbsd" "openbsd" } member? ] [ drop "Intel Pentium Pro or better" ] } @@ -151,23 +148,36 @@ C: builder-link ] bi 2array sift [ [XML
  • <->
    • XML] ] map [XML
      <->
    XML] ; +: last-build-status ( builder -- xml ) + [ last-git-id>> ] [ last-timestamp>> ] bi build-status ; + +: clean-build-status ( builder -- xml ) + [ clean-git-id>> ] [ clean-timestamp>> ] bi build-status ; + : ( -- action ) [ validate-os/cpu "os" value "cpu" value (platform) "platform" set-value - current-builder - [ latest-binary-link "package" set-value ] - [ release-git-id>> git-link "git-id" set-value ] - [ requirements "requirements" set-value ] - tri + current-builder { + [ latest-binary-link "package" set-value ] + [ release-git-id>> git-link "git-id" set-value ] + [ requirements "requirements" set-value ] + [ host-name>> "host-name" set-value ] + [ current-status "status" set-value ] + [ last-build-status "last-build" set-value ] + [ clean-build-status "last-clean-build" set-value ] + [ binaries-link "binaries" set-value ] + [ clean-image-link "clean-images" set-value ] + [ report-link "last-report" set-value ] + } cleave ] >>init { mason-app "download" } >>template ; : ( -- dispatcher ) mason-app new-dispatcher - "" add-responder "report" add-responder "download" add-responder + "grid" add-responder mason-db ; From 16b39e2d6c438b173a17c27e580247475c651c47 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 21 May 2009 19:19:12 -0500 Subject: [PATCH 09/22] mason: use short host name not fully qualified host name --- extra/mason/common/common.factor | 5 ++++- extra/mason/notify/notify.factor | 2 +- extra/mason/report/report.factor | 3 --- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/extra/mason/common/common.factor b/extra/mason/common/common.factor index d54a17ff91..22e37f8a8c 100755 --- a/extra/mason/common/common.factor +++ b/extra/mason/common/common.factor @@ -5,9 +5,12 @@ math.functions make io io.files io.pathnames io.directories io.directories.hierarchy io.launcher io.encodings.utf8 prettyprint combinators.short-circuit parser combinators calendar calendar.format arrays mason.config locals debugger fry -continuations strings ; +continuations strings io.sockets ; IN: mason.common +: short-host-name ( -- string ) + host-name "." split1 drop ; + SYMBOL: current-git-id : short-running-process ( command -- ) diff --git a/extra/mason/notify/notify.factor b/extra/mason/notify/notify.factor index 87447e48cc..122c8a47cd 100644 --- a/extra/mason/notify/notify.factor +++ b/extra/mason/notify/notify.factor @@ -10,7 +10,7 @@ IN: mason.notify [ "ssh" , status-host get , "-l" , status-username get , "./mason-notify" , - host-name , + short-host-name , target-cpu get , target-os get , ] { } make prepend diff --git a/extra/mason/report/report.factor b/extra/mason/report/report.factor index 3ed332abf2..4a2138323c 100644 --- a/extra/mason/report/report.factor +++ b/extra/mason/report/report.factor @@ -7,9 +7,6 @@ prettyprint sequences xml.syntax xml.writer combinators.short-circuit literals splitting ; IN: mason.report -: short-host-name ( -- string ) - host-name "." split1 drop ; - : common-report ( -- xml ) target-os get target-cpu get From 9685aea6fecbd3ff295e048f61a98df81f162e61 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 21 May 2009 20:55:44 -0500 Subject: [PATCH 10/22] homogeneous coordinates coated in nurbsauce --- basis/math/vectors/vectors.factor | 3 + .../affine-transforms.factor | 3 - extra/math/vectors/homogeneous/authors.txt | 1 + .../homogeneous/homogeneous-tests.factor | 15 ++++ .../vectors/homogeneous/homogeneous.factor | 36 +++++++++ extra/math/vectors/homogeneous/summary.txt | 1 + extra/nurbs/authors.txt | 1 + extra/nurbs/nurbs-tests.factor | 32 ++++++++ extra/nurbs/nurbs.factor | 73 +++++++++++++++++++ extra/nurbs/summary.txt | 1 + 10 files changed, 163 insertions(+), 3 deletions(-) create mode 100644 extra/math/vectors/homogeneous/authors.txt create mode 100644 extra/math/vectors/homogeneous/homogeneous-tests.factor create mode 100644 extra/math/vectors/homogeneous/homogeneous.factor create mode 100644 extra/math/vectors/homogeneous/summary.txt create mode 100644 extra/nurbs/authors.txt create mode 100644 extra/nurbs/nurbs-tests.factor create mode 100644 extra/nurbs/nurbs.factor create mode 100644 extra/nurbs/summary.txt diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index 0fe1404516..14a66b5c18 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -62,6 +62,9 @@ IN: math.vectors [ first vnlerp ] [ second vnlerp ] bi-curry [ 2bi@ ] [ call ] bi* ; +: v~ ( a b epsilon -- ? ) + [ ~ ] curry 2all? ; + HINTS: vneg { array } ; HINTS: norm-sq { array } ; HINTS: norm { array } ; diff --git a/extra/math/affine-transforms/affine-transforms.factor b/extra/math/affine-transforms/affine-transforms.factor index d1fd602f72..7d63bbfac8 100644 --- a/extra/math/affine-transforms/affine-transforms.factor +++ b/extra/math/affine-transforms/affine-transforms.factor @@ -65,9 +65,6 @@ CONSTANT: identity-transform T{ affine-transform f { 1.0 0.0 } { 0.0 1.0 } { 0.0 } 2cleave [ [ 2array ] 2bi@ ] dip ; -: v~ ( a b epsilon -- ? ) - [ ~ ] curry 2all? ; - : a~ ( a b epsilon -- ? ) { [ [ [ x>> ] bi@ ] dip v~ ] diff --git a/extra/math/vectors/homogeneous/authors.txt b/extra/math/vectors/homogeneous/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/math/vectors/homogeneous/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/math/vectors/homogeneous/homogeneous-tests.factor b/extra/math/vectors/homogeneous/homogeneous-tests.factor new file mode 100644 index 0000000000..7e657dbe71 --- /dev/null +++ b/extra/math/vectors/homogeneous/homogeneous-tests.factor @@ -0,0 +1,15 @@ +! (c)2009 Joe Groff bsd license +USING: math.vectors.homogeneous tools.test ; +IN: math.vectors.homogeneous.tests + +[ { 1.0 2.0 1.0 } ] [ { 1.0 0.0 1.0 } { 0.0 2.0 1.0 } h+ ] unit-test +[ { 1.0 -2.0 1.0 } ] [ { 1.0 0.0 1.0 } { 0.0 2.0 1.0 } h- ] unit-test +[ { 2.0 2.0 2.0 } ] [ { 1.0 0.0 1.0 } { 0.0 2.0 2.0 } h+ ] unit-test +[ { 1.0 2.0 2.0 } ] [ { 1.0 0.0 2.0 } { 0.0 2.0 2.0 } h+ ] unit-test + +[ { 2.0 4.0 2.0 } ] [ 2.0 { 1.0 2.0 2.0 } n*h ] unit-test +[ { 2.0 4.0 2.0 } ] [ { 1.0 2.0 2.0 } 2.0 h*n ] unit-test + +[ { 0.5 1.5 } ] [ { 1.0 3.0 2.0 } h>v ] unit-test +[ { 0.5 1.5 1.0 } ] [ { 0.5 1.5 } v>h ] unit-test +[ { 0.5 1.5 1.0 } ] [ { 0.5 1.5 } v>h ] unit-test diff --git a/extra/math/vectors/homogeneous/homogeneous.factor b/extra/math/vectors/homogeneous/homogeneous.factor new file mode 100644 index 0000000000..218e56dfb5 --- /dev/null +++ b/extra/math/vectors/homogeneous/homogeneous.factor @@ -0,0 +1,36 @@ +! (c)2009 Joe Groff bsd license +USING: kernel math math.vectors sequences ; +IN: math.vectors.homogeneous + +: (homogeneous-xyz) ( h -- xyz ) + 1 head* ; inline +: (homogeneous-w) ( h -- w ) + peek ; inline + +: h+ ( a b -- c ) + 2dup [ (homogeneous-w) ] bi@ over = + [ [ [ (homogeneous-xyz) ] bi@ v+ ] dip suffix ] [ + drop + [ [ (homogeneous-xyz) ] [ (homogeneous-w) ] bi* v*n ] + [ [ (homogeneous-w) ] [ (homogeneous-xyz) ] bi* n*v v+ ] + [ [ (homogeneous-w) ] [ (homogeneous-w) ] bi* * suffix ] 2tri + ] if ; + +: n*h ( n h -- nh ) + [ (homogeneous-xyz) n*v ] [ (homogeneous-w) suffix ] bi ; + +: h*n ( h n -- nh ) + swap n*h ; + +: hneg ( h -- -h ) + -1.0 swap n*h ; + +: h- ( a b -- c ) + hneg h+ ; + +: v>h ( v -- h ) + 1.0 suffix ; + +: h>v ( h -- v ) + [ (homogeneous-xyz) ] [ (homogeneous-w) ] bi v/n ; + diff --git a/extra/math/vectors/homogeneous/summary.txt b/extra/math/vectors/homogeneous/summary.txt new file mode 100644 index 0000000000..eb6d457267 --- /dev/null +++ b/extra/math/vectors/homogeneous/summary.txt @@ -0,0 +1 @@ +Homogeneous coordinate math diff --git a/extra/nurbs/authors.txt b/extra/nurbs/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/nurbs/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/nurbs/nurbs-tests.factor b/extra/nurbs/nurbs-tests.factor new file mode 100644 index 0000000000..db606f9c5c --- /dev/null +++ b/extra/nurbs/nurbs-tests.factor @@ -0,0 +1,32 @@ +! (c)2009 Joe Groff bsd license +USING: literals math math.functions math.vectors namespaces +nurbs tools.test ; +IN: nurbs.tests + +SYMBOL: test-nurbs + +CONSTANT: √2/2 $[ 0.5 sqrt ] +CONSTANT: -√2/2 $[ 0.5 sqrt neg ] + +! unit circle as NURBS +3 { + { 1.0 0.0 1.0 } + { $ √2/2 $ √2/2 $ √2/2 } + { 0.0 1.0 1.0 } + { $ -√2/2 $ √2/2 $ √2/2 } + { -1.0 0.0 1.0 } + { $ -√2/2 $ -√2/2 $ √2/2 } + { 0.0 -1.0 1.0 } + { $ √2/2 $ -√2/2 $ √2/2 } + { 1.0 0.0 1.0 } +} { 0.0 0.0 0.0 0.25 0.25 0.5 0.5 0.75 0.75 1.0 1.0 1.0 } test-nurbs set + +[ t ] [ test-nurbs get 0.0 eval-nurbs { 1.0 0.0 } 0.00001 v~ ] unit-test +[ t ] [ test-nurbs get 0.25 eval-nurbs { 0.0 1.0 } 0.00001 v~ ] unit-test +[ t ] [ test-nurbs get 0.5 eval-nurbs { -1.0 0.0 } 0.00001 v~ ] unit-test +[ t ] [ test-nurbs get 0.75 eval-nurbs { 0.0 -1.0 } 0.00001 v~ ] unit-test + +[ t ] [ test-nurbs get 0.125 eval-nurbs { $ √2/2 $ √2/2 } 0.00001 v~ ] unit-test +[ t ] [ test-nurbs get 0.375 eval-nurbs { $ -√2/2 $ √2/2 } 0.00001 v~ ] unit-test +[ t ] [ test-nurbs get 0.625 eval-nurbs { $ -√2/2 $ -√2/2 } 0.00001 v~ ] unit-test +[ t ] [ test-nurbs get 0.875 eval-nurbs { $ √2/2 $ -√2/2 } 0.00001 v~ ] unit-test diff --git a/extra/nurbs/nurbs.factor b/extra/nurbs/nurbs.factor new file mode 100644 index 0000000000..ff77d3e915 --- /dev/null +++ b/extra/nurbs/nurbs.factor @@ -0,0 +1,73 @@ +! (c)2009 Joe Groff bsd license +USING: accessors arrays grouping kernel locals math math.order +math.ranges math.vectors math.vectors.homogeneous sequences +specialized-arrays.float ; +IN: nurbs + +TUPLE: nurbs-curve + { order integer } + control-points + knots + (knot-constants) ; + +: ?recip ( n -- 1/n ) + dup zero? [ recip ] unless ; + +:: order-index-knot-constants ( curve order index -- knot-constants ) + curve knots>> :> knots + index order 1 - + knots nth :> knot_i+k-1 + index knots nth :> knot_i + index order + knots nth :> knot_i+k + index 1 + knots nth :> knot_i+1 + + knot_i+k-1 knot_i - ?recip :> c1 + knot_i+1 knot_i+k - ?recip :> c2 + + knot_i c1 * neg :> c3 + knot_i+k c2 * neg :> c4 + + c1 c2 c3 c4 float-array{ } 4sequence ; + +: order-knot-constants ( curve order -- knot-constants ) + 2dup [ knots>> length ] dip - iota + [ order-index-knot-constants ] with with map ; + +: knot-constants ( curve -- knot-constants ) + 2 over order>> [a,b] + [ order-knot-constants ] with map ; + +: update-knots ( curve -- curve ) + dup knot-constants >>(knot-constants) ; + +: ( order control-points knots -- nurbs-curve ) + f nurbs-curve boa update-knots ; + +: knot-interval ( nurbs-curve t -- index ) + [ knots>> ] dip [ > ] curry find drop 1 - ; + +: clip-range ( from to sequence -- from' to' ) + length min [ 0 max ] dip ; + +:: eval-base ( knot-constants bases t -- base ) + knot-constants first t * knot-constants third + bases first * + knot-constants second t * knot-constants fourth + bases second * + + ; + +: (eval-curve) ( base-values control-points -- value ) + [ n*v ] 2map { 0.0 0.0 0.0 } [ v+ ] binary-reduce h>v ; + +:: (eval-bases) ( curve t interval values order -- values' ) + order 2 - curve (knot-constants)>> nth :> all-knot-constants + interval order interval + all-knot-constants clip-range :> to :> from + from to all-knot-constants subseq :> knot-constants + values { 0.0 } { 0.0 } surround 2 :> bases + + knot-constants bases [ t eval-base ] 2map :> values' + order curve order>> = + [ values' from to curve control-points>> subseq (eval-curve) ] + [ curve t interval 1 - values' order 1 + (eval-bases) ] if ; + +: eval-nurbs ( nurbs-curve t -- value ) + 2dup knot-interval 1 - { 1.0 } 2 (eval-bases) ; + + diff --git a/extra/nurbs/summary.txt b/extra/nurbs/summary.txt new file mode 100644 index 0000000000..46b9bebffb --- /dev/null +++ b/extra/nurbs/summary.txt @@ -0,0 +1 @@ +NURBS curve evaluation From 3276ae3a088bf6e81ef5a37d8e739626482a660c Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 21 May 2009 20:56:57 -0500 Subject: [PATCH 11/22] get rid of useless test --- basis/compiler/tree/cleanup/cleanup-tests.factor | 2 -- 1 file changed, 2 deletions(-) diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor index c596be263a..549d492d20 100755 --- a/basis/compiler/tree/cleanup/cleanup-tests.factor +++ b/basis/compiler/tree/cleanup/cleanup-tests.factor @@ -136,8 +136,6 @@ M: object xyz ; \ +-integer-fixnum inlined? ] unit-test -[ f ] [ [ dup 0 < [ neg ] when ] \ - inlined? ] unit-test - [ t ] [ [ [ no-cond ] 1 From 028c8776019129e143a4bf81b977eb603ead70dd Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 21 May 2009 21:23:01 -0500 Subject: [PATCH 12/22] tuple-arrays: clean up a bit and add docs --- basis/tuple-arrays/tuple-arrays-docs.factor | 25 +++++++++++++++++++++ basis/tuple-arrays/tuple-arrays.factor | 2 +- 2 files changed, 26 insertions(+), 1 deletion(-) create mode 100644 basis/tuple-arrays/tuple-arrays-docs.factor diff --git a/basis/tuple-arrays/tuple-arrays-docs.factor b/basis/tuple-arrays/tuple-arrays-docs.factor new file mode 100644 index 0000000000..cedf900698 --- /dev/null +++ b/basis/tuple-arrays/tuple-arrays-docs.factor @@ -0,0 +1,25 @@ +IN: tuple-arrays +USING: help.markup help.syntax sequences ; + +HELP: TUPLE-ARRAY: +{ $syntax "TUPLE-ARRAY: class" } +{ $description "Generates a new data type in the current vocabulary named " { $snippet { $emphasis "class" } "-array" } " for holding instances of " { $snippet "class" } ", which must be a tuple class word. Together with the class itself, this also generates words named " { $snippet "<" { $emphasis "class" } "-array>" } " and " { $snippet ">" { $emphasis "class" } "-array" } ", for creating new instances of this tuple array type." } ; + +ARTICLE: "tuple-arrays" "Tuple arrays" +"The " { $vocab-link "tuple-arrays" } " vocabulary implements space-efficient unboxed tuple arrays. Whereas an ordinary array of tuples would consist of pointers to heap-allocated objects, a tuple array stores its elements inline. Calling " { $link nth } " copies an element into a new tuple, and calling " { $link set-nth } " copies an existing tuple's slots into an array." +$nl +"Since value semantics differ from reference semantics, it is best to use tuple arrays with tuples where all slots are declared " { $link read-only } "." +$nl +"Tuple arrays should not be used with inheritance; storing an instance of a subclass in a tuple array will slice off the subclass slots, and getting the same value out again will yield an instance of the superclass. Also, tuple arrays do not get updated if tuples are redefined to add or remove slots, so caution should be exercised when doing interactive development on code that uses tuple arrays." +{ $subsection POSTPONE: TUPLE-ARRAY: } +"An example:" +{ $example + "USE: tuple-arrays" + "IN: scratchpad" + "TUPLE: point x y ;" + "TUPLE-ARRAY: point" + "{ T{ point f 1 2 } T{ point f 1 3 } T{ point f 2 3 } } >point-array first short." + "T{ point f 1 2 }" +} ; + +ABOUT: "tuple-arrays" \ No newline at end of file diff --git a/basis/tuple-arrays/tuple-arrays.factor b/basis/tuple-arrays/tuple-arrays.factor index 35d771416c..761dbd816a 100644 --- a/basis/tuple-arrays/tuple-arrays.factor +++ b/basis/tuple-arrays/tuple-arrays.factor @@ -21,7 +21,7 @@ MACRO: infer-in ( class -- quot ) infer in>> '[ _ ] ; [ new ] [ smart-tuple>array ] bi ; inline : tuple-slice ( n seq -- slice ) - [ n>> [ * dup ] keep + ] [ seq>> ] bi { array } declare slice boa ; inline + [ n>> [ * dup ] keep + ] [ seq>> ] bi slice boa ; inline : read-tuple ( slice class -- tuple ) '[ _ boa-unsafe ] input Date: Thu, 21 May 2009 23:27:42 -0500 Subject: [PATCH 13/22] io.monitors: fix example (reported by levy in #concatenative0 --- basis/io/monitors/monitors-docs.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/monitors/monitors-docs.factor b/basis/io/monitors/monitors-docs.factor index f0278e300e..c5f266de56 100644 --- a/basis/io/monitors/monitors-docs.factor +++ b/basis/io/monitors/monitors-docs.factor @@ -112,10 +112,10 @@ $nl { $code "USE: io.monitors" ": watch-loop ( monitor -- )" - " dup next-change . nl nl flush watch-loop ;" + " dup next-change path>> print nl nl flush watch-loop ;" "" ": watch-directory ( path -- )" - " [ t [ watch-loop ] with-monitor ] with-monitors" + " [ t [ watch-loop ] with-monitor ] with-monitors ;" } ; ABOUT: "io.monitors" From 9cc178b738e4cddaed98748f10233757f05c07d8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 22 May 2009 01:59:50 -0500 Subject: [PATCH 14/22] If a vocab fails to load, manifest would be left in a weird state (reported by Joe Groff) --- core/parser/parser-tests.factor | 11 ++++++++++- core/vocabs/loader/test/l/l.factor | 4 ++++ core/vocabs/loader/test/l/tags.txt | 1 + core/vocabs/parser/parser.factor | 4 ++-- 4 files changed, 17 insertions(+), 3 deletions(-) create mode 100644 core/vocabs/loader/test/l/l.factor create mode 100644 core/vocabs/loader/test/l/tags.txt diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index a9e0bd08ab..32f432a6cd 100644 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -618,4 +618,13 @@ EXCLUDE: qualified.tests.bar => x ; [ "USE: kernel UNUSE: kernel dup" "unuse-test" parse-stream -] [ error>> error>> error>> no-word-error? ] must-fail-with \ No newline at end of file +] [ error>> error>> error>> no-word-error? ] must-fail-with + +[ ] [ [ "vocabs.loader.test.l" forget-vocab ] with-compilation-unit ] unit-test + +[ + [ "vocabs.loader.test.l" use-vocab ] must-fail + [ f ] [ "vocabs.loader.test.l" manifest get search-vocab-names>> key? ] unit-test + [ ] [ "vocabs.loader.test.l" unuse-vocab ] unit-test + [ f ] [ "vocabs.loader.test.l" manifest get search-vocab-names>> key? ] unit-test +] with-file-vocabs diff --git a/core/vocabs/loader/test/l/l.factor b/core/vocabs/loader/test/l/l.factor new file mode 100644 index 0000000000..10cd35dff2 --- /dev/null +++ b/core/vocabs/loader/test/l/l.factor @@ -0,0 +1,4 @@ +IN: vocabs.loader.test.l +USE: kernel + +"Oops" throw \ No newline at end of file diff --git a/core/vocabs/loader/test/l/tags.txt b/core/vocabs/loader/test/l/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/core/vocabs/loader/test/l/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index 45084ae8ff..ff55f8e68d 100644 --- a/core/vocabs/parser/parser.factor +++ b/core/vocabs/parser/parser.factor @@ -108,8 +108,8 @@ TUPLE: no-current-vocab ; dup using-vocab? [ vocab-name "Already using ``" "'' vocabulary" surround note. ] [ manifest get - [ [ vocab-name ] dip search-vocab-names>> conjoin ] [ [ load-vocab ] dip search-vocabs>> push ] + [ [ vocab-name ] dip search-vocab-names>> conjoin ] 2bi ] if ; @@ -121,8 +121,8 @@ TUPLE: no-current-vocab ; : unuse-vocab ( vocab -- ) dup using-vocab? [ manifest get - [ [ vocab-name ] dip search-vocab-names>> delete-at ] [ [ load-vocab ] dip search-vocabs>> delq ] + [ [ vocab-name ] dip search-vocab-names>> delete-at ] 2bi ] [ drop ] if ; From d7ab0ad7c081c145989422bfa6e80f2a86512df0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 22 May 2009 02:04:36 -0500 Subject: [PATCH 15/22] io.monitors: spawn-monitor was broken and never used, so remove it (reported by levi in #concatenative) --- basis/io/monitors/monitors.factor | 3 --- 1 file changed, 3 deletions(-) diff --git a/basis/io/monitors/monitors.factor b/basis/io/monitors/monitors.factor index 7d40a1563a..cc8cea37d2 100644 --- a/basis/io/monitors/monitors.factor +++ b/basis/io/monitors/monitors.factor @@ -60,9 +60,6 @@ SYMBOL: +rename-file+ : run-monitor ( path recursive? quot -- ) '[ [ @ t ] loop ] with-monitor ; inline -: spawn-monitor ( path recursive? quot -- ) - [ '[ _ _ _ run-monitor ] ] [ 2drop "Monitoring " prepend ] 3bi - spawn drop ; { { [ os macosx? ] [ "io.monitors.macosx" require ] } { [ os linux? ] [ "io.monitors.linux" require ] } From bbad40683b701346a65253d67b66d1f8f3ed4dac Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 22 May 2009 16:21:35 -0500 Subject: [PATCH 16/22] webapps.mason: spiff up download.xml a bit --- extra/webapps/mason/download.xml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/extra/webapps/mason/download.xml b/extra/webapps/mason/download.xml index af4ac0214d..6dca81baf8 100644 --- a/extra/webapps/mason/download.xml +++ b/extra/webapps/mason/download.xml @@ -4,9 +4,12 @@ + Factor binary package for <t:label t:name="platform" /> +
    Logo
    +

    Factor binary package for

    Requirements:

    From 92ecb2f3be0226c6886018cb0821c6956cbfa2e0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 22 May 2009 17:15:40 -0500 Subject: [PATCH 17/22] fix random.windows -- use CRYPT_MACHINE_KEYSET --- basis/random/windows/windows.factor | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/basis/random/windows/windows.factor b/basis/random/windows/windows.factor index 6dce078d67..06a7634a43 100644 --- a/basis/random/windows/windows.factor +++ b/basis/random/windows/windows.factor @@ -25,7 +25,8 @@ CONSTANT: factor-crypto-container "FactorCryptoContainer" CryptAcquireContextW handle swap ; : acquire-crypto-context ( provider type -- handle ) - 0 (acquire-crypto-context) + CRYPT_MACHINE_KEYSET + (acquire-crypto-context) 0 = [ GetLastError NTE_BAD_KEYSET = [ drop f ] [ win32-error-string throw ] if @@ -34,7 +35,7 @@ CONSTANT: factor-crypto-container "FactorCryptoContainer" ] if ; : create-crypto-context ( provider type -- handle ) - CRYPT_NEWKEYSET (acquire-crypto-context) win32-error=0/f *void* ; + { CRYPT_MACHINE_KEYSET CRYPT_NEWKEYSET } (acquire-crypto-context) win32-error=0/f *void* ; ERROR: acquire-crypto-context-failed provider type ; From d660dd4ed6ec4f91d9b9b9a2a5a24802a2cb7dc6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 22 May 2009 17:18:24 -0500 Subject: [PATCH 18/22] fix typo --- basis/random/windows/windows.factor | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/basis/random/windows/windows.factor b/basis/random/windows/windows.factor index 06a7634a43..83b1fab0d0 100644 --- a/basis/random/windows/windows.factor +++ b/basis/random/windows/windows.factor @@ -1,7 +1,7 @@ USING: accessors alien.c-types byte-arrays combinators.short-circuit continuations destructors init kernel locals namespaces random windows.advapi32 windows.errors -windows.kernel32 ; +windows.kernel32 math.bitwise ; IN: random.windows TUPLE: windows-rng provider type ; @@ -35,7 +35,8 @@ CONSTANT: factor-crypto-container "FactorCryptoContainer" ] if ; : create-crypto-context ( provider type -- handle ) - { CRYPT_MACHINE_KEYSET CRYPT_NEWKEYSET } (acquire-crypto-context) win32-error=0/f *void* ; + { CRYPT_MACHINE_KEYSET CRYPT_NEWKEYSET } flags + (acquire-crypto-context) win32-error=0/f *void* ; ERROR: acquire-crypto-context-failed provider type ; From a1436e69cde39d8ef151c5d09075c9e3afafb3ed Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 22 May 2009 17:32:27 -0500 Subject: [PATCH 19/22] webapps.mason: make it look like the factorcode.org site --- extra/webapps/mason/download.xml | 5 ++++- extra/webapps/mason/mason.factor | 22 +++++++++++----------- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/extra/webapps/mason/download.xml b/extra/webapps/mason/download.xml index 6dca81baf8..7e50f958cd 100644 --- a/extra/webapps/mason/download.xml +++ b/extra/webapps/mason/download.xml @@ -1,8 +1,11 @@ + + - + Factor binary package for <t:label t:name="platform" /> diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor index 4d42617520..690c4c9660 100644 --- a/extra/webapps/mason/mason.factor +++ b/extra/webapps/mason/mason.factor @@ -21,12 +21,13 @@ TUPLE: mason-app < dispatcher ; ] dip link ; : download-grid-cell ( cpu os -- xml ) - builder new swap >>os swap >>cpu select-tuple dup - [ + builder new swap >>os swap >>cpu select-tuple [ dup last-release>> dup [ "." split1 drop 16 tail* 6 head* download-link ] [ 2drop f ] if - ] when - [XML <-> XML] ; + [XML
    <->
    XML] + ] [ + [XML XML] + ] if* ; CONSTANT: oses { @@ -47,22 +48,21 @@ CONSTANT: cpus : download-grid ( -- xml ) oses - [ values [ [XML <-> XML] ] map ] + [ values [ [XML <-> XML] ] map ] [ keys cpus [ [ nip second ] [ first ] 2bi [ swap download-grid-cell - ] curry map [XML <-><-> XML] + ] curry map + [XML <-><-> XML] ] with map - ] bi [XML <->
    <->
    XML] ; + ] bi + [XML <->
    <->
    XML] ; : ( -- action ) - [ - download-grid - xml>string "text/html" - ] >>display ; + [ download-grid xml>string "text/html" ] >>display ; : validate-os/cpu ( -- ) { From 760445c8e4347389645e7bf4eafaf2832f694766 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 22 May 2009 17:42:05 -0500 Subject: [PATCH 20/22] More cosmetic tweaks --- extra/webapps/mason/mason.factor | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor index 690c4c9660..fad77286b2 100644 --- a/extra/webapps/mason/mason.factor +++ b/extra/webapps/mason/mason.factor @@ -26,7 +26,7 @@ TUPLE: mason-app < dispatcher ; [ "." split1 drop 16 tail* 6 head* download-link ] [ 2drop f ] if [XML
    <->
    XML] ] [ - [XML XML] + [XML XML] ] if* ; CONSTANT: oses @@ -58,7 +58,12 @@ CONSTANT: cpus [XML <-><-> XML] ] with map ] bi - [XML <->
    <->
    XML] ; + [XML + + <-> + <-> +
    OS/CPU
    + XML] ; : ( -- action ) From b58c1780c6fd9dde4d15b082f1e18c418dd89c71 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 22 May 2009 17:48:05 -0500 Subject: [PATCH 21/22] One last tweak --- extra/webapps/mason/mason.factor | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor index fad77286b2..f7aadb9a54 100644 --- a/extra/webapps/mason/mason.factor +++ b/extra/webapps/mason/mason.factor @@ -15,7 +15,7 @@ TUPLE: mason-app < dispatcher ; : download-link ( builder label -- xml ) [ - [ URL" download" ] dip + [ URL" http://builds.factorcode.org/download" ] dip [ os>> "os" set-query-param ] [ cpu>> "cpu" set-query-param ] bi ] dip link ; @@ -137,16 +137,16 @@ CONSTANT: cpus os>> { { "winnt" "Windows XP (also tested on Vista)" } { "macosx" "Mac OS X 10.5 Leopard" } - { "linux" "Linux 2.6.16 with GLIBC 2.4" } + { "linux" "Ubuntu Linux 9.04 (other distributions may also work)" } { "freebsd" "FreeBSD 7.0" } { "netbsd" "NetBSD 4.0" } - { "openbsd" "OpenBSD 4.2" } + { "openbsd" "OpenBSD 4.4" } } at ] [ dup cpu>> "x86.32" = [ os>> { - { [ dup { "winnt" "linux" } member? ] [ drop "Intel Pentium 4, Core Duo, or other x86 chip with SSE2 support. Note that 32-bit Athlon XP processors do not support SSE2." ] } - { [ dup { "freebsd" "netbsd" "openbsd" } member? ] [ drop "Intel Pentium Pro or better" ] } + { [ dup { "winnt" "linux" "freebsd" } member? ] [ drop "Intel Pentium 4, Core Duo, or other x86 chip with SSE2 support. Note that 32-bit Athlon XP processors do not support SSE2." ] } + { [ dup { "netbsd" "openbsd" } member? ] [ drop "Intel Pentium Pro or better" ] } { [ t ] [ drop f ] } } cond ] [ drop f ] if From 5fa0507b97f0acd9721ca8d9bf807a729b55df95 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 22 May 2009 17:52:31 -0500 Subject: [PATCH 22/22] websites.concatenatieve: add builds.factorcode.org --- extra/websites/concatenative/concatenative.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index d7b132d4f2..207ae9ab34 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -23,7 +23,8 @@ webapps.pastebin webapps.planet webapps.wiki webapps.user-admin -webapps.help ; +webapps.help +webapps.mason ; IN: websites.concatenative : test-db ( -- db ) "resource:test.db" ; @@ -95,6 +96,7 @@ SYMBOL: dh-file test-db "planet.factorcode.org" add-responder home "docs" append-path test-db "docs.factorcode.org" add-responder home "cgi" append-path "gitweb.factorcode.org" add-responder + "builds.factorcode.org" add-responder main-responder set-global ; : ( -- config )