]> gitweb.factorcode.org Git - factor.git/commitdiff
Fix conflict
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 9 Dec 2008 23:52:45 +0000 (17:52 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 9 Dec 2008 23:52:45 +0000 (17:52 -0600)
16 files changed:
basis/byte-vectors/byte-vectors.factor
basis/compiler/cfg/intrinsics/allot/allot.factor
basis/compiler/cfg/intrinsics/intrinsics.factor
basis/specialized-arrays/double/double.factor
basis/specialized-arrays/functor/functor.factor
basis/stack-checker/known-words/known-words.factor
basis/tools/walker/walker.factor
core/bootstrap/primitives.factor
core/byte-arrays/byte-arrays.factor
core/sbufs/sbufs.factor
core/sequences/sequences-docs.factor
core/sequences/sequences.factor
core/strings/strings.factor
vm/primitives.c
vm/types.c
vm/types.h

index e24c808bbc79e91d299a77f97ac17564c61465b5..d146017db08d636d5022f64fbf833e67f562e376 100644 (file)
@@ -10,7 +10,7 @@ TUPLE: byte-vector
 { length array-capacity } ;\r
 \r
 : <byte-vector> ( n -- byte-vector )\r
-    <byte-array> 0 byte-vector boa ; inline\r
+    (byte-array) 0 byte-vector boa ; inline\r
 \r
 : >byte-vector ( seq -- byte-vector )\r
     T{ byte-vector f B{ } 0 } clone-like ;\r
@@ -22,7 +22,7 @@ M: byte-vector like
     ] unless ;\r
 \r
 M: byte-vector new-sequence\r
-    drop [ <byte-array> ] [ >fixnum ] bi byte-vector boa ;\r
+    drop [ (byte-array) ] [ >fixnum ] bi byte-vector boa ;\r
 \r
 M: byte-vector equal?\r
     over byte-vector? [ sequence= ] [ 2drop f ] if ;\r
index ceac5e960cfb20aa82372fb43fb8cedd9b8c4cc5..3a4c702bc563535758057098911c9a15c41c10eb 100644 (file)
@@ -54,15 +54,19 @@ IN: compiler.cfg.intrinsics.allot
 
 : bytes>cells ( m -- n ) cell align cell /i ;
 
-:: emit-<byte-array> ( node -- )
-    [let | len [ node node-input-infos first literal>> ] |
-        len expand-<byte-array>? [
-            [let | elt [ 0 ^^load-literal ]
-                   reg [ len ^^allot-byte-array ] |
-                ds-drop
-                len reg store-length
-                elt reg len bytes>cells store-initial-element
-                reg ds-push
-            ]
-        ] [ node emit-primitive ] if
-    ] ;
+: emit-allot-byte-array ( len -- dst )
+    ds-drop
+    dup ^^allot-byte-array
+    [ store-length ] [ ds-push ] [ ] tri ;
+
+: emit-(byte-array) ( node -- )
+    dup node-input-infos first literal>> dup expand-<byte-array>?
+    [ nip emit-allot-byte-array drop ] [ drop emit-primitive ] if ;
+
+: emit-<byte-array> ( node -- )
+    dup node-input-infos first literal>> dup expand-<byte-array>? [
+        nip
+        [ 0 ^^load-literal ] dip
+        [ emit-allot-byte-array ] keep
+        bytes>cells store-initial-element
+    ] [ drop emit-primitive ] if ;
index 6656cd11f7646047e95e11317dfb6a7779a501c3..5f753308655f96a8aa1e108057b89fe8a90b695b 100644 (file)
@@ -52,6 +52,7 @@ IN: compiler.cfg.intrinsics
     classes.tuple.private:<tuple-boa>
     arrays:<array>
     byte-arrays:<byte-array>
+    byte-arrays:(byte-array)
     math.private:<complex>
     math.private:<ratio>
     kernel:<wrapper>
