From 38b65e00f4fa7896c737a0fd9929cc73d7dfe718 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 6 Sep 2008 20:34:02 -0500 Subject: [PATCH 1/3] Fix instances to not allocate memory while scanning heap --- core/memory/memory-tests.factor | 2 ++ core/memory/memory.factor | 11 +++++++++-- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/core/memory/memory-tests.factor b/core/memory/memory-tests.factor index 3fe1387582..9fded3eb3a 100755 --- a/core/memory/memory-tests.factor +++ b/core/memory/memory-tests.factor @@ -3,6 +3,8 @@ sequences tools.test words namespaces layouts classes classes.builtin arrays quotations ; IN: memory.tests +[ [ ] instances ] must-infer + ! Code GC wasn't kicking in when needed : leak-step 800000 f 1quotation call drop ; diff --git a/core/memory/memory.factor b/core/memory/memory.factor index cb5c5bf7e4..42527371f2 100644 --- a/core/memory/memory.factor +++ b/core/memory/memory.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel continuations sequences arrays system ; +USING: kernel continuations sequences vectors arrays system math ; IN: memory : (each-object) ( quot: ( obj -- ) -- ) @@ -9,7 +9,14 @@ IN: memory : each-object ( quot -- ) begin-scan [ (each-object) ] [ end-scan ] [ ] cleanup ; inline +: count-instances ( quot -- n ) + 0 swap [ 1 0 ? + ] compose each-object ; inline + : instances ( quot -- seq ) - pusher [ each-object ] dip >array ; inline + #! To ensure we don't need to grow the vector while scanning + #! the heap, we do two scans, the first one just counts the + #! number of objects that satisfy the predicate. + [ count-instances 100 + ] keep swap + [ [ push-if ] 2curry each-object ] keep >array ; inline : save ( -- ) image save-image ; From 33eee7638b4726ec0e41618902b5c3efd91a2200 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 6 Sep 2008 23:20:27 -0500 Subject: [PATCH 2/3] Add nsequence --- .../generalizations-docs.factor | 19 ++++++++++++++++++- basis/generalizations/generalizations.factor | 7 +++++-- 2 files changed, 23 insertions(+), 3 deletions(-) diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor index a702f452da..a2b318cb39 100755 --- a/basis/generalizations/generalizations-docs.factor +++ b/basis/generalizations/generalizations-docs.factor @@ -2,6 +2,16 @@ USING: help.syntax help.markup kernel sequences quotations math arrays ; IN: generalizations +HELP: nsequence +{ $values { "n" integer } { "seq" "an exemplar" } } +{ $description "A generalization of " { $link 2sequence } ", " +{ $link 3sequence } ", and " { $link 4sequence } " " +"that constructs a sequence from the top " { $snippet "n" } " elements of the stack." +} +{ $examples + { $example "CHAR: f CHAR: i CHAR: s CHAR: h 4 \"\" nsequence ." "\"fish\"" } +} ; + HELP: narray { $values { "n" integer } } { $description "A generalization of " { $link 1array } ", " @@ -9,6 +19,8 @@ HELP: narray "that constructs an array from the top " { $snippet "n" } " elements of the stack." } ; +{ nsequence narray } related-words + HELP: firstn { $values { "n" integer } } { $description "A generalization of " { $link first } ", " @@ -127,11 +139,15 @@ HELP: nkeep { $see-also keep nslip } ; ARTICLE: "generalizations" "Generalized shuffle words and combinators" -"A number of stack shuffling words and combinators for use in " +"The " { $vocab-link "generalizations" } " vocabulary defines a number of stack shuffling words and combinators for use in " "macros where the arity of the input quotations depends on an " "input parameter." +$nl +"Generalized sequence operations:" { $subsection narray } +{ $subsection nsequence } { $subsection firstn } +"Generated stack shuffle operations:" { $subsection ndup } { $subsection npick } { $subsection nrot } @@ -139,6 +155,7 @@ ARTICLE: "generalizations" "Generalized shuffle words and combinators" { $subsection nnip } { $subsection ndrop } { $subsection nrev } +"Generalized combinators:" { $subsection ndip } { $subsection nslip } { $subsection nkeep } diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor index e4d5249a30..c97e9c7b91 100755 --- a/basis/generalizations/generalizations.factor +++ b/basis/generalizations/generalizations.factor @@ -5,10 +5,13 @@ USING: kernel sequences sequences.private namespaces math math.ranges combinators macros quotations fry arrays ; IN: generalizations -MACRO: narray ( n -- quot ) - [ ] [ '[ , f ] ] bi +MACRO: nsequence ( n seq -- quot ) + [ drop ] [ '[ , , new-sequence ] ] 2bi [ '[ @ [ , swap set-nth-unsafe ] keep ] ] reduce ; +MACRO: narray ( n -- quot ) + '[ , { } nsequence ] ; + MACRO: firstn ( n -- ) dup zero? [ drop [ drop ] ] [ [ [ '[ , _ nth-unsafe ] ] map ] From dbd7b4f54617935639e9b68b5f1356a62d8f6198 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 6 Sep 2008 23:58:07 -0500 Subject: [PATCH 3/3] Update builder.release.upload for robustness; make upload location configurable --- extra/builder/release/upload/upload.factor | 50 +++++++++++++++++----- 1 file changed, 40 insertions(+), 10 deletions(-) diff --git a/extra/builder/release/upload/upload.factor b/extra/builder/release/upload/upload.factor index 38f6dcb133..32a27f82fd 100644 --- a/extra/builder/release/upload/upload.factor +++ b/extra/builder/release/upload/upload.factor @@ -1,5 +1,5 @@ -USING: kernel namespaces io io.files +USING: kernel namespaces sequences arrays io io.files builder.util builder.common builder.release.archive ; @@ -8,17 +8,47 @@ IN: builder.release.upload ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: remote-location ( -- dest ) - "factorcode.org:/var/www/factorcode.org/newsite/downloads" - platform - append-path ; +SYMBOL: upload-host -: (upload) ( -- ) - { "scp" archive-name remote-location } to-strings - [ "Error uploading binary to factorcode" print ] - run-or-bail ; +SYMBOL: upload-username + +SYMBOL: upload-directory + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: remote-location ( -- dest ) + upload-directory get platform append ; + +: remote-archive-name ( -- dest ) + remote-location "/" archive-name 3append ; + +: temp-archive-name ( -- dest ) + remote-archive-name ".incomplete" append ; + +: upload-command ( -- args ) + "scp" + archive-name + [ upload-username get % "@" % upload-host get % ":" % temp-archive-name % ] "" make + 3array ; + +: rename-command ( -- args ) + [ + "ssh" , + upload-host get , + "-l" , + upload-username get , + "mv" , + temp-archive-name , + remote-archive-name , + ] { } make ; + +: upload-temp-file ( -- ) + upload-command [ "Error uploading binary to factorcode" print ] run-or-bail ; + +: rename-temp-file ( -- ) + rename-command [ "Error renaming binary on factorcode" print ] run-or-bail ; : upload ( -- ) upload-to-factorcode get - [ (upload) ] + [ upload-temp-file rename-temp-file ] when ;