malloc cleanup

library/alien/c-types.factor

@@ -1,9 +1,9 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
+! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: alien
-USING: arrays assembler compiler compiler-backend errors generic
+USING: arrays compiler compiler-backend errors generic
-hashtables kernel kernel-internals lists math namespaces parser
+hashtables kernel kernel-internals libc lists math namespaces
-sequences sequences-internals strings words ;
+parser sequences strings words ;
 
 : <c-type> ( -- type )
     H{
@@ -33,12 +33,20 @@ SYMBOL: c-types
     >r <c-type> [ swap bind ] keep r> c-types get set-hash ;
     inline
 
-: <c-object> ( type -- c-ptr )
-    global [ c-size <byte-array> ] bind ;
-
 : <c-array> ( size type -- c-ptr )
     global [ c-size * <byte-array> ] bind ;
 
+: <c-object> ( type -- c-ptr ) 1 swap <c-array> ;
+
+: <malloc-array> ( size type -- malloc-ptr )
+    global [ c-size calloc ] bind check-ptr ;
+
+: <malloc-object> ( type -- malloc-ptr ) 1 swap <malloc-array> ;
+
+: <malloc-string> ( string -- alien )
+    "\0" append dup length malloc check-ptr
+    [ alien-address string>memory ] keep ;
+
 : define-pointer ( type -- )
     "void*" c-type swap "*" append c-types get set-hash ;
 

library/alien/malloc.factor

@@ -1,13 +1,13 @@
 ! Copyright (C) 2004, 2005 Mackenzie Straight.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: kernel-internals
+IN: libc
 USING: alien errors kernel math ;
 
 LIBRARY: libc
-FUNCTION: ulong malloc ( ulong size ) ;
+FUNCTION: void* malloc ( ulong size ) ;
-FUNCTION: ulong calloc ( ulong count, ulong size ) ;
+FUNCTION: void* calloc ( ulong count, ulong size ) ;
-FUNCTION: void free ( ulong ptr ) ;
+FUNCTION: void free ( void* ptr ) ;
-FUNCTION: ulong realloc ( ulong ptr, ulong size ) ;
+FUNCTION: void* realloc ( void* ptr, ulong size ) ;
-FUNCTION: void memcpy ( ulong dst, ulong src, ulong size ) ;
+FUNCTION: void memcpy ( void* dst, void* src, ulong size ) ;
 
-: check-ptr dup zero? [ "Out of memory" throw ] when ;
+: check-ptr [ "Out of memory" throw ] unless* ;

library/bootstrap/boot-stage1.factor

@@ -137,13 +137,13 @@ vectors words ;
         "/library/compiler/basic-blocks.factor"
         "/library/compiler/compiler.factor"
 
+        "/library/alien/malloc.factor"
         "/library/alien/c-types.factor"
         "/library/alien/structs.factor"
         "/library/alien/compiler.factor"
         "/library/alien/alien-invoke.factor"
         "/library/alien/alien-callback.factor"
         "/library/alien/syntax.factor"
-        "/library/alien/malloc.factor"
         
         "/library/io/buffer.factor"
 

library/cocoa/subclassing.factor

@@ -1,4 +1,5 @@
 ! Copyright (C) 2006 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 IN: objc
+USING: alien kernel kernel-internals libc math sequences ;
 

library/cocoa/utilities.factor

@@ -85,14 +85,26 @@ C: selector ( name -- sel ) [ set-selector-name ] keep ;
     [ method-list>seq % (objc-methods) ] [ 2drop ] if* ;
 
 : objc-methods ( class -- seq )
-    [ "Null pointer passed to objc-methods" throw ] unless*
     [ f <void*> (objc-methods) ] { } make ;
 
+: (objc-class) ( string word -- class )
+    dupd execute
+    [ ] [ "No such class: " swap append throw ] ?if ; inline
+
+: objc-class ( string -- class )
+    \ objc_getClass (objc-class) ;
+
+: objc-meta-class ( string -- class )
+    \ objc_getMetaClass (objc-class) ;
+
+: class-exists? ( string -- class )
+    objc_getClass >boolean ;
+
 : instance-methods ( classname -- seq )
-    objc_getClass objc-methods ;
+    objc-class objc-methods ;
 
 : class-methods ( classname -- seq )
-    objc_getMetaClass objc-methods ;
+    objc-meta-class objc-methods ;
 
 : make-dip ( quot n -- quot )
     dup \ >r <array> -rot \ r> <array> append3 ;

library/freetype/freetype-gl.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien arrays errors hashtables io kernel
-kernel-internals math namespaces opengl prettyprint
+libc math namespaces opengl prettyprint
 sequences styles ;
 IN: freetype
 
@@ -124,7 +124,7 @@ C: font ( handle -- font )
     FT_RENDER_MODE_NORMAL FT_Render_Glyph freetype-error ;
 
 : with-locked-block ( size quot -- | quot: address -- )
-    swap 1 calloc [ swap call ] keep free ; inline
+    swap 1 calloc [ alien-address swap call ] keep free ; inline
 
 : copy-pixel ( bit tex -- bit tex )
     255 f pick set-alien-unsigned-1 1+

library/io/buffer.factor

@@ -2,19 +2,19 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: io-internals
-USING: alien errors kernel kernel-internals math sequences
+USING: alien errors kernel kernel-internals libc math sequences
 strings ;
 
 TUPLE: buffer size ptr fill pos ;
 
 C: buffer ( size -- buffer )
     2dup set-buffer-size
-    [ >r malloc check-ptr r> set-buffer-ptr ] keep
+    [ >r malloc check-ptr alien-address r> set-buffer-ptr ] keep
     0 over set-buffer-fill
     0 over set-buffer-pos ;
 
 : buffer-free ( buffer -- )
-    dup buffer-ptr free  0 swap set-buffer-ptr ;
+    dup buffer-ptr <alien> free  0 swap set-buffer-ptr ;
 
 : buffer-contents ( buffer -- string )
     dup buffer-ptr over buffer-pos +
@@ -55,7 +55,7 @@ C: buffer ( size -- buffer )
 : buffer-empty? ( buffer -- ? ) buffer-fill zero? ;
 
 : extend-buffer ( length buffer -- )
-    2dup buffer-ptr swap realloc check-ptr
+    2dup buffer-ptr <alien> swap realloc check-ptr alien-address
     over set-buffer-ptr set-buffer-size ;
 
 : check-overflow ( length buffer -- )

library/test/io/buffer.factor

@@ -1,10 +1,10 @@
 IN: temporary
-USING: io-internals kernel kernel-internals sequences test ;
+USING: alien io-internals kernel kernel-internals sequences test ;
 
 : buffer-append ( buffer buffer -- )
     #! Append first buffer to second buffer.
-    2dup buffer-end over buffer-ptr rot buffer-fill memcpy
+    2dup buffer-end <alien> over buffer-ptr <alien>
-    >r buffer-fill r> n>buffer ;
+    rot buffer-fill memcpy >r buffer-fill r> n>buffer ;
 
 : buffer-set ( string buffer -- )
     2dup buffer-ptr string>memory

library/win32/win32-io-internals.factor

@@ -73,7 +73,7 @@ GENERIC: expire
     ] with-scope ;
 
 : <overlapped> ( -- overlapped )
-    "overlapped-ext" c-size malloc <alien> ;
+    "overlapped-ext" <malloc-object> ;
 
 C: io-queue ( -- queue )
     V{ } clone over set-io-queue-callbacks ;