C type cleanup

TODO.FACTOR.txt

@@ -1,3 +1,4 @@
+- remove <ushort*-array>, <char*-array>, <void*-array>
 - if cell is rebound, and we allocate c objects, bang
 - make-image leaks memory if there is an error while parsing files
 - runtime primitives like fopen: check for null input

contrib/cairo/cairo_simple.factor

@@ -52,7 +52,7 @@ USE: sdl-video
 : cairo-sdl-test ( -- )
     320 240 32 SDL_HWSURFACE  [
 		set-up-cairo
-        	<event> event-loop
+        	"event" <c-object> event-loop
 		cr get cairo_destroy
 	SDL_Quit
     ] with-screen ;

contrib/cairo/cairo_text.factor

@@ -96,7 +96,7 @@ USING: cairo cairo-sdl compiler errors kernel namespaces sdl sdl-event sdl-gfx s
 
     320 240 32 SDL_HWSURFACE  [
 		set-up-cairo
-        	<event> event-loop
+        	"event" <c-object> event-loop
 	SDL_Quit
     ] with-screen ;
 

contrib/space-invaders/space-invaders.factor

@@ -179,7 +179,7 @@ M: space-invaders update-video ( value addr cpu -- )
 : run ( -- )
   224 256 16 SDL_HWSURFACE [ 
    <space-invaders> "invaders.rom" over load-rom
-   <event> event-loop
+   "event" <c-object> event-loop
     SDL_Quit
   ] with-screen ;
 

contrib/x11/lesson2.factor

@@ -17,7 +17,7 @@ SYMBOL: width
 SYMBOL: height
 
 : >int-array ( seq -- int-array )