@@ -139,6 +140,7 @@ IN: compiler.cfg.intrinsics
         { \ classes.tuple.private:<tuple-boa> [ emit-<tuple-boa> iterate-next ] }
         { \ arrays:<array> [ emit-<array> iterate-next ] }
         { \ byte-arrays:<byte-array> [ emit-<byte-array> iterate-next ] }
+        { \ byte-arrays:(byte-array) [ emit-(byte-array) iterate-next ] }
         { \ math.private:<complex> [ emit-simple-allot iterate-next ] }
         { \ math.private:<ratio> [ emit-simple-allot iterate-next ] }
         { \ kernel:<wrapper> [ emit-simple-allot iterate-next ] }
index 0501458532e1faff6c55142422fefa4c9617a9f6..02e47ca140c00da8bb4fbcd32a637b7487957f25 100644 (file)
@@ -9,6 +9,8 @@ USING: hints math.vectors arrays kernel math accessors sequences ;
 
 HINTS: <double-array> { 2 } { 3 } ;
 
+HINTS: (double-array) { 2 } { 3 } ;
+
 HINTS: vneg { array } { double-array } ;
 HINTS: v*n { array object } { double-array float } ;
 HINTS: n*v { array object } { float double-array } ;
index 28946494282ec6ef777a91aa0931f511033ab39c..579da5b84a4dd783b2d7cc0523d2127e553b4325 100644 (file)
@@ -10,10 +10,14 @@ ERROR: bad-byte-array-length byte-array type ;
 M: bad-byte-array-length summary
     drop "Byte array length doesn't divide type width" ;
 
+: (c-array) ( n c-type -- array )
+    heap-size * (byte-array) ; inline
+
 FUNCTOR: define-array ( T -- )
 
 A            DEFINES ${T}-array
 <A>          DEFINES <${A}>
+(A)          DEFINES (${A})
 >A           DEFINES >${A}
 byte-array>A DEFINES byte-array>${A}
 A{           DEFINES ${A}{
@@ -29,6 +33,8 @@ TUPLE: A
 
 : <A> ( n -- specialized-array ) dup T <c-array> A boa ; inline
 
+: (A) ( n -- specialized-array ) dup T (c-array) A boa ; inline
+
 : byte-array>A ( byte-array -- specialized-array )
     dup length T heap-size /mod 0 = [ drop T bad-byte-array-length ] unless
     swap A boa ; inline
@@ -45,7 +51,7 @@ M: A set-nth-unsafe underlying>> SET-NTH call ;
 
 M: A like drop dup A instance? [ >A execute ] unless ;
 
-M: A new-sequence drop <A> execute ;
+M: A new-sequence drop (A) execute ;
 
 M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ;
 
index a998e5394b7ee127da20d9d1cbcb2e1adb3f1723..ad4cadb743a4c518ed91b1c74313fbeb8743b4f3 100644 (file)
@@ -480,6 +480,9 @@ M: object infer-call*
 \ <byte-array> { integer } { byte-array } define-primitive
 \ <byte-array> make-flushable
 
+\ (byte-array) { integer } { byte-array } define-primitive
+\ (byte-array) make-flushable
+
 \ <displaced-alien> { integer c-ptr } { c-ptr } define-primitive
 \ <displaced-alien> make-flushable
 
@@ -608,6 +611,9 @@ M: object infer-call*
 \ <string> { integer integer } { string } define-primitive
 \ <string> make-flushable
 
+\ (string) { integer } { string } define-primitive
+\ (string) make-flushable
+
 \ array>quotation { array } { quotation } define-primitive
 \ array>quotation make-flushable
 
index 27358b53fc8644e5a871912a8bbd5465164c86aa..a614e2eb0a72400fe64191fdf26eb7196486d902 100644 (file)
@@ -4,7 +4,7 @@ USING: threads kernel namespaces continuations combinators
 sequences math namespaces.private continuations.private
 concurrency.messaging quotations kernel.private words
 sequences.private assocs models models.filter arrays accessors
-generic generic.standard definitions make ;
+generic generic.standard definitions make sbufs ;
 IN: tools.walker
 
 SYMBOL: show-walker-hook ! ( status continuation thread -- )
@@ -147,10 +147,15 @@ SYMBOL: +stopped+
     { (call-next-method) [ (step-into-call-next-method) ] }
 } [ "step-into" set-word-prop ] assoc-each
 
+! Never step into these words
 {
     >n ndrop >c c>
     continue continue-with
     stop suspend (spawn)
+    ! Don't step into some sequence words since output of
+    ! (string) and new-sequence-unsafe may not print due to
+    ! memory safety issues
+    <sbuf> prepare-subseq subseq new-sequence-unsafe
 } [
     dup [ execute break ] curry
     "step-into" set-word-prop
index cc05efc46e3818e6e747f0e03e8d715477b31823..79cc922f7864035a86beea2146724e171e1fa50c 100644 (file)
@@ -468,6 +468,7 @@ tuple
     { "dlsym" "alien" }
     { "dlclose" "alien" }
     { "<byte-array>" "byte-arrays" }
+    { "(byte-array)" "byte-arrays" }
     { "<displaced-alien>" "alien" }
     { "alien-signed-cell" "alien.accessors" }
     { "set-alien-signed-cell" "alien.accessors" }
@@ -519,6 +520,7 @@ tuple
     { "<wrapper>" "kernel" }
     { "(clone)" "kernel" }
     { "<string>" "strings" }
+    { "(string)" "strings.private" }
     { "array>quotation" "quotations.private" }
     { "quotation-xt" "quotations" }
     { "<tuple>" "classes.tuple.private" }
index f981e758d79e3bd3c76613a74405033c9df3ca8b..f0d188ce4a705855a356eb3b07c3e332a55e090a 100644 (file)
@@ -9,7 +9,7 @@ M: byte-array length length>> ;
 M: byte-array nth-unsafe swap >fixnum alien-unsigned-1 ;
 M: byte-array set-nth-unsafe swap >fixnum set-alien-unsigned-1 ;
 : >byte-array ( seq -- byte-array ) B{ } clone-like ; inline
-M: byte-array new-sequence drop <byte-array> ;
+M: byte-array new-sequence drop (byte-array) ;
 
 M: byte-array equal?
     over byte-array? [ sequence= ] [ 2drop f ] if ;
index 5590432ef4ca3908facee7aadd6fb31fcb704b26..0b6f089443d7b698c720a8b6d80faf7e6185bf0f 100644 (file)
@@ -8,7 +8,7 @@ TUPLE: sbuf
 { underlying string }
 { length array-capacity } ;
 
-: <sbuf> ( n -- sbuf ) 0 <string> 0 sbuf boa ; inline
+: <sbuf> ( n -- sbuf ) (string) 0 sbuf boa ; inline
 
 M: sbuf set-nth-unsafe
     [ >fixnum ] [ >fixnum ] [ underlying>> ] tri* set-string-nth ;
index 0b3e0003ac90ec40ca9897a05a2e48185731d36c..a78117c35f03064f489e0afc603d44ca114c42f0 100644 (file)
@@ -59,7 +59,7 @@ HELP: immutable
 
 HELP: new-sequence
 { $values { "len" "a non-negative integer" } { "seq" sequence } { "newseq" "a mutable sequence" } }
-{ $contract "Outputs a mutable sequence of length " { $snippet "n" } " which can hold the elements of " { $snippet "seq" } "." } ;
+{ $contract "Outputs a mutable sequence of length " { $snippet "n" } " which can hold the elements of " { $snippet "seq" } ". The initial contents of the sequence are undefined." } ;
 
 HELP: new-resizable
 { $values { "len" "a non-negative integer" } { "seq" sequence } { "newseq" "a resizable mutable sequence" } }
index 8c9eff94f514d2dfc1f52d3c915f478c0b74bd15..8083cffe972e9ac631982fdeadca6eccdf8816e4 100644 (file)
@@ -81,6 +81,7 @@ GENERIC: resize ( n seq -- newseq ) flushable
 ! Unsafe sequence protocol for inner loops
 GENERIC: nth-unsafe ( n seq -- elt ) flushable
 GENERIC: set-nth-unsafe ( elt n seq -- )
+GENERIC: new-sequence-unsafe ( len seq -- newseq ) flushable
 
 M: sequence nth bounds-check nth-unsafe ;
 M: sequence set-nth bounds-check set-nth-unsafe ;
@@ -88,6 +89,8 @@ M: sequence set-nth bounds-check set-nth-unsafe ;
 M: sequence nth-unsafe nth ;
 M: sequence set-nth-unsafe set-nth ;
 
+M: sequence new-sequence-unsafe new-sequence ;
+
 ! The f object supports the sequence protocol trivially
 M: f length drop 0 ;
 M: f nth-unsafe nip ;
@@ -256,7 +259,7 @@ INSTANCE: repetition immutable-sequence
 
 : prepare-subseq ( from to seq -- dst i src j n )
     #! The check-length call forces partial dispatch
-    [ [ swap - ] dip new-sequence dup 0 ] 3keep
+    [ [ swap - ] dip new-sequence-unsafe dup 0 ] 3keep
     -rot drop roll length check-length ; inline
 
 : check-copy ( src n dst -- )
index 0c3f918fdca03879a8dd65c817b2e94272b0e8a6..6da7bfce0d57c96183150de3aca15d17c4c061aa 100644 (file)
@@ -56,4 +56,6 @@ M: string resize resize-string ;
 
 M: string new-sequence drop 0 <string> ;
 
+M: string new-sequence-unsafe drop (string) ;
+
 INSTANCE: string sequence
index a01a8653b7879a6af41d873b1ab0fd1506fe3c6e..142db9e2048d695c15f47aecae66d704136604f3 100755 (executable)
@@ -74,6 +74,7 @@ void *primitives[] = {
        primitive_dlsym,
        primitive_dlclose,
        primitive_byte_array,
+       primitive_uninitialized_byte_array,
        primitive_displaced_alien,
        primitive_alien_signed_cell,
        primitive_set_alien_signed_cell,
@@ -125,6 +126,7 @@ void *primitives[] = {
        primitive_wrapper,
        primitive_clone,
        primitive_string,
+       primitive_uninitialized_string,
        primitive_array_to_quotation,
        primitive_quotation_xt,
        primitive_tuple,
index 1afbcd3a4062fb2ef7597851fad0274a658b599c..4a598dc601d5088a9f92bcaab81bc873c6ca09f0 100755 (executable)
@@ -243,6 +243,12 @@ void primitive_byte_array(void)
        dpush(tag_object(allot_byte_array(size)));
 }
 
+void primitive_uninitialized_byte_array(void)
+{
+       CELL size = unbox_array_size();
+       dpush(tag_object(allot_byte_array_internal(size)));
+}
+
 F_BYTE_ARRAY *reallot_byte_array(F_BYTE_ARRAY *array, CELL capacity)
 {
        CELL to_copy = array_capacity(array);
index ba8d9689fe8b810c5c02ddc25944b2cebc44fba2..5850489a4c1ae5bb07c3a17ff88b09443a51530a 100755 (executable)
@@ -116,6 +116,7 @@ void primitive_tuple(void);
 void primitive_tuple_boa(void);
 void primitive_tuple_layout(void);
 void primitive_byte_array(void);
+void primitive_uninitialized_byte_array(void);
 void primitive_clone(void);
 
 F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity);
@@ -125,6 +126,7 @@ void primitive_resize_byte_array(void);
 
 F_STRING* allot_string_internal(CELL capacity);
 F_STRING* allot_string(CELL capacity, CELL fill);
+void primitive_uninitialized_string(void);
 void primitive_string(void);
 F_STRING *reallot_string(F_STRING *string, CELL capacity);
 void primitive_resize_string(void);