From 346cb9cb7d14684f61fe380fbe8bc90d1df9eea3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 25 Dec 2005 22:46:21 +0000 Subject: [PATCH] C type cleanup --- TODO.FACTOR.txt | 1 + contrib/cairo/cairo_simple.factor | 2 +- contrib/cairo/cairo_text.factor | 2 +- contrib/space-invaders/space-invaders.factor | 2 +- contrib/x11/lesson2.factor | 2 +- examples/factoroids/input.factor | 5 ++-- examples/factoroids/utils.factor | 2 +- library/alien/c-types.factor | 27 ++++---------------- library/ui/world.factor | 2 +- library/unix/io.factor | 6 ++--- library/unix/sockets.factor | 4 +-- library/unix/syscalls.factor | 2 +- native/array.c | 3 ++- 13 files changed, 23 insertions(+), 37 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 9d25f79ee1..6cbec48ffe 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,3 +1,4 @@ +- remove , , - 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 diff --git a/contrib/cairo/cairo_simple.factor b/contrib/cairo/cairo_simple.factor index 02106bc7b1..404706f658 100644 --- a/contrib/cairo/cairo_simple.factor +++ b/contrib/cairo/cairo_simple.factor @@ -52,7 +52,7 @@ USE: sdl-video : cairo-sdl-test ( -- ) 320 240 32 SDL_HWSURFACE [ set-up-cairo - event-loop + "event" event-loop cr get cairo_destroy SDL_Quit ] with-screen ; diff --git a/contrib/cairo/cairo_text.factor b/contrib/cairo/cairo_text.factor index 8b811f4866..3d98569a35 100644 --- a/contrib/cairo/cairo_text.factor +++ b/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-loop + "event" event-loop SDL_Quit ] with-screen ; diff --git a/contrib/space-invaders/space-invaders.factor b/contrib/space-invaders/space-invaders.factor index c80f230dfe..21ed7eb958 100644 --- a/contrib/space-invaders/space-invaders.factor +++ b/contrib/space-invaders/space-invaders.factor @@ -179,7 +179,7 @@ M: space-invaders update-video ( value addr cpu -- ) : run ( -- ) 224 256 16 SDL_HWSURFACE [ "invaders.rom" over load-rom - event-loop + "event" event-loop SDL_Quit ] with-screen ; diff --git a/contrib/x11/lesson2.factor b/contrib/x11/lesson2.factor index fa4afae051..6b070cab38 100644 --- a/contrib/x11/lesson2.factor +++ b/contrib/x11/lesson2.factor @@ -17,7 +17,7 @@ SYMBOL: width SYMBOL: height : >int-array ( seq -- int-array ) - dup length dup -rot [ + dup length dup "int" -rot [ pick set-int-nth ] 2each ; diff --git a/examples/factoroids/input.factor b/examples/factoroids/input.factor index 908bc2669d..cb4c028940 100644 --- a/examples/factoroids/input.factor +++ b/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 ( -- ? ) - dup SDL_PollEvent [ handle-event ] [ drop f ] if ; + "event" dup SDL_PollEvent + [ handle-event ] [ drop f ] if ; diff --git a/examples/factoroids/utils.factor b/examples/factoroids/utils.factor index e9fe9cbcf8..97d5d95a4f 100644 --- a/examples/factoroids/utils.factor +++ b/examples/factoroids/utils.factor @@ -16,7 +16,7 @@ USING: alien kernel math namespaces opengl sdl sequences ; ; : >float-array ( seq -- float-array ) - dup length dup -rot + dup length dup "float" -rot [ pick set-float-nth ] 2each ; : light-source diff --git a/library/alien/c-types.factor b/library/alien/c-types.factor index 4b7f21c47e..de5416874c 100644 --- a/library/alien/c-types.factor +++ b/library/alien/c-types.factor @@ -31,9 +31,9 @@ SYMBOL: c-types >r [ swap bind ] keep r> c-types get set-hash ; inline -: bytes>cells cell get / ceiling ; +: ( type -- c-ptr ) c-size ; -: ( size -- c-ptr ) bytes>cells ; +: ( size type -- c-ptr ) c-size * ; : 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 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-constructor) ; - -: array-constructor ( name vocab -- ) - #! Make a word ( n -- byte-array ). - over >r >r "-array" append r> r> - [ * ] (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 [ 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 - 2dup c-constructor - 2dup array-constructor - define-nth ; + over define-pointer define-nth ; : define-primitive-type ( quot name -- ) [ define-c-type ] keep "alien" diff --git a/library/ui/world.factor b/library/ui/world.factor index 575cd161e2..e1d2a6254f 100644 --- a/library/ui/world.factor +++ b/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 ? ) dup SDL_PollEvent ; +: next-event ( -- event ? ) "event" dup SDL_PollEvent ; GENERIC: handle-event ( event -- ) diff --git a/library/unix/io.factor b/library/unix/io.factor index cb1c2103e3..5d054d361f 100644 --- a/library/unix/io.factor +++ b/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 read-fdset set + FD_SETSIZE read-fdset set H{ } clone write-tasks set - FD_SETSIZE write-fdset set + FD_SETSIZE write-fdset set 0 1 stdio set ] bind ; diff --git a/library/unix/sockets.factor b/library/unix/sockets.factor index e2ec785bc0..efa6829758 100644 --- a/library/unix/sockets.factor +++ b/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" [ 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 swap set-server-client ; M: accept-task do-io-task ( task -- ? ) - io-task-port + io-task-port "sockaddr-in" over port-handle over "sockaddr-in" c-size accept dup 0 >= [ do-accept t diff --git a/library/unix/syscalls.factor b/library/unix/syscalls.factor index efc6cb2f0a..6d9126c549 100644 --- a/library/unix/syscalls.factor +++ b/library/unix/syscalls.factor @@ -26,7 +26,7 @@ END-STRUCT drop f ] [ 1000 /mod 1000 * - + "timeval" [ set-timeval-usec ] keep [ set-timeval-sec ] keep ] if ; diff --git a/native/array.c b/native/array.c index b69652ef2a..a01b2745b8 100644 --- a/native/array.c +++ b/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() */