From c89a40f902c817d37756a638d0ed845ab7320b1e Mon Sep 17 00:00:00 2001 From: slava Date: Wed, 8 Mar 2006 21:06:13 +0000 Subject: [PATCH] malloc cleanup --- library/alien/c-types.factor | 22 +++++++++++++++------- library/alien/malloc.factor | 14 +++++++------- library/bootstrap/boot-stage1.factor | 2 +- library/cocoa/subclassing.factor | 1 + library/cocoa/utilities.factor | 18 +++++++++++++++--- library/freetype/freetype-gl.factor | 4 ++-- library/io/buffer.factor | 8 ++++---- library/test/io/buffer.factor | 6 +++--- library/win32/win32-io-internals.factor | 2 +- 9 files changed, 49 insertions(+), 28 deletions(-) diff --git a/library/alien/c-types.factor b/library/alien/c-types.factor index 78f6c851a6..4a2afff30b 100644 --- a/library/alien/c-types.factor +++ b/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 -hashtables kernel kernel-internals lists math namespaces parser -sequences sequences-internals strings words ; +USING: arrays compiler compiler-backend errors generic +hashtables kernel kernel-internals libc lists math namespaces +parser sequences strings words ; : ( -- type ) H{ @@ -33,12 +33,20 @@ SYMBOL: c-types >r [ swap bind ] keep r> c-types get set-hash ; inline -: ( type -- c-ptr ) - global [ c-size ] bind ; - : ( size type -- c-ptr ) global [ c-size * ] bind ; +: ( type -- c-ptr ) 1 swap ; + +: ( size type -- malloc-ptr ) + global [ c-size calloc ] bind check-ptr ; + +: ( type -- malloc-ptr ) 1 swap ; + +: ( 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 ; diff --git a/library/alien/malloc.factor b/library/alien/malloc.factor index 8e23f7e8c4..b5564775a5 100644 --- a/library/alien/malloc.factor +++ b/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: ulong calloc ( ulong count, ulong size ) ; -FUNCTION: void free ( ulong ptr ) ; -FUNCTION: ulong realloc ( ulong ptr, ulong size ) ; -FUNCTION: void memcpy ( ulong dst, ulong src, ulong size ) ; +FUNCTION: void* malloc ( ulong size ) ; +FUNCTION: void* calloc ( ulong count, ulong size ) ; +FUNCTION: void free ( void* ptr ) ; +FUNCTION: void* realloc ( void* ptr, 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* ; diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 0d14aeb164..fe3231981c 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/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" diff --git a/library/cocoa/subclassing.factor b/library/cocoa/subclassing.factor index 7b5faa3fb2..40e183e0ac 100644 --- a/library/cocoa/subclassing.factor +++ b/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 ; diff --git a/library/cocoa/utilities.factor b/library/cocoa/utilities.factor index 53bc40c253..1bd210f9fd 100644 --- a/library/cocoa/utilities.factor +++ b/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 (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 -rot \ r> append3 ; diff --git a/library/freetype/freetype-gl.factor b/library/freetype/freetype-gl.factor index 69db77be0c..0c9831012c 100644 --- a/library/freetype/freetype-gl.factor +++ b/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+ diff --git a/library/io/buffer.factor b/library/io/buffer.factor index 38d26b6d19..0815151b0f 100644 --- a/library/io/buffer.factor +++ b/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 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 swap realloc check-ptr alien-address over set-buffer-ptr set-buffer-size ; : check-overflow ( length buffer -- ) diff --git a/library/test/io/buffer.factor b/library/test/io/buffer.factor index 49d023641a..69c5c7df3f 100644 --- a/library/test/io/buffer.factor +++ b/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 - >r buffer-fill r> n>buffer ; + 2dup buffer-end over buffer-ptr + rot buffer-fill memcpy >r buffer-fill r> n>buffer ; : buffer-set ( string buffer -- ) 2dup buffer-ptr string>memory diff --git a/library/win32/win32-io-internals.factor b/library/win32/win32-io-internals.factor index 3b11784a3a..a3bfb81f5b 100644 --- a/library/win32/win32-io-internals.factor +++ b/library/win32/win32-io-internals.factor @@ -73,7 +73,7 @@ GENERIC: expire ] with-scope ; : ( -- overlapped ) - "overlapped-ext" c-size malloc ; + "overlapped-ext" ; C: io-queue ( -- queue ) V{ } clone over set-io-queue-callbacks ;