From eab654bb8a98f7dfbeb4e8917ca8ea9f151dfd6b Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 31 Jan 2008 11:58:17 -0600 Subject: [PATCH 01/15] Changing names of words --- extra/boids/ui/ui.factor | 20 ++++++++++---------- extra/namespaces/lib/lib.factor | 2 +- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/extra/boids/ui/ui.factor b/extra/boids/ui/ui.factor index 6d04a4d623..b545f41060 100644 --- a/extra/boids/ui/ui.factor +++ b/extra/boids/ui/ui.factor @@ -145,20 +145,20 @@ VARS: population-label cohesion-label alignment-label separation-label ; slate> over @center grid-add H{ } clone - T{ key-down f f "1" } C[ drop randomize ] put-hash - T{ key-down f f "2" } C[ drop sub-10-boids ] put-hash - T{ key-down f f "3" } C[ drop add-10-boids ] put-hash + T{ key-down f f "1" } C[ drop randomize ] put-at + T{ key-down f f "2" } C[ drop sub-10-boids ] put-at + T{ key-down f f "3" } C[ drop add-10-boids ] put-at - T{ key-down f f "q" } C[ drop inc-cohesion-weight ] put-hash - T{ key-down f f "a" } C[ drop dec-cohesion-weight ] put-hash + T{ key-down f f "q" } C[ drop inc-cohesion-weight ] put-at + T{ key-down f f "a" } C[ drop dec-cohesion-weight ] put-at - T{ key-down f f "w" } C[ drop inc-alignment-weight ] put-hash - T{ key-down f f "s" } C[ drop dec-alignment-weight ] put-hash + T{ key-down f f "w" } C[ drop inc-alignment-weight ] put-at + T{ key-down f f "s" } C[ drop dec-alignment-weight ] put-at - T{ key-down f f "e" } C[ drop inc-separation-weight ] put-hash - T{ key-down f f "d" } C[ drop dec-separation-weight ] put-hash + T{ key-down f f "e" } C[ drop inc-separation-weight ] put-at + T{ key-down f f "d" } C[ drop dec-separation-weight ] put-at - T{ key-down f f "ESC" } C[ drop toggle-loop ] put-hash + T{ key-down f f "ESC" } C[ drop toggle-loop ] put-at tuck set-gadget-delegate "Boids" open-window ; : boids-window ( -- ) [ [ boids-window* ] with-scope ] with-ui ; diff --git a/extra/namespaces/lib/lib.factor b/extra/namespaces/lib/lib.factor index 6e66119cb0..528e770558 100644 --- a/extra/namespaces/lib/lib.factor +++ b/extra/namespaces/lib/lib.factor @@ -16,4 +16,4 @@ IN: namespaces.lib ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: set* ( val var -- ) namestack* set-hash-stack ; +: set* ( val var -- ) namestack* set-assoc-stack ; From b98dc7ec0a738c19c5bc1533e35de5d6d725c3f1 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 31 Jan 2008 12:16:34 -0600 Subject: [PATCH 02/15] Fixing use of a qualified name --- extra/io/sniffer/bsd/bsd.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/io/sniffer/bsd/bsd.factor b/extra/io/sniffer/bsd/bsd.factor index ae87c05d38..66336425a1 100644 --- a/extra/io/sniffer/bsd/bsd.factor +++ b/extra/io/sniffer/bsd/bsd.factor @@ -7,7 +7,7 @@ sequences io.sniffer.backend ; QUALIFIED: unix IN: io.sniffer.bsd -M: unix-io destruct-handle ( obj -- ) close drop ; +M: unix-io destruct-handle ( obj -- ) unix:close drop ; C-UNION: ifreq_props "sockaddr-in" "short" "int" "caddr_t" ; C-STRUCT: ifreq { { "char" 16 } "name" } { "ifreq_props" "props" } ; From 40ca906f1c117af5ff9e96165c99169fd1f7aea0 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 31 Jan 2008 12:18:31 -0600 Subject: [PATCH 03/15] fixing use in cryptlib.streams --- extra/cryptlib/streams/streams.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/cryptlib/streams/streams.factor b/extra/cryptlib/streams/streams.factor index 64b5ee9992..750d2a426c 100755 --- a/extra/cryptlib/streams/streams.factor +++ b/extra/cryptlib/streams/streams.factor @@ -3,7 +3,7 @@ USING: cryptlib cryptlib.libcl kernel alien sequences byte-arrays namespaces io.buffers math generic io strings io.streams.lines io.streams.plain io.streams.duplex combinators -alien.c-types ; +alien.c-types continuations ; IN: cryptlib.streams @@ -154,4 +154,4 @@ M: crypt-stream dispose ( stream -- ) dispose end - ; \ No newline at end of file + ; From 4e3426d8718d5070d0c14a2f587814ad79a9679e Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 31 Jan 2008 12:21:49 -0600 Subject: [PATCH 04/15] Fixing various use clauses --- extra/html/elements/elements.factor | 2 +- extra/html/html.factor | 2 +- extra/io/streams/null/null.factor | 2 +- extra/tar/tar.factor | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/html/elements/elements.factor b/extra/html/elements/elements.factor index ff3e7b1283..101bc423b5 100644 --- a/extra/html/elements/elements.factor +++ b/extra/html/elements/elements.factor @@ -4,7 +4,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io kernel namespaces prettyprint quotations -sequences strings words xml.writer compiler.units effects ; +sequences strings words xml.entities compiler.units effects ; IN: html.elements diff --git a/extra/html/html.factor b/extra/html/html.factor index b5d4e63930..0860ae6c48 100755 --- a/extra/html/html.factor +++ b/extra/html/html.factor @@ -3,7 +3,7 @@ USING: generic assocs help http io io.styles io.files io.streams.string kernel math math.parser namespaces quotations assocs sequences strings words html.elements -xml.writer sbufs ; +xml.entities sbufs continuations ; IN: html GENERIC: browser-link-href ( presented -- href ) diff --git a/extra/io/streams/null/null.factor b/extra/io/streams/null/null.factor index 28d1b29be8..f76b0cbce3 100755 --- a/extra/io/streams/null/null.factor +++ b/extra/io/streams/null/null.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: io.streams.null -USING: kernel io ; +USING: kernel io continuations ; TUPLE: null-stream ; diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index ee312c1111..3bce7df9d6 100755 --- a/extra/tar/tar.factor +++ b/extra/tar/tar.factor @@ -1,5 +1,5 @@ USING: combinators io io.files io.streams.duplex -io.streams.string kernel math math.parser +io.streams.string kernel math math.parser continuations namespaces pack prettyprint sequences strings system ; USING: hexdump tools.interpreter ; IN: tar From 0bfad408721f53c72b555e83969eb0861bb6468b Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Fri, 1 Feb 2008 15:36:26 -0600 Subject: [PATCH 05/15] USE fix for pastebin --- extra/webapps/pastebin/pastebin.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor index 5ac322a952..7a7a88dcc6 100755 --- a/extra/webapps/pastebin/pastebin.factor +++ b/extra/webapps/pastebin/pastebin.factor @@ -1,6 +1,6 @@ USING: calendar furnace furnace.validator io.files kernel namespaces sequences http.server.responders html math.parser rss -xml.writer xmode.code2html ; +xml.writer xmode.code2html math ; IN: webapps.pastebin TUPLE: pastebin pastes ; From 1ee12b512cf3e4149f52a8f454fc755e827591de Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 1 Feb 2008 16:04:41 -0600 Subject: [PATCH 06/15] builder: minor tweaks --- extra/builder/builder.factor | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index a2b5dffb4d..4c770ff4ce 100644 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -31,8 +31,6 @@ SYMBOL: builder-recipients ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: boot-image ( -- filename ) `{ "boot" ,[ cpu ] "image" } "." join ; - : target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -61,7 +59,7 @@ if "factor" cd -{ "/usr/bin/git" "show" } +{ "git" "show" } [ readln ] with-stream " " split second "../git-id" [ print ] with-stream @@ -76,7 +74,7 @@ if "builder: vm compile" throw ] if -"wget http://factorcode.org/images/latest/" boot-image append system +"wget http://factorcode.org/images/latest/" boot-image-name append system 0 = [ ] [ @@ -84,7 +82,11 @@ if "builder: image download" throw ] if -[ "./factor -i=" boot-image " -no-user-init > ../boot-log" 3append system ] +[ + "./factor -i=" boot-image-name " -no-user-init > ../boot-log" + 3append + system +] benchmark nip "../boot-time" [ . ] with-stream 0 = From a849bc3097ef5bc7942a0a7b74332274a95c072b Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 1 Feb 2008 16:10:18 -0600 Subject: [PATCH 07/15] builder: fix using --- extra/builder/builder.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index 4c770ff4ce..a9a4c159f8 100644 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -1,5 +1,5 @@ -USING: kernel io io.files io.launcher +USING: kernel io io.files io.launcher tools.deploy.backend system namespaces sequences splitting math.parser unix prettyprint tools.time calendar bake vars ; From cef80543ad7504c0c77fdf8b04ab050e92ff0fba Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 1 Feb 2008 16:26:11 -0600 Subject: [PATCH 08/15] Fix set-string-nth GC issue --- vm/types.c | 28 +++++++++++++++++++++++++--- 1 file changed, 25 insertions(+), 3 deletions(-) diff --git a/vm/types.c b/vm/types.c index f34f5e57ca..1f0287b1f0 100755 --- a/vm/types.c +++ b/vm/types.c @@ -431,23 +431,30 @@ CELL string_nth(F_STRING* string, CELL index) } } +/* allocates memory */ void set_string_nth(F_STRING* string, CELL index, CELL value) { bput(SREF(string,index),value & 0xff); + F_BYTE_ARRAY *aux; + if(string->aux == F) { if(value <= 0xff) return; else { - string->aux = tag_object(allot_byte_array( + REGISTER_UNTAGGED(string); + aux = allot_byte_array( untag_fixnum_fast(string->length) - * sizeof(u16))); + * sizeof(u16)); + UNREGISTER_UNTAGGED(string); + string->aux = tag_object(aux); } } + else + aux = untag_object(string->aux); - F_BYTE_ARRAY *aux = untag_object(string->aux); cput(BREF(aux,index * sizeof(u16)),value >> 8); } @@ -463,10 +470,13 @@ F_STRING* allot_string_internal(CELL capacity) string->length = tag_fixnum(capacity); string->hashcode = F; string->aux = F; + set_string_nth(string,capacity,0); + return string; } +/* allocates memory */ void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill) { if(fill == 0) @@ -476,7 +486,11 @@ void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill) CELL i; for(i = start; i < capacity; i++) + { + REGISTER_UNTAGGED(string); set_string_nth(string,i,fill); + UNREGISTER_UNTAGGED(string); + } } } @@ -484,7 +498,9 @@ void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill) F_STRING *allot_string(CELL capacity, CELL fill) { F_STRING* string = allot_string_internal(capacity); + REGISTER_UNTAGGED(string); fill_string(string,0,capacity,fill); + UNREGISTER_UNTAGGED(string); return string; } @@ -506,7 +522,10 @@ F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill) UNREGISTER_UNTAGGED(string); memcpy(new_string + 1,string + 1,to_copy); + + REGISTER_UNTAGGED(string); fill_string(new_string,to_copy,capacity,fill); + UNREGISTER_UNTAGGED(string); return new_string; } @@ -529,7 +548,9 @@ DEFINE_PRIMITIVE(resize_string) CELL i; \ for(i = 0; i < length; i++) \ { \ + REGISTER_UNTAGGED(s); \ set_string_nth(s,i,(utype)*string); \ + UNREGISTER_UNTAGGED(s); \ string++; \ } \ return s; \ @@ -552,6 +573,7 @@ DEFINE_PRIMITIVE(resize_string) MEMORY_TO_STRING(char,u8) MEMORY_TO_STRING(u16,u16) +// MEMORY_TO_STRING(u32,u32) bool check_string(F_STRING *s, CELL max) { From 7cd7af7bd1e5b684289a0a35ea2a09e5abf16cbe Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Fri, 1 Feb 2008 16:43:12 -0600 Subject: [PATCH 09/15] Bug fix in word wrap --- extra/wrap/wrap.factor | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/extra/wrap/wrap.factor b/extra/wrap/wrap.factor index 4392ac81a6..41dea1bd13 100644 --- a/extra/wrap/wrap.factor +++ b/extra/wrap/wrap.factor @@ -12,15 +12,17 @@ SYMBOL: width : (split-chunk) ( words -- ) -1 over [ length + 1+ dup width get > ] find drop nip - [ cut-slice swap , (split-chunk) ] [ , ] if* ; + [ 1 max cut-slice swap , (split-chunk) ] [ , ] if* ; : split-chunk ( words -- lines ) [ (split-chunk) ] { } make ; +: join-spaces ( words-seqs -- lines ) + [ [ " " join ] map ] map concat ; + : broken-lines ( string width -- lines ) width [ - line-chunks - [ split-chunk [ " " join ] map ] map concat + line-chunks [ split-chunk ] map join-spaces ] with-variable ; : line-break ( string width -- newstring ) From bff385269c6eb9ce50f2188cf8ecc424b37a3346 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 1 Feb 2008 18:26:32 -0600 Subject: [PATCH 10/15] Lot's of USING: fixes for ascii or unicode --- core/parser/parser.factor | 76 ++++++++++--------- .../benchmark/knucleotide/knucleotide.factor | 2 +- .../reverse-complement.factor | 2 +- extra/cryptlib/cryptlib.factor | 2 +- extra/fjsc/fjsc.factor | 2 +- extra/globs/globs.factor | 2 +- extra/hexdump/hexdump.factor | 4 +- extra/id3/id3.factor | 2 +- extra/irc/irc.factor | 2 +- extra/json/reader/reader.factor | 2 +- extra/lint/lint.factor | 5 +- extra/parser-combinators/simple/simple.factor | 2 +- extra/peg/ebnf/ebnf.factor | 3 +- extra/peg/peg.factor | 3 +- extra/project-euler/017/017.factor | 3 +- extra/project-euler/022/022.factor | 2 +- extra/prolog/prolog.factor | 2 +- extra/regexp/regexp.factor | 2 +- extra/roman/roman.factor | 2 +- extra/rot13/rot13.factor | 2 +- extra/sequences/lib/lib.factor | 4 +- extra/state-parser/state-parser.factor | 2 +- extra/strings/lib/lib.factor | 16 ++-- extra/xml/tokenize/tokenize.factor | 2 +- extra/xml/xml.factor | 2 +- extra/xmode/keyword-map/keyword-map.factor | 3 +- extra/xmode/marker/marker.factor | 2 +- extra/xmode/rules/rules.factor | 2 +- 28 files changed, 81 insertions(+), 74 deletions(-) diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 862b266d05..6825029a8e 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -348,45 +348,49 @@ SYMBOL: bootstrap-syntax call ] with-scope ; inline +SYMBOL: interactive-vocabs + +{ + "arrays" + "assocs" + "combinators" + "compiler.errors" + "continuations" + "debugger" + "definitions" + "editors" + "generic" + "help" + "inspector" + "io" + "io.files" + "kernel" + "listener" + "math" + "memory" + "namespaces" + "prettyprint" + "sequences" + "slicing" + "sorting" + "strings" + "syntax" + "tools.annotations" + "tools.crossref" + "tools.memory" + "tools.profiler" + "tools.test" + "tools.time" + "vocabs" + "vocabs.loader" + "words" + "scratchpad" +} interactive-vocabs set-global + : with-interactive-vocabs ( quot -- ) [ "scratchpad" in set - { - "arrays" - "assocs" - "combinators" - "compiler.errors" - "continuations" - "debugger" - "definitions" - "editors" - "generic" - "help" - "inspector" - "io" - "io.files" - "kernel" - "listener" - "math" - "memory" - "namespaces" - "prettyprint" - "sequences" - "slicing" - "sorting" - "strings" - "syntax" - "tools.annotations" - "tools.crossref" - "tools.memory" - "tools.profiler" - "tools.test" - "tools.time" - "vocabs" - "vocabs.loader" - "words" - "scratchpad" - } set-use + interactive-vocabs get set-use call ] with-scope ; inline diff --git a/extra/benchmark/knucleotide/knucleotide.factor b/extra/benchmark/knucleotide/knucleotide.factor index f036a644ae..ad1ffc1c50 100644 --- a/extra/benchmark/knucleotide/knucleotide.factor +++ b/extra/benchmark/knucleotide/knucleotide.factor @@ -1,6 +1,6 @@ USING: kernel io io.files splitting strings hashtables sequences assocs math namespaces prettyprint - math.parser combinators arrays sorting ; + math.parser combinators arrays sorting unicode.case ; IN: benchmark.knucleotide diff --git a/extra/benchmark/reverse-complement/reverse-complement.factor b/extra/benchmark/reverse-complement/reverse-complement.factor index 332489abed..7b09b586f4 100644 --- a/extra/benchmark/reverse-complement/reverse-complement.factor +++ b/extra/benchmark/reverse-complement/reverse-complement.factor @@ -1,6 +1,6 @@ USING: io io.files io.streams.duplex kernel sequences sequences.private strings vectors words memoize splitting -hints ; +hints unicode.case ; IN: benchmark.reverse-complement MEMO: trans-map ( -- str ) diff --git a/extra/cryptlib/cryptlib.factor b/extra/cryptlib/cryptlib.factor index 65d2ffe48f..2ba81ef15a 100644 --- a/extra/cryptlib/cryptlib.factor +++ b/extra/cryptlib/cryptlib.factor @@ -6,7 +6,7 @@ ! Adapted from cryptlib.h ! Tested with cryptlib 3.3.1.0 USING: cryptlib.libcl kernel hashtables alien math -namespaces sequences assocs libc alien.c-types continuations ; +namespaces sequences assocs libc alien.c-types alien.accessors continuations ; IN: cryptlib diff --git a/extra/fjsc/fjsc.factor b/extra/fjsc/fjsc.factor index fdeed339d8..6beb48e05e 100755 --- a/extra/fjsc/fjsc.factor +++ b/extra/fjsc/fjsc.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel peg strings promises sequences math math.parser namespaces words quotations arrays hashtables io - io.streams.string assocs memoize ; + io.streams.string assocs memoize ascii ; IN: fjsc TUPLE: ast-number value ; diff --git a/extra/globs/globs.factor b/extra/globs/globs.factor index 901191b51e..7204693016 100755 --- a/extra/globs/globs.factor +++ b/extra/globs/globs.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: parser-combinators regexp lazy-lists sequences kernel -promises strings ; +promises strings unicode.case ; IN: globs digit ( c -- i ) 48 - ; +! : char>digit ( c -- i ) 48 - ; -: string>digits ( s -- seq ) [ char>digit ] { } map-as ; +! : string>digits ( s -- seq ) [ char>digit ] { } map-as ; -: >Upper ( str -- str ) - dup empty? [ - unclip ch>upper 1string swap append - ] unless ; +! : >Upper ( str -- str ) +! dup empty? [ +! unclip ch>upper 1string swap append +! ] unless ; -: >Upper-dashes ( str -- str ) - "-" split [ >Upper ] map "-" join ; +! : >Upper-dashes ( str -- str ) +! "-" split [ >Upper ] map "-" join ; diff --git a/extra/xml/tokenize/tokenize.factor b/extra/xml/tokenize/tokenize.factor index 85a473f503..d99c306b2b 100644 --- a/extra/xml/tokenize/tokenize.factor +++ b/extra/xml/tokenize/tokenize.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: xml.errors xml.data xml.utilities xml.char-classes xml.entities kernel state-parser kernel namespaces strings math -math.parser sequences assocs arrays splitting combinators ; +math.parser sequences assocs arrays splitting combinators unicode.case ; IN: xml.tokenize ! XML namespace processing: ns = namespace diff --git a/extra/xml/xml.factor b/extra/xml/xml.factor index 826b16b213..65a8e28dea 100644 --- a/extra/xml/xml.factor +++ b/extra/xml/xml.factor @@ -3,7 +3,7 @@ USING: io io.streams.string io.files kernel math namespaces prettyprint sequences arrays generic strings vectors xml.char-classes xml.data xml.errors xml.tokenize xml.writer -xml.utilities state-parser assocs ; +xml.utilities state-parser assocs unicode.categories ; IN: xml ! -- Overall parser with data tree diff --git a/extra/xmode/keyword-map/keyword-map.factor b/extra/xmode/keyword-map/keyword-map.factor index 350d8572a0..4e97e597b2 100644 --- a/extra/xmode/keyword-map/keyword-map.factor +++ b/extra/xmode/keyword-map/keyword-map.factor @@ -1,4 +1,5 @@ -USING: kernel strings assocs sequences hashtables sorting ; +USING: kernel strings assocs sequences hashtables sorting + unicode.case unicode.categories ; IN: xmode.keyword-map ! Based on org.gjt.sp.jedit.syntax.KeywordMap diff --git a/extra/xmode/marker/marker.factor b/extra/xmode/marker/marker.factor index b8331fe6b6..91ccd43907 100755 --- a/extra/xmode/marker/marker.factor +++ b/extra/xmode/marker/marker.factor @@ -2,7 +2,7 @@ IN: xmode.marker USING: kernel namespaces xmode.rules xmode.tokens xmode.marker.state xmode.marker.context xmode.utilities xmode.catalog sequences math assocs combinators combinators.lib -strings regexp splitting parser-combinators ; +strings regexp splitting parser-combinators ascii unicode.case ; ! Based on org.gjt.sp.jedit.syntax.TokenMarker diff --git a/extra/xmode/rules/rules.factor b/extra/xmode/rules/rules.factor index acc6308c6f..28237a7b2c 100755 --- a/extra/xmode/rules/rules.factor +++ b/extra/xmode/rules/rules.factor @@ -1,5 +1,5 @@ USING: xmode.tokens xmode.keyword-map kernel -sequences vectors assocs strings memoize regexp ; +sequences vectors assocs strings memoize regexp unicode.case ; IN: xmode.rules TUPLE: string-matcher string ignore-case? ; From c75b51bd58a32ffea6b020840fd097c37421cda8 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Fri, 1 Feb 2008 18:28:10 -0600 Subject: [PATCH 11/15] URL encoding uses ascii --- extra/http/http.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/http/http.factor b/extra/http/http.factor index 9e5d34fa36..7beb3b9da0 100755 --- a/extra/http/http.factor +++ b/extra/http/http.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2003, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: hashtables io kernel math namespaces math.parser assocs -sequences strings splitting ; +sequences strings splitting ascii ; IN: http : header-line ( line -- ) @@ -20,7 +20,7 @@ IN: http dup letter? over LETTER? or over digit? or - swap "/_-?." member? or ; foldable + swap "/_-." member? or ; foldable : url-encode ( str -- str ) [ From 9f1bcc5d224c80c66315ddd4989eeec8ccb19914 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 1 Feb 2008 18:36:13 -0600 Subject: [PATCH 12/15] Fix resize-string --- core/strings/strings-tests.factor | 5 +++++ vm/data_gc.c | 3 ++- vm/types.c | 26 ++++++++++++++++++++++++-- vm/types.h | 4 ++-- 4 files changed, 33 insertions(+), 5 deletions(-) diff --git a/core/strings/strings-tests.factor b/core/strings/strings-tests.factor index 5ab7f1dffe..459ec7b153 100755 --- a/core/strings/strings-tests.factor +++ b/core/strings/strings-tests.factor @@ -51,6 +51,9 @@ unit-test [ "ab" ] [ 2 "abc" resize-string ] unit-test [ "abc\0\0\0" ] [ 6 "abc" resize-string ] unit-test +[ "\u001234b" ] [ 2 "\u001234bc" resize-string ] unit-test +[ "\u001234bc\0\0\0" ] [ 6 "\u001234bc" resize-string ] unit-test + ! Random tester found this [ { "kernel-error" 3 12 -7 } ] [ [ 2 -7 resize-string ] catch ] unit-test @@ -88,3 +91,5 @@ unit-test "\udeadbe" clone CHAR: \u123456 over clone set-first ] unit-test + + diff --git a/vm/data_gc.c b/vm/data_gc.c index 3ca41d602c..601a677920 100755 --- a/vm/data_gc.c +++ b/vm/data_gc.c @@ -505,7 +505,6 @@ CELL binary_payload_start(CELL pointer) switch(untag_header(get(pointer))) { /* these objects do not refer to other objects at all */ - case STRING_TYPE: case FLOAT_TYPE: case BYTE_ARRAY_TYPE: case BIT_ARRAY_TYPE: @@ -522,6 +521,8 @@ CELL binary_payload_start(CELL pointer) return CELLS * 2; case QUOTATION_TYPE: return sizeof(F_QUOTATION) - CELLS * 2; + case STRING_TYPE: + return sizeof(F_STRING); /* everything else consists entirely of pointers */ default: return unaligned_object_size(pointer); diff --git a/vm/types.c b/vm/types.c index 1f0287b1f0..24b5e7ff07 100755 --- a/vm/types.c +++ b/vm/types.c @@ -480,7 +480,16 @@ F_STRING* allot_string_internal(CELL capacity) void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill) { if(fill == 0) - memset((void*)SREF(string,start),'\0',capacity - start); + { + memset((void *)SREF(string,start),'\0',capacity - start); + + if(string->aux != F) + { + F_BYTE_ARRAY *aux = untag_object(string->aux); + memset((void *)BREF(aux,start * sizeof(u16)),'\0', + (capacity - start) * sizeof(u16)); + } + } else { CELL i; @@ -523,6 +532,19 @@ F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill) memcpy(new_string + 1,string + 1,to_copy); + if(string->aux != F) + { + REGISTER_UNTAGGED(string); + REGISTER_UNTAGGED(new_string); + F_BYTE_ARRAY *new_aux = allot_byte_array(capacity * sizeof(u16)); + new_string->aux = tag_object(new_aux); + UNREGISTER_UNTAGGED(new_string); + UNREGISTER_UNTAGGED(string); + + F_BYTE_ARRAY *aux = untag_object(string->aux); + memcpy(new_aux + 1,aux + 1,to_copy * sizeof(u16)); + } + REGISTER_UNTAGGED(string); fill_string(new_string,to_copy,capacity,fill); UNREGISTER_UNTAGGED(string); @@ -573,7 +595,7 @@ DEFINE_PRIMITIVE(resize_string) MEMORY_TO_STRING(char,u8) MEMORY_TO_STRING(u16,u16) -// MEMORY_TO_STRING(u32,u32) +MEMORY_TO_STRING(u32,u32) bool check_string(F_STRING *s, CELL max) { diff --git a/vm/types.h b/vm/types.h index 6f4234af34..e5003ea069 100755 --- a/vm/types.h +++ b/vm/types.h @@ -83,8 +83,8 @@ INLINE CELL array_capacity(F_ARRAY* array) return array->capacity >> TAG_BITS; } -#define BREF(byte_array,index) ((CELL)byte_array + sizeof(F_BYTE_ARRAY) + index) -#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + index) +#define BREF(byte_array,index) ((CELL)byte_array + sizeof(F_BYTE_ARRAY) + (index)) +#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + (index)) INLINE F_STRING* untag_string(CELL tagged) { From 6851b16b3932a0ee057e0423c3a587279726a082 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 1 Feb 2008 18:36:20 -0600 Subject: [PATCH 13/15] Remove dan's make* --- extra/unicode/case/case.factor | 15 ++++++++------- extra/unicode/normalize/normalize.factor | 11 ----------- 2 files changed, 8 insertions(+), 18 deletions(-) diff --git a/extra/unicode/case/case.factor b/extra/unicode/case/case.factor index 96ae9a790b..ee9e2a0381 100755 --- a/extra/unicode/case/case.factor +++ b/extra/unicode/case/case.factor @@ -1,5 +1,6 @@ -USING: kernel unicode.data sequences sequences.next namespaces assocs.lib -unicode.normalize math unicode.categories combinators assocs ; +USING: kernel unicode.data sequences sequences.next namespaces +assocs.lib unicode.normalize math unicode.categories combinators +assocs ; IN: unicode.case : ch>lower ( ch -- lower ) simple-lower at-default ; @@ -20,7 +21,7 @@ SYMBOL: locale ! Just casing locale, or overall? [ swap dot-over = over "ij" member? and swap , ] if ; : lithuanian>upper ( string -- lower ) - [ f swap [ lithuanian-ch>upper ] each-next drop ] "" make* ; + [ f swap [ lithuanian-ch>upper ] each-next drop ] "" make ; : mark-above? ( ch -- ? ) combining-class 230 = ; @@ -32,14 +33,14 @@ SYMBOL: locale ! Just casing locale, or overall? dup , "IJ" member? swap mark-above? and [ dot-over , ] when ; : lithuanian>lower ( string -- lower ) - [ [ lithuanian-ch>lower ] each-next ] "" make* ; + [ [ lithuanian-ch>lower ] each-next ] "" make ; : turk-ch>upper ( ch -- ) dup CHAR: i = [ drop CHAR: I , dot-over , ] [ , ] if ; : turk>upper ( string -- upper-i ) - [ [ turk-ch>upper ] each ] "" make* ; + [ [ turk-ch>upper ] each ] "" make ; : turk-ch>lower ( ? next ch -- ? ) { @@ -52,7 +53,7 @@ SYMBOL: locale ! Just casing locale, or overall? } cond ; : turk>lower ( string -- lower-i ) - [ f swap [ turk-ch>lower ] each-next drop ] "" make* ; + [ f swap [ turk-ch>lower ] each-next drop ] "" make ; : word-boundary ( prev char -- new ? ) dup non-starter? [ drop dup ] when @@ -76,7 +77,7 @@ SYMBOL: locale ! Just casing locale, or overall? [ -rot nip call , ] ?if ] 2keep ] each 2drop - ] "" make* ; inline + ] "" make ; inline : >lower ( string -- lower ) i-dot? [ turk>lower ] when diff --git a/extra/unicode/normalize/normalize.factor b/extra/unicode/normalize/normalize.factor index b018d115f8..47637e8330 100644 --- a/extra/unicode/normalize/normalize.factor +++ b/extra/unicode/normalize/normalize.factor @@ -2,17 +2,6 @@ USING: sequences namespaces unicode.data kernel combinators.lib math arrays ; IN: unicode.normalize -! Utility word--probably unnecessary -: make* ( seq quot exemplar -- newseq ) - ! quot has access to original seq on stack - ! this just makes the new-resizable the same length as seq - [ - [ - pick length swap new-resizable - [ building set call ] keep - ] keep like - ] with-scope ; inline - ! Conjoining Jamo behavior : hangul-base HEX: ac00 ; inline From 1e477cfc4af593088b2feb259264cf1f7addefda Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Fri, 1 Feb 2008 18:38:29 -0600 Subject: [PATCH 14/15] URL encoding/decoding uses UTF-8 now --- extra/http/http-tests.factor | 2 ++ extra/http/http.factor | 19 ++++++++----------- 2 files changed, 10 insertions(+), 11 deletions(-) diff --git a/extra/http/http-tests.factor b/extra/http/http-tests.factor index 853ac28f72..5146502644 100644 --- a/extra/http/http-tests.factor +++ b/extra/http/http-tests.factor @@ -14,3 +14,5 @@ IN: temporary [ "hello world" ] [ "hello world%x" url-decode ] unit-test [ "hello%20world" ] [ "hello world" url-encode ] unit-test [ "%20%21%20" ] [ " ! " url-encode ] unit-test + +[ "\u001234hi\u002045" ] [ "\u001234hi\u002045" url-encode url-decode ] unit-test diff --git a/extra/http/http.factor b/extra/http/http.factor index 7beb3b9da0..1bd9e18d98 100755 --- a/extra/http/http.factor +++ b/extra/http/http.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2003, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: hashtables io kernel math namespaces math.parser assocs -sequences strings splitting ascii ; +sequences strings splitting ascii io.utf8 ; IN: http : header-line ( line -- ) @@ -22,16 +22,13 @@ IN: http over digit? or swap "/_-." member? or ; foldable +: push-utf8 ( string -- ) + 1string encode-utf8 [ CHAR: % , >hex 2 CHAR: 0 pad-left % ] each ; + : url-encode ( str -- str ) - [ - [ - dup url-quotable? [ - , - ] [ - CHAR: % , >hex 2 CHAR: 0 pad-left % - ] if - ] each - ] "" make ; + [ [ + dup url-quotable? [ , ] [ push-utf8 ] if + ] each ] "" make ; : url-decode-hex ( index str -- ) 2dup length 2 - >= [ @@ -58,7 +55,7 @@ IN: http ] if ; : url-decode ( str -- str ) - [ 0 swap url-decode-iter ] "" make ; + [ 0 swap url-decode-iter ] "" make decode-utf8 ; : hash>query ( hash -- str ) [ [ url-encode ] 2apply "=" swap 3append ] { } assoc>map From 2d381ed84e2845a1174480bcc79eb54ebf02a3d6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 1 Feb 2008 22:47:01 -0600 Subject: [PATCH 15/15] Fix http server --- extra/http/server/templating/templating.factor | 2 +- extra/io/server/server.factor | 6 +++--- extra/webapps/cgi/cgi.factor | 6 +++--- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/extra/http/server/templating/templating.factor b/extra/http/server/templating/templating.factor index 69f8b4e7fd..f5de4664a1 100755 --- a/extra/http/server/templating/templating.factor +++ b/extra/http/server/templating/templating.factor @@ -25,7 +25,7 @@ M: template-lexer skip-word { { [ 2dup nth CHAR: " = ] [ drop 1+ ] } { [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] } - { [ t ] [ [ blank? ] skip ] } + { [ t ] [ f skip ] } } cond ] change-column ; diff --git a/extra/io/server/server.factor b/extra/io/server/server.factor index 6e7cd5a940..408fd29714 100755 --- a/extra/io/server/server.factor +++ b/extra/io/server/server.factor @@ -29,7 +29,7 @@ SYMBOL: log-stream : with-log-file ( file quot -- ) >r r> - [ with-log-stream ] with-disposal ; inline + [ with-log-stream ] curry with-disposal ; inline : with-log-stdio ( quot -- ) stdio get swap with-log-stream ; @@ -47,11 +47,11 @@ SYMBOL: log-stream dup log-client [ swap with-stream ] 2curry concurrency:spawn drop ; inline -: accept-loop ( server quot -- server quot ) +: accept-loop ( server quot -- ) [ swap accept with-client ] 2keep accept-loop ; inline : server-loop ( server quot -- ) - [ accept-loop ] compose with-disposal ; inline + [ accept-loop ] curry with-disposal ; inline : spawn-server ( addrspec quot -- ) "Waiting for connections on " pick unparse append diff --git a/extra/webapps/cgi/cgi.factor b/extra/webapps/cgi/cgi.factor index 9dd9dca39c..967036a797 100644 --- a/extra/webapps/cgi/cgi.factor +++ b/extra/webapps/cgi/cgi.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2007 Slava Pestov. +! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: namespaces kernel assocs io.files combinators arrays io.launcher io http.server.responders webapps.file -sequences strings math.parser ; +sequences strings math.parser unicode.case ; IN: webapps.cgi SYMBOL: cgi-root @@ -31,7 +31,7 @@ SYMBOL: cgi-root "method" get >upper "REQUEST_METHOD" set "raw-query" get "QUERY_STRING" set - "Cookie" header-param "HTTP_COOKIE" set + "Cookie" header-param "HTTP_COOKIE" set "User-Agent" header-param "HTTP_USER_AGENT" set "Accept" header-param "HTTP_ACCEPT" set