]> gitweb.factorcode.org Git - factor.git/commitdiff
stdio-binary cleanup
authorSlava Pestov <slava@factorcode.org>
Fri, 10 Jun 2005 20:08:00 +0000 (20:08 +0000)
committerSlava Pestov <slava@factorcode.org>
Fri, 10 Jun 2005 20:08:00 +0000 (20:08 +0000)
24 files changed:
TODO.FACTOR.txt
doc/handbook.tex
library/bootstrap/boot-stage3.factor
library/bootstrap/image.factor
library/bootstrap/primitives.factor
library/collections/arrays.factor
library/collections/hashtables.factor
library/collections/sbuf.factor
library/collections/sequences-epilogue.factor
library/collections/sequences.factor
library/collections/vectors.factor
library/generic/tuple.factor
library/io/buffer.factor
library/io/stdio-binary.factor
library/tools/jedit-wire.factor
library/tools/jedit.factor
library/unix/syscalls.factor
library/unix/types.factor [new file with mode: 0644]
native/array.c
native/array.h
native/primitives.c
native/s48_bignumint.h
native/string.c
native/string.h

index 8c83b47322e85a3d3b0cf7a17309022d9f07243b..9ff04efb44be8ed5964279d93fe2e974844d1d69 100644 (file)
@@ -7,15 +7,11 @@
 <magnus--> http://clozure.com/cgi-bin/viewcvs.cgi/ccl/lisp-kernel/lisp-exceptions.c?rev=1.9&content-type=text/vnd.viewcvs-markup\r
 \r
 <erg> if write returns -1  and errno == EINTR then it's not a real error, you can try again\r
-\r
-- make head? tail? more efficient with slices\r
-- fix ceiling\r
 - single-stepper and variable access: wrong namespace?\r
 - investigate if COPYING_GEN needs a fix\r
 - faster layout\r
-- keep alive\r
+- http keep alive, and range get\r
 - sleep word\r
-- fix fixnum<< overflow on PowerPC\r
 - fix i/o on generic x86/ppc unix\r
 - alien primitives need a more general input type\r
 - 2map slow with lists\r
@@ -68,6 +64,8 @@
 \r
 + compiler:\r
 \r
+- powerpc: float ffi parameters\r
+- fix fixnum<< and /i overflow on PowerPC\r
 - simplifier:\r
   - kill replace after a peek\r
   - merge inc-d's across VOPs that don't touch the stack\r
index d60fe53390e9d5aab3982be199c8da087a075227..3a1a3c0462959e54b0b5f1421918213dad221e03 100644 (file)
@@ -924,7 +924,7 @@ One exception is that when \texttt{ifte} occurs as the last word in a definition
 
 \subsubsection{Quotation variants}
 
-There are three words that combine shuffle words with \texttt{call}. They are useful in the implementation of higher-order words taking quotations as inputs.
+There are some words that combine shuffle words with \texttt{call}. They are useful in the implementation of higher-order words taking quotations as inputs.
 \wordtable{
 \vocabulary{kernel}
 \ordinaryword{slip}{slip ( quot x -- x | quot:~-- )}
index ce2e9bbee28db0559c7d916afc3652b4e36b94b6..bdcc90ddf808b101c19df5db472cdeb7ce9a8ee4 100644 (file)
@@ -80,6 +80,10 @@ t [
 ] pull-in
 
 compile? [
+    unix? [
+        "/library/unix/types.factor"
+    ] pull-in
+
     os "freebsd" = [
         "/library/unix/syscalls-freebsd.factor"
     ] pull-in
index 983a370b75b6bb6e5db032daffe029f0506d73d3..ea96490c972f4f21adaba82b337b424f608fc64d 100644 (file)
@@ -298,9 +298,9 @@ M: hashtable ' ( hashtable -- pointer )
 
 : write-word ( word -- )
     "64-bits" get [
-        "big-endian" get [ write-be64 ] [ write-le64 ] ifte
+        "big-endian" get [ write-be8 ] [ write-le8 ] ifte
     ] [
-         "big-endian" get [ write-be32 ] [ write-le32 ] ifte
+         "big-endian" get [ write-be4 ] [ write-le4 ] ifte
     ] ifte ;
 
 : write-image ( image file -- )
index d955aa231fb357d47b74208834c057d743da1f3e..8a66fca69997d467d0eb01aeb4e57f9533fb45c8 100644 (file)
@@ -190,8 +190,8 @@ vocabularies get [
     [ "set-integer-slot" "kernel-internals"   [ [ integer object fixnum ] [ ] ] ]
     [ "char-slot" "kernel-internals"          [ [ object fixnum ] [ fixnum ] ] ]
     [ "set-char-slot" "kernel-internals"      [ [ integer object fixnum ] [ ] ] ]
-    [ "grow-array" "kernel-internals"         [ [ integer array ] [ array ] ] ]
-    [ "grow-string" "kernel-internals"        [ [ integer string ] [ string ] ] ]
+    [ "resize-array" "kernel-internals"       [ [ integer array ] [ array ] ] ]
+    [ "resize-string" "strings"               [ [ integer string ] [ string ] ] ]
     [ "<hashtable>" "hashtables"              [ [ number ] [ hashtable ] ] ]
     [ "<array>" "kernel-internals"            [ [ number ] [ array ] ] ]
     [ "<tuple>" "kernel-internals"            [ [ number ] [ tuple ] ] ]
index 0b387ee981a16cd12ae61129f6cc127a42b2fef4..a1adf291830b2ea9e7b4b24378559851b4f183a1 100644 (file)
@@ -11,9 +11,6 @@
 ! low-level... but be aware that vectors are usually a better
 ! choice.
 
-IN: math
-DEFER: repeat
-
 IN: kernel-internals
 USING: kernel math-internals sequences ;
 
@@ -25,12 +22,7 @@ BUILTIN: array 8 array? ;
 : set-array-nth ( obj n a -- ) swap 2 fixnum+ set-slot ; inline
 : dispatch ( n vtable -- ) 2 slot array-nth call ;
 
-: copy-array ( to from -- )
-    dup array-capacity [
-        3dup swap array-nth pick rot set-array-nth
-    ] repeat 2drop ;
-
 M: array length array-capacity ;
 M: array nth array-nth ;
 M: array set-nth set-array-nth ;
-M: array (grow) grow-array ;
+M: array resize resize-array ;
index 5a929154ca4edd8c5094130ff979f6960009a34e..f72368aa5fe38252b37833bb165c2ac8925498c8 100644 (file)
@@ -140,7 +140,7 @@ IN: hashtables
 M: hashtable clone ( hash -- hash )
     dup bucket-count <hashtable>
     over hash-size over set-hash-size
-    [ hash-array swap hash-array copy-array ] keep ;
+    [ hash-array swap hash-array copy-into ] keep ;
 
 M: hashtable = ( obj hash -- ? )
     2dup eq? [
index 30d998db6cb99690e49b5227b8b6066fb46f19d3..3af4b3942b05fac778d5e6a699b6162725046e7a 100644 (file)
@@ -8,7 +8,7 @@ USING: kernel math strings ;
 IN: strings
 USING: generic sequences ;
 
-M: string (grow) grow-string ;
+M: string resize resize-string ;
 
 DEFER: sbuf?
 BUILTIN: sbuf 13 sbuf?
@@ -16,7 +16,7 @@ BUILTIN: sbuf 13 sbuf?
     [ 2 underlying set-underlying ] ;
 
 M: sbuf set-length ( n sbuf -- )
-    growable-check 2dup grow set-capacity ;
+    growable-check 2dup expand set-capacity ;
 
 M: sbuf nth ( n sbuf -- ch )
     bounds-check underlying char-slot ;
index f1888676bd97eca279c34661c747908d7a8b79cc..d3762b44b89a163c7d93ea38d4adbe7cfbfd1f73 100644 (file)
@@ -137,6 +137,9 @@ M: object peek ( sequence -- element )
 
 M: object reverse ( seq -- seq ) [ nreverse ] immutable ;
 
+: copy-into ( to from -- )
+    dup length [ 3dup swap nth pick rot set-nth ] repeat 3drop ;
+
 ! Equality testing
 : length= ( seq seq -- ? ) length swap length number= ;
 
index 9c4fb35c96cbb25ffd4728b17056ba91c280ccec..4cd726c152910b7b3f7abe4d7777010fd7d3544f 100644 (file)
@@ -25,6 +25,7 @@ GENERIC: contains? ( elt seq -- ? )
 GENERIC: head ( n seq -- seq )
 GENERIC: tail ( n seq -- seq )
 GENERIC: concat ( seq -- seq )
+GENERIC: resize ( n seq -- seq )
 
 G: each ( seq quot -- | quot: elt -- )
     [ over ] [ type ] ; inline
@@ -76,12 +77,9 @@ IN: kernel-internals
 GENERIC: underlying
 GENERIC: set-underlying
 GENERIC: set-capacity
-GENERIC: (grow)
 
-: grow ( len seq -- )
-    #! If the sequence cannot accomodate len elements, resize it
-    #! to exactly len.
-    [ underlying (grow) ] keep set-underlying ;
+: expand ( len seq -- )
+    [ underlying resize ] keep set-underlying ;
 
 : ensure ( n seq -- )
     #! If n is beyond the sequence's length, increase the length,
@@ -90,7 +88,7 @@ GENERIC: (grow)
     2dup length fixnum>= [
         >r 1 fixnum+ r>
         2dup underlying length fixnum> [
-            over 2 fixnum* over grow
+            over 2 fixnum* over expand
         ] when
         set-capacity
     ] [
index 7dd384bddff14be96eead1c5625a9f8fb66db229..bf217329eafadb279347df431d904e7c1a9b926b 100644 (file)
@@ -10,7 +10,7 @@ BUILTIN: vector 11 vector?
     [ 2 underlying set-underlying ] ;
 
 M: vector set-length ( len vec -- )
-    growable-check 2dup grow set-capacity ;
+    growable-check 2dup expand set-capacity ;
 
 M: vector nth ( n vec -- obj )
     bounds-check underlying array-nth ;
index 7d56015d06d0145ef447a765a516710305b3f972..55ce819698a741523595b93a793c48b2718f35fd 100644 (file)
@@ -12,6 +12,11 @@ hashtables errors sequences vectors ;
 ! slot 2 - the class, a word
 ! slot 3 - the delegate tuple, or f
 
+: copy-array ( to from -- )
+    dup array-capacity [
+        3dup swap array-nth pick rot set-array-nth
+    ] repeat 2drop ;
+
 : make-tuple ( class size -- tuple )
     #! Internal allocation function. Do not call it directly,
     #! since you can fool the runtime and corrupt memory by
index 432b6a0272f1177615a0a11dbcd9d5a99ede44b2..624fa879435487d83d7961c205856aeea0f24c8f 100644 (file)
@@ -8,9 +8,9 @@ TUPLE: buffer size ptr fill pos ;
 
 C: buffer ( size -- buffer )
     2dup set-buffer-size
-    swap malloc check-ptr swap [ set-buffer-ptr ] keep
-    0 swap [ set-buffer-fill ] keep
-    0 swap [ set-buffer-pos ] keep ;
+    [ >r malloc check-ptr r> set-buffer-ptr ] keep
+    0 over set-buffer-fill
+    0 over set-buffer-pos ;
 
 : buffer-free ( buffer -- )
     #! Frees the C memory associated with the buffer.
@@ -31,8 +31,8 @@ C: buffer ( size -- buffer )
     [ buffer-fill min ] keep
     [ set-buffer-pos ] keep
     dup buffer-pos over buffer-fill = [
-        [ 0 swap set-buffer-pos ] keep
-        [ 0 swap set-buffer-fill ] keep
+        0 over set-buffer-pos
+        0 over set-buffer-fill
     ] when drop ;
 
 : buffer@ ( buffer -- int ) dup buffer-ptr swap buffer-pos + ;
@@ -99,5 +99,5 @@ C: buffer ( size -- buffer )
     2dup buffer-ptr string>memory
     >r length r> buffer-reset ;
 
-: string>buffer ( string - -buffer )
+: string>buffer ( string -buffer )
     dup length <buffer> tuck buffer-set ;
index a655ca4bf77c155ee75a38cf804fff81d2e51674..f68f2f7ab67141953937d53b47b3368e9738f35a 100644 (file)
@@ -1,65 +1,20 @@
 ! Copyright (C) 2003, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: stdio
-USING: kernel math ;
+USING: kernel lists math sequences strings ;
 
-: read-le32 ( -- word )
-    read1
-    read1 8  shift bitor
-    read1 16 shift bitor
-    read1 24 shift bitor ;
+: be> ( seq -- x ) 0 swap [ >r 8 shift r> bitor ] each ;
+: le> ( seq -- x ) reverse be> ;
 
-: read-be32 ( -- word )
-    read1 24 shift
-    read1 16 shift bitor
-    read1 8  shift bitor
-    read1          bitor ;
+: nth-byte ( x n -- b ) -8 * shift HEX: ff bitand ;
 
-: byte7 ( num -- byte ) -56 shift HEX: ff bitand ;
-: byte6 ( num -- byte ) -48 shift HEX: ff bitand ;
-: byte5 ( num -- byte ) -40 shift HEX: ff bitand ;
-: byte4 ( num -- byte ) -32 shift HEX: ff bitand ;
-: byte3 ( num -- byte ) -24 shift HEX: ff bitand ;
-: byte2 ( num -- byte ) -16 shift HEX: ff bitand ;
-: byte1 ( num -- byte )  -8 shift HEX: ff bitand ;
-: byte0 ( num -- byte )           HEX: ff bitand ;
+: >le ( x n -- string ) [ nth-byte ] project-with >string ;
+: >be ( x n -- string ) >le reverse ;
 
-: write-le64 ( word -- )
-    dup byte0 write
-    dup byte1 write
-    dup byte2 write
-    dup byte3 write
-    dup byte4 write
-    dup byte5 write
-    dup byte6 write
-        byte7 write ;
+: read-le2 ( -n) 2 read le> ; : read-be2 ( -n) 2 read be> ;
+: read-le4 ( -n) 4 read le> ; : read-be4 ( -n) 4 read be> ;
+: read-le8 ( -n) 8 read le> ; : read-be8 ( -n) 8 read be> ;
 
-: write-be64 ( word -- )
-    dup byte7 write
-    dup byte6 write
-    dup byte5 write
-    dup byte4 write
-    dup byte3 write
-    dup byte2 write
-    dup byte1 write
-        byte0 write ;
-
-: write-le32 ( word -- )
-    dup byte0 write
-    dup byte1 write
-    dup byte2 write
-        byte3 write ;
-
-: write-be32 ( word -- )
-    dup byte3 write
-    dup byte2 write
-    dup byte1 write
-        byte0 write ;
-
-: write-le16 ( char -- )
-    dup byte0 write
-        byte1 write ;
-
-: write-be16 ( char -- )
-    dup byte1 write
-        byte0 write ;
+: write-le2 ( n-) 2 >le write ; : write-be2 ( n-) 2 >be write ;
+: write-le4 ( n-) 4 >le write ; : write-be4 ( n-) 4 >be write ;
+: write-le8 ( n-) 8 >le write ; : write-be8 ( n-) 8 >be write ;
index a97de1d4be6be38356f0ed423208badaf18b7660..530d426a6d6f44e187ff5f4b1a9a3fce651d435b 100644 (file)
@@ -14,10 +14,9 @@ prettyprint sequences stdio streams strings words ;
 ! captured with with-string.
 
 : write-packet ( string -- )
-    dup length write-be32 write flush ;
+    dup length write-be4 write flush ;
 
-: read-packet ( -- string )
-    read-be32 read ;
+: read-packet ( -- string ) read-be4 read ;
 
 : wire-server ( -- )
     #! Repeatedly read jEdit requests and execute them. Return
@@ -40,13 +39,13 @@ prettyprint sequences stdio streams strings words ;
 : jedit-write-attr ( str style -- )
     CHAR: w write
     [ swap . . ] with-string
-    dup length write-be32
+    dup length write-be4
     write ;
 
 TUPLE: jedit-stream ;
 
 M: jedit-stream stream-readln ( stream -- str )
-    [ CHAR: r write flush read-be32 read ] with-wrapper ;
+    [ CHAR: r write flush read-be4 read ] with-wrapper ;
 
 M: jedit-stream stream-write-attr ( str style stream -- )
     [ jedit-write-attr ] with-wrapper ;
index 4e56edf1aa1899f41c084443a298915f8143e17b..9ae8bea67cbee2e4df885c88893006f0bbde56b2 100644 (file)
@@ -25,8 +25,8 @@ streams strings unparser words ;
 
 : send-jedit-request ( request -- )
     jedit-server-info swap "localhost" swap <client> [
-        write-be32
-        dup length write-be16
+        write-be4
+        dup length write-be2
         write flush
     ] with-stream ;
 
index d40a62c6d490c95dda13dcdb79450f6450340bc0..c58f2887f5c7e37ae06e048269b055678c7f3d49 100644 (file)
@@ -5,12 +5,6 @@ USING: alien errors kernel math namespaces ;
 
 ! Alien wrappers for various Unix libc functions.
 
-ALIAS: ulonglong off_t
-ALIAS: long ssize_t
-ALIAS: ulong size_t
-ALIAS: uint socklen_t
-ALIAS: uint in_addr_t
-
 : EINPROGRESS 36 ;
 
 : errno ( -- n )
diff --git a/library/unix/types.factor b/library/unix/types.factor
new file mode 100644 (file)
index 0000000..42de48d
--- /dev/null
@@ -0,0 +1,10 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: unix-internals
+USING: alien errors kernel math namespaces ;
+
+ALIAS: ulonglong off_t
+ALIAS: long ssize_t
+ALIAS: ulong size_t
+ALIAS: uint socklen_t
+ALIAS: uint in_addr_t
index 0dc6b89b27d75ad37ed455a4e81b0d10529a0dfb..09be56e9a4932e3369b6dc15bbd4e4c0b355a75d 100644 (file)
@@ -47,33 +47,32 @@ void primitive_byte_array(void)
 }
 
 /* see note about fill in array() */
-F_ARRAY* grow_array(F_ARRAY* array, CELL capacity, CELL fill)
+F_ARRAY* resize_array(F_ARRAY* array, CELL capacity, CELL fill)
 {
-       int i; F_ARRAY* new_array;
-       CELL curr_cap = array_capacity(array);
-       if(curr_cap >= capacity)
-               return array;
+       int i;
+       F_ARRAY* new_array;
+       
+       CELL to_copy = array_capacity(array);
+       if(capacity < to_copy)
+               to_copy = capacity;
+       
        new_array = allot_array(untag_header(array->header),capacity);
-       memcpy(new_array + 1,array + 1,curr_cap * CELLS);
-       for(i = curr_cap; i < capacity; i++)
+       
+       memcpy(new_array + 1,array + 1,to_copy * CELLS);
+       
+       for(i = to_copy; i < capacity; i++)
                put(AREF(new_array,i),fill);
+
        return new_array;
 }
 
-void primitive_grow_array(void)
+void primitive_resize_array(void)
 {
        F_ARRAY* array; CELL capacity;
        maybe_garbage_collection();
        array = untag_array_fast(dpop());
        capacity = to_fixnum(dpop());
-       dpush(tag_object(grow_array(array,capacity,F)));
-}
-
-F_ARRAY* shrink_array(F_ARRAY* array, CELL capacity)
-{
-       F_ARRAY* new_array = allot_array(untag_header(array->header),capacity);
-       memcpy(new_array + 1,array + 1,capacity * CELLS);
-       return new_array;
+       dpush(tag_object(resize_array(array,capacity,F)));
 }
 
 void fixup_array(F_ARRAY* array)
index 566737610a108fa7e8ff78cd253d0661f4152548..1ce208b81abff03e6b265e0a8f7d4a3eaf4186d7 100644 (file)
@@ -21,9 +21,8 @@ void primitive_array(void);
 void primitive_tuple(void);
 void primitive_byte_array(void);
 
-F_ARRAY* grow_array(F_ARRAY* array, CELL capacity, CELL fill);
-void primitive_grow_array(void);
-F_ARRAY* shrink_array(F_ARRAY* array, CELL capacity);
+F_ARRAY* resize_array(F_ARRAY* array, CELL capacity, CELL fill);
+void primitive_resize_array(void);
 
 #define AREF(array,index) ((CELL)(array) + sizeof(F_ARRAY) + (index) * CELLS)
 
index 6cb10f4d6d099dc49663f95f5733832c4721a65b..91d07090507a6d1ca7b0468b88c2abecd39f73de 100644 (file)
@@ -156,8 +156,8 @@ void* primitives[] = {
        primitive_set_integer_slot,
        primitive_char_slot,
        primitive_set_char_slot,
-       primitive_grow_array,
-       primitive_grow_string,
+       primitive_resize_array,
+       primitive_resize_string,
        primitive_hashtable,
        primitive_array,
        primitive_tuple,
index 059763bba22c0e73097f8edcef1970d8fc9572b7..dc80e496086a23cf069b0b198c1c0f7c3fc6734e 100644 (file)
@@ -57,8 +57,7 @@ typedef long bignum_length_type;
 /* BIGNUM_REDUCE_LENGTH allows the memory system to reclaim some
    space when a bignum's length is reduced from its original value. */
 #define BIGNUM_REDUCE_LENGTH(target, source, length)            \
-     target = shrink_array(source, length + 1)
-/* extern F_ARRAY* shrink_array(F_ARRAY* array, CELL capacity); */
+     target = resize_array(source, length + 1,0)
 
 /* BIGNUM_DEALLOCATE is called when disposing of bignums which are
    created as intermediate temporaries; Scheme doesn't need this. */
index 90ebe511e7e9b1ddca911159ba439d69c5c2afb9..4f08f326e406132129d674b59d9b66aec6bbb07e 100644 (file)
@@ -45,29 +45,32 @@ F_STRING* string(CELL capacity, CELL fill)
        return string;
 }
 
-F_STRING* grow_string(F_STRING* string, F_FIXNUM capacity, u16 fill)
+F_STRING* resize_string(F_STRING* string, F_FIXNUM capacity, u16 fill)
 {
        /* later on, do an optimization: if end of array is here, just grow */
        CELL i;
-       CELL old_capacity = string_capacity(string);
+       CELL to_copy = string_capacity(string);
+
+       if(capacity < to_copy)
+               to_copy = capacity;
 
        F_STRING* new_string = allot_string(capacity);
 
-       memcpy(new_string + 1,string + 1,old_capacity * CHARS);
+       memcpy(new_string + 1,string + 1,to_copy * CHARS);
 
-       for(i = old_capacity; i < capacity; i++)
+       for(i = to_copy; i < capacity; i++)
                cput(SREF(new_string,i),fill);
 
        return new_string;
 }
 
-void primitive_grow_string(void)
+void primitive_resize_string(void)
 {
        F_STRING* string; CELL capacity;
        maybe_garbage_collection();
        string = untag_string_fast(dpop());
        capacity = to_fixnum(dpop());
-       dpush(tag_object(grow_string(string,capacity,F)));
+       dpush(tag_object(resize_string(string,capacity,F)));
 }
 
 F_STRING* memory_to_string(const BYTE* string, CELL length)
index fd44faebf6f814add4167202aafa1f225e82c888..16b4496f059f2041f3fb1dba2d7ba6a7e5edfddf 100644 (file)
@@ -31,8 +31,8 @@ F_STRING* allot_string(CELL capacity);
 F_STRING* string(CELL capacity, CELL fill);
 void rehash_string(F_STRING* str);
 void primitive_rehash_string(void);
-F_STRING* grow_string(F_STRING* string, F_FIXNUM capacity, u16 fill);
-void primitive_grow_string(void);
+F_STRING* resize_string(F_STRING* string, F_FIXNUM capacity, u16 fill);
+void primitive_resize_string(void);
 char* to_c_string(F_STRING* s);
 char* to_c_string_unchecked(F_STRING* s);
 void string_to_memory(F_STRING* s, BYTE* string);