-    dup length dup <int-array> -rot [
+    dup length dup "int" <c-array> -rot [
 	pick set-int-nth
     ] 2each ;
 

examples/factoroids/input.factor

@@ -1,5 +1,5 @@
 IN: factoroids
-USING: generic hashtables io kernel math namespaces sdl
+USING: alien generic hashtables io kernel math namespaces sdl
 sequences ;
 
 : fire ( -- )
@@ -48,4 +48,5 @@ M: key-up-event handle-event ( event -- quit? )
     binding second call f ;
 
 : check-event ( -- ? )
-    <event> dup SDL_PollEvent [ handle-event ] [ drop f ] if ;
+    "event" <c-object> dup SDL_PollEvent
+    [ handle-event ] [ drop f ] if ;

examples/factoroids/utils.factor

@@ -16,7 +16,7 @@ USING: alien kernel math namespaces opengl sdl sequences ;
     ;
 
 : >float-array ( seq -- float-array )
-    dup length dup <float-array> -rot
+    dup length dup "float" <c-array> -rot
     [ pick set-float-nth ] 2each ;
 
 : light-source

library/alien/c-types.factor

@@ -31,9 +31,9 @@ SYMBOL: c-types
     >r <c-type> [ swap bind ] keep r> c-types get set-hash ;
     inline
 
-: bytes>cells cell get / ceiling ;
+: <c-object> ( type -- c-ptr ) c-size <byte-array> ;
 
-: <c-object> ( size -- c-ptr ) bytes>cells <byte-array> ;
+: <c-array> ( size type -- c-ptr ) c-size * <byte-array> ;
 
 : define-pointer ( type -- )
     "void*" c-type swap "*" append c-types get set-hash ;
@@ -42,20 +42,6 @@ SYMBOL: c-types
     >r dup "*" swap append r> create
     swap c-getter 0 swons define-compound ;
 
-: (c-constructor) ( name vocab type quot -- )
-    >r >r constructor-word r> c-size r> cons define-compound ;
-
-: c-constructor ( name vocab -- )
-    #! Make a word <foo> where foo is the structure name that
-    #! allocates a Factor heap-local instance of this structure.
-    #! Used for C functions that expect you to pass in a struct.
-    over [ <c-object> ] (c-constructor) ;
-
-: array-constructor ( name vocab -- )
-    #! Make a word <foo-array> ( n -- byte-array ).
-    over >r >r "-array" append r> r>
-    [ * <c-object> ] (c-constructor) ;
-
 : (define-nth) ( word type quot -- )
     >r c-size [ rot * ] cons r> append define-compound ;
 
@@ -65,20 +51,17 @@ SYMBOL: c-types
     swap dup c-getter (define-nth) ;
 
 : define-set-nth ( name vocab -- )
-    #! Make a word foo-nth ( n alien -- displaced-alien ).
+    #! Make a word set-foo-nth ( value n alien -- ).
     >r "set-" over "-nth" append3 r> create
     swap dup c-setter (define-nth) ;
 
 : define-out ( name vocab -- )
     #! Out parameter constructor for integral types.
     over [ <c-object> tuck 0 ] over c-setter append
-    (c-constructor) ;
+    >r >r constructor-word r> r> cons define-compound ;
 
 : init-c-type ( name vocab -- )
-    over define-pointer
+    over define-pointer define-nth ;
-    2dup c-constructor
-    2dup array-constructor
-    define-nth ;
 
 : define-primitive-type ( quot name -- )
     [ define-c-type ] keep "alien"

library/ui/world.factor

@@ -98,7 +98,7 @@ M: f set-message 2drop ;
     world get world-invalid >r layout-world r>
     [ update-hand draw-world ] when ;
 
-: next-event ( -- event ? ) <event> dup SDL_PollEvent ;
+: next-event ( -- event ? ) "event" <c-object> dup SDL_PollEvent ;
 
 GENERIC: handle-event ( event -- )
 

library/unix/io.factor

@@ -24,7 +24,7 @@ USING: namespaces ;
     swap -5 shift set-alien-unsigned-4 ;
 
 : clear-bits ( alien len -- )
-    bytes>cells [ 0 -rot set-alien-unsigned-cell ] each-with ;
+    [ 0 -rot set-alien-unsigned-1 ] each-with ;
 
 ! Global variables
 SYMBOL: read-fdset
@@ -315,8 +315,8 @@ USE: io
     #! other time can have unintended consequences.
     global [
         H{ } clone read-tasks set
-        FD_SETSIZE <c-object> read-fdset set
+        FD_SETSIZE <byte-array> read-fdset set
         H{ } clone write-tasks set
-        FD_SETSIZE <c-object> write-fdset set
+        FD_SETSIZE <byte-array> write-fdset set
         0 1 <fd-stream> stdio set
     ] bind ;

library/unix/sockets.factor

@@ -8,7 +8,7 @@ USING: alien errors generic io kernel math namespaces parser
 threads unix-internals ;
 
 : init-sockaddr ( port -- sockaddr )
-    <sockaddr-in>
+    "sockaddr-in" <c-object>
     [ AF_INET swap set-sockaddr-in-family ] keep
     [ >r htons r> set-sockaddr-in-port ] keep ;
 
@@ -93,7 +93,7 @@ C: accept-task ( port -- task )
     ] keep <client-stream> swap set-server-client ;
 
 M: accept-task do-io-task ( task -- ? )
-    io-task-port <sockaddr-in>
+    io-task-port "sockaddr-in" <c-object>
     over port-handle over "sockaddr-in" c-size <int> accept
     dup 0 >= [
         do-accept t

library/unix/syscalls.factor

@@ -26,7 +26,7 @@ END-STRUCT
         drop f
     ] [
         1000 /mod 1000 *
-        <timeval>
+        "timeval" <c-object>
         [ set-timeval-usec ] keep
         [ set-timeval-sec ] keep
     ] if ;

native/array.c

@@ -44,7 +44,8 @@ void primitive_byte_array(void)
 {
 	F_FIXNUM size = to_fixnum(dpop());
 	maybe_gc(array_size(size));
-	dpush(tag_object(array(BYTE_ARRAY_TYPE,size,0)));
+	F_FIXNUM byte_size = (size + sizeof(CELL) - 1) / sizeof(CELL);
+	dpush(tag_object(array(BYTE_ARRAY_TYPE,byte_size,0)));
 }
 
 /* see note about fill in array() */