From 70a99e1cdb02548627e928196e686b06a078467d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 23 May 2010 03:07:47 -0400 Subject: [PATCH] Updating code to use with-out-parameters --- basis/checksums/openssl/openssl.factor | 9 +- basis/cocoa/messages/messages.factor | 10 +- basis/cocoa/nibs/nibs.factor | 14 +-- basis/cocoa/plists/plists.factor | 8 +- basis/core-foundation/core-foundation.factor | 21 ++-- .../core-foundation/fsevents/fsevents.factor | 3 +- basis/core-foundation/strings/strings.factor | 17 ++-- basis/core-graphics/types/types.factor | 10 +- basis/core-text/core-text.factor | 18 ++-- basis/db/postgresql/lib/lib.factor | 5 +- basis/db/sqlite/lib/lib.factor | 11 ++- basis/game/input/x11/x11.factor | 8 +- basis/io/backend/windows/nt/nt.factor | 14 +-- .../windows/nt/privileges/privileges.factor | 6 +- basis/io/files/info/windows/windows.factor | 98 ++++++++----------- basis/io/launcher/unix/unix.factor | 17 ++-- basis/io/launcher/windows/windows.factor | 2 +- basis/io/sockets/windows/nt/nt.factor | 4 +- basis/iokit/iokit.factor | 9 +- basis/opengl/framebuffers/framebuffers.factor | 4 +- basis/opengl/opengl.factor | 12 +-- basis/opengl/shaders/shaders.factor | 4 +- basis/opengl/textures/textures.factor | 18 ++-- basis/pango/cairo/cairo.factor | 24 ++--- basis/random/windows/windows.factor | 22 ++--- basis/system-info/windows/nt/nt-tests.factor | 5 + basis/system-info/windows/nt/nt.factor | 2 +- basis/ui/backend/cocoa/cocoa.factor | 17 ++-- basis/ui/backend/windows/windows.factor | 8 +- basis/ui/backend/x11/x11.factor | 2 +- basis/unix/process/process.factor | 3 - basis/windows/dwmapi/dwmapi.factor | 2 +- basis/windows/offscreen/offscreen.factor | 4 +- basis/windows/uniscribe/uniscribe.factor | 6 +- 34 files changed, 201 insertions(+), 216 deletions(-) create mode 100644 basis/system-info/windows/nt/nt-tests.factor diff --git a/basis/checksums/openssl/openssl.factor b/basis/checksums/openssl/openssl.factor index 095ab38ace..1fec109d5f 100644 --- a/basis/checksums/openssl/openssl.factor +++ b/basis/checksums/openssl/openssl.factor @@ -1,4 +1,4 @@ -! copyright (C) 2008 Slava Pestov +! Copyright (C) 2008, 2010 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: accessors byte-arrays alien.c-types alien.data kernel continuations destructors sequences io openssl openssl.libcrypto @@ -47,9 +47,10 @@ M: evp-md-context dispose* : digest-value ( ctx -- value ) handle>> - EVP_MAX_MD_SIZE 0 - [ EVP_DigestFinal_ex ssl-error ] 2keep - *int memory>byte-array ; + { { int EVP_MAX_MD_SIZE } int } + [ EVP_DigestFinal_ex ssl-error ] + [ memory>byte-array ] + with-out-parameters ; PRIVATE> diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index 5cce0401ce..029b3f46e6 100644 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2006, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types alien.strings arrays assocs -classes.struct continuations combinators compiler +USING: accessors alien alien.c-types alien.data alien.strings +arrays assocs classes.struct continuations combinators compiler core-graphics.types stack-checker kernel math namespaces make quotations sequences strings words cocoa.runtime cocoa.types io -macros memoize io.encodings.utf8 effects layouts libc -lexer init core-foundation fry generalizations specialized-arrays ; +macros memoize io.encodings.utf8 effects layouts libc lexer init +core-foundation fry generalizations specialized-arrays ; QUALIFIED-WITH: alien.c-types c IN: cocoa.messages @@ -216,7 +216,7 @@ ERROR: no-objc-type name ; objc-methods get set-at ; : each-method-in-class ( class quot -- ) - [ 0 [ class_copyMethodList ] keep *uint ] dip + [ { uint } [ class_copyMethodList ] [ ] with-out-parameters ] dip over 0 = [ 3drop ] [ [ ] dip [ each ] [ drop (free) ] 2bi diff --git a/basis/cocoa/nibs/nibs.factor b/basis/cocoa/nibs/nibs.factor index a39cc794d0..d4a11cc9d5 100644 --- a/basis/cocoa/nibs/nibs.factor +++ b/basis/cocoa/nibs/nibs.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: cocoa.application cocoa.messages cocoa.classes -cocoa.runtime kernel cocoa alien.c-types core-foundation -core-foundation.arrays ; +USING: alien.c-types alien.data cocoa.application cocoa.messages +cocoa.classes cocoa.runtime cocoa core-foundation +core-foundation.arrays kernel ; IN: cocoa.nibs : load-nib ( name -- ) @@ -15,5 +15,7 @@ IN: cocoa.nibs dup [ -> autorelease ] when ; : nib-objects ( anNSNib -- objects/f ) - f f [ -> instantiateNibWithOwner:topLevelObjects: ] keep - swap [ *void* CF>array ] [ drop f ] if ; \ No newline at end of file + f + { void* } [ -> instantiateNibWithOwner:topLevelObjects: ] [ ] + with-out-parameters + swap [ CF>array ] [ drop f ] if ; \ No newline at end of file diff --git a/basis/cocoa/plists/plists.factor b/basis/cocoa/plists/plists.factor index 86b13b2ddc..80d58e6340 100644 --- a/basis/cocoa/plists/plists.factor +++ b/basis/cocoa/plists/plists.factor @@ -36,9 +36,11 @@ DEFER: plist> NSFastEnumeration-map >hashtable ; : (read-plist) ( NSData -- id ) - NSPropertyListSerialization swap kCFPropertyListImmutable f f - [ -> propertyListFromData:mutabilityOption:format:errorDescription: ] keep - *void* [ -> release "read-plist failed" throw ] when* ; + NSPropertyListSerialization swap kCFPropertyListImmutable f + { void* } + [ -> propertyListFromData:mutabilityOption:format:errorDescription: ] [ ] + with-out-parameters + [ -> release "read-plist failed" throw ] when* ; MACRO: objc-class-case ( alist -- quot ) [ diff --git a/basis/core-foundation/core-foundation.factor b/basis/core-foundation/core-foundation.factor index 2ef388563e..0185387597 100644 --- a/basis/core-foundation/core-foundation.factor +++ b/basis/core-foundation/core-foundation.factor @@ -8,23 +8,20 @@ TYPEDEF: void* CFTypeRef TYPEDEF: void* CFAllocatorRef CONSTANT: kCFAllocatorDefault f -TYPEDEF: bool Boolean -TYPEDEF: long CFIndex -TYPEDEF: uchar UInt8 -TYPEDEF: ushort UInt16 -TYPEDEF: uint UInt32 +TYPEDEF: bool Boolean +TYPEDEF: long CFIndex +TYPEDEF: uchar UInt8 +TYPEDEF: ushort UInt16 +TYPEDEF: uint UInt32 TYPEDEF: ulonglong UInt64 -TYPEDEF: char SInt8 -TYPEDEF: short SInt16 -TYPEDEF: int SInt32 -TYPEDEF: longlong SInt64 +TYPEDEF: char SInt8 +TYPEDEF: short SInt16 +TYPEDEF: int SInt32 +TYPEDEF: longlong SInt64 TYPEDEF: ulong CFTypeID TYPEDEF: UInt32 CFOptionFlags TYPEDEF: void* CFUUIDRef -ALIAS: -ALIAS: *CFIndex *long - STRUCT: CFRange { location CFIndex } { length CFIndex } ; diff --git a/basis/core-foundation/fsevents/fsevents.factor b/basis/core-foundation/fsevents/fsevents.factor index ef1a3ff7f1..fd17843bf3 100644 --- a/basis/core-foundation/fsevents/fsevents.factor +++ b/basis/core-foundation/fsevents/fsevents.factor @@ -119,8 +119,7 @@ FUNCTION: CFStringRef FSEventStreamCopyDescription ( FSEventStreamRef streamRef flags FSEventStreamCreate ; -: kCFRunLoopCommonModes ( -- string ) - &: kCFRunLoopCommonModes *void* ; +C-GLOBAL: void* kCFRunLoopCommonModes : schedule-event-stream ( event-stream -- ) CFRunLoopGetMain diff --git a/basis/core-foundation/strings/strings.factor b/basis/core-foundation/strings/strings.factor index 4c7e9ba261..b78e1046fe 100644 --- a/basis/core-foundation/strings/strings.factor +++ b/basis/core-foundation/strings/strings.factor @@ -1,8 +1,9 @@ -! Copyright (C) 2008, 2009 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types alien.syntax alien.strings io.encodings.string -kernel sequences byte-arrays io.encodings.utf8 math core-foundation -core-foundation.arrays destructors parser fry alien words ; +USING: alien.c-types alien.data alien.syntax alien.strings +io.encodings.string kernel sequences byte-arrays +io.encodings.utf8 math core-foundation core-foundation.arrays +destructors parser fry alien words ; IN: core-foundation.strings TYPEDEF: void* CFStringRef @@ -75,8 +76,12 @@ FUNCTION: CFStringRef CFStringCreateWithCString ( : CF>string ( alien -- string ) dup CFStringGetLength [ 0 swap kCFStringEncodingUTF8 0 f ] keep - 4 * 1 + [ dup length 0 [ CFStringGetBytes drop ] keep ] keep - swap *CFIndex head-slice utf8 decode ; + 4 * 1 + [ + dup length + { CFIndex } [ CFStringGetBytes drop ] [ ] + with-out-parameters + ] keep + swap head-slice utf8 decode ; : CF>string-array ( alien -- seq ) CF>array [ CF>string ] map ; diff --git a/basis/core-graphics/types/types.factor b/basis/core-graphics/types/types.factor index 587154fb2f..ac0ba31270 100644 --- a/basis/core-graphics/types/types.factor +++ b/basis/core-graphics/types/types.factor @@ -8,12 +8,6 @@ IN: core-graphics.types SYMBOL: CGFloat << cell 4 = float double ? \ CGFloat typedef >> -: ( x -- alien ) - cell 4 = [ ] [ ] if ; inline - -: *CGFloat ( alien -- x ) - cell 4 = [ *float ] [ *double ] if ; inline - STRUCT: CGPoint { x CGFloat } { y CGFloat } ; @@ -30,7 +24,7 @@ STRUCT: CGSize STRUCT: CGRect { origin CGPoint } - { size CGSize } ; + { size CGSize } ; : CGPoint>loc ( CGPoint -- loc ) [ x>> ] [ y>> ] bi 2array ; @@ -40,7 +34,7 @@ STRUCT: CGRect : CGRect>rect ( CGRect -- rect ) [ origin>> CGPoint>loc ] - [ size>> CGSize>dim ] + [ size>> CGSize>dim ] bi ; inline : CGRect-x ( CGRect -- x ) diff --git a/basis/core-text/core-text.factor b/basis/core-text/core-text.factor index 7af6792e79..4de8b2c06a 100644 --- a/basis/core-text/core-text.factor +++ b/basis/core-text/core-text.factor @@ -1,12 +1,12 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays alien alien.c-types alien.syntax kernel destructors -accessors fry words hashtables strings sequences memoize assocs math -math.order math.vectors math.rectangles math.functions locals init -namespaces combinators fonts colors cache core-foundation -core-foundation.strings core-foundation.attributed-strings -core-foundation.utilities core-graphics core-graphics.types -core-text.fonts ; +USING: arrays alien alien.c-types alien.data alien.syntax kernel +destructors accessors fry words hashtables strings sequences +memoize assocs math math.order math.vectors math.rectangles +math.functions locals init namespaces combinators fonts colors +cache core-foundation core-foundation.strings +core-foundation.attributed-strings core-foundation.utilities +core-graphics core-graphics.types core-text.fonts ; IN: core-text TYPEDEF: void* CTLineRef @@ -50,8 +50,8 @@ ERROR: not-a-string object ; TUPLE: line < disposable line metrics image loc dim ; : typographic-bounds ( line -- width ascent descent leading ) - 0 0 0 - [ CTLineGetTypographicBounds ] 3keep [ *CGFloat ] tri@ ; inline + { CGFloat CGFloat CGFloat } + [ CTLineGetTypographicBounds ] [ ] with-out-parameters ; inline : store-typographic-bounds ( metrics width ascent descent leading -- metrics ) { diff --git a/basis/db/postgresql/lib/lib.factor b/basis/db/postgresql/lib/lib.factor index 5398e669ed..7fe40a73d6 100644 --- a/basis/db/postgresql/lib/lib.factor +++ b/basis/db/postgresql/lib/lib.factor @@ -139,15 +139,14 @@ M: postgresql-malloc-destructor dispose ( obj -- ) [ 3drop ] dip [ memory>byte-array >string - 0 + { uint } [ PQunescapeBytea dup zero? [ postgresql-result-error-message throw ] [ &postgresql-free ] if - ] keep - *uint memory>byte-array + ] [ ] with-out-parameters memory>byte-array ] with-destructors ] [ drop pq-get-is-null nip [ f ] [ B{ } clone ] if diff --git a/basis/db/sqlite/lib/lib.factor b/basis/db/sqlite/lib/lib.factor index b8e56863c3..58033a281e 100644 --- a/basis/db/sqlite/lib/lib.factor +++ b/basis/db/sqlite/lib/lib.factor @@ -27,16 +27,17 @@ ERROR: sqlite-sql-error < sql-error n string ; : sqlite-open ( path -- db ) normalize-path - void* - [ sqlite3_open sqlite-check-result ] keep *void* ; + { void* } [ sqlite3_open sqlite-check-result ] [ ] + with-out-parameters ; : sqlite-close ( db -- ) sqlite3_close sqlite-check-result ; : sqlite-prepare ( db sql -- handle ) - utf8 encode dup length void* void* - [ sqlite3_prepare_v2 sqlite-check-result ] 2keep - drop *void* ; + utf8 encode dup length + { void* void* } + [ sqlite3_prepare_v2 sqlite-check-result ] [ drop ] + with-out-parameters ; : sqlite-bind-parameter-index ( handle name -- index ) sqlite3_bind_parameter_index ; diff --git a/basis/game/input/x11/x11.factor b/basis/game/input/x11/x11.factor index 2e6514d396..c3bf11f7a8 100644 --- a/basis/game/input/x11/x11.factor +++ b/basis/game/input/x11/x11.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types arrays kernel game.input namespaces math classes bit-arrays system sequences vectors -x11 x11.xlib assocs ; +x11 x11.xlib assocs generalizations ; IN: game.input.x11 SINGLETON: x11-game-input-backend @@ -88,9 +88,9 @@ M: x11-game-input-backend read-keyboard : query-pointer ( -- x y buttons ) dpy get dup XDefaultRootWindow - 0 0 0 0 0 0 0 - [ XQueryPointer drop ] 3keep - [ *int ] tri@ ; + { int int int int int int int } + [ XQueryPointer drop ] [ ] with-out-parameters + [ 4 ndrop ] 3dip ; SYMBOL: mouse-reset? diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor index bd59afc26d..14a09bdfac 100644 --- a/basis/io/backend/windows/nt/nt.factor +++ b/basis/io/backend/windows/nt/nt.factor @@ -51,16 +51,12 @@ M: winnt add-completion ( win32-handle -- ) ] with-timeout ; :: wait-for-overlapped ( nanos -- bytes-transferred overlapped error? ) - master-completion-port get-global - 0 :> bytes - f :> key - f :> overlapped nanos [ 1,000,000 /i ] [ INFINITE ] if* :> timeout - bytes key overlapped timeout GetQueuedCompletionStatus zero? :> error? - - bytes *int - overlapped *void* dup [ OVERLAPPED memory>struct ] when - error? ; + master-completion-port get-global + { int void* pointer: OVERLAPPED } + [ timeout GetQueuedCompletionStatus zero? ] [ ] with-out-parameters + :> ( error? bytes key overlapped ) + bytes overlapped error? ; : resume-callback ( result overlapped -- ) >c-ptr pending-overlapped get-global delete-at* drop resume-with ; diff --git a/basis/io/backend/windows/nt/privileges/privileges.factor b/basis/io/backend/windows/nt/privileges/privileges.factor index 6c63d3eda0..27687df9d5 100644 --- a/basis/io/backend/windows/nt/privileges/privileges.factor +++ b/basis/io/backend/windows/nt/privileges/privileges.factor @@ -13,8 +13,10 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES ! http://msdn.microsoft.com/msdnmag/issues/05/03/TokenPrivileges/ : (open-process-token) ( handle -- handle ) - flags{ TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY } PHANDLE - [ OpenProcessToken win32-error=0/f ] keep *void* ; + flags{ TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY } + { PHANDLE } + [ OpenProcessToken win32-error=0/f ] [ ] + with-out-parameters ; : open-process-token ( -- handle ) #! remember to CloseHandle diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index 799b6dc4b2..73d79b20bf 100644 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -21,12 +21,8 @@ IN: io.files.info.windows TUPLE: windows-file-info < file-info attributes ; : get-compressed-file-size ( path -- n ) - DWORD [ GetCompressedFileSize ] keep - over INVALID_FILE_SIZE = [ - win32-error-string throw - ] [ - *uint >64bit - ] if ; + { DWORD } [ GetCompressedFileSize ] [ ] with-out-parameters + over INVALID_FILE_SIZE = [ win32-error-string throw ] [ >64bit ] if ; : set-windows-size-on-disk ( file-info path -- file-info ) over attributes>> +compressed+ swap member? [ @@ -99,22 +95,18 @@ M: windows file-info ( path -- info ) M: windows link-info ( path -- info ) file-info ; +CONSTANT: path-length $[ MAX_PATH 1 + ] + : volume-information ( normalized-path -- volume-name volume-serial max-component flags type ) - MAX_PATH 1 + [ ] keep - DWORD - DWORD - DWORD - MAX_PATH 1 + [ ] keep - [ GetVolumeInformation win32-error=0/f ] 7 nkeep - drop 5 nrot drop - [ utf16n alien>string ] 4 ndip - utf16n alien>string ; + { { ushort path-length } DWORD DWORD DWORD { ushort path-length } } + [ [ path-length ] 4dip path-length GetVolumeInformation win32-error=0/f ] + [ [ utf16n alien>string ] 4dip utf16n alien>string ] + with-out-parameters ; : file-system-space ( normalized-path -- available-space total-space free-space ) - ULARGE_INTEGER - ULARGE_INTEGER - ULARGE_INTEGER - [ GetDiskFreeSpaceEx win32-error=0/f ] 3keep ; + { ULARGE_INTEGER ULARGE_INTEGER ULARGE_INTEGER } + [ GetDiskFreeSpaceEx win32-error=0/f ] [ ] + with-out-parameters ; : calculate-file-system-info ( file-system-info -- file-system-info' ) [ dup [ total-space>> ] [ free-space>> ] bi - >>used-space drop ] keep ; @@ -136,13 +128,13 @@ ERROR: not-absolute-path ; : (file-system-info) ( path -- file-system-info ) dup [ volume-information ] [ file-system-space ] bi \ win32-file-system-info new - swap *ulonglong >>free-space - swap *ulonglong >>total-space - swap *ulonglong >>available-space + swap >>free-space + swap >>total-space + swap >>available-space swap >>type - swap *uint >>flags - swap *uint >>max-component - swap *uint >>device-serial + swap >>flags + swap >>max-component + swap >>device-serial swap >>device-name swap >>mount-point calculate-file-system-info ; @@ -152,36 +144,29 @@ PRIVATE> M: winnt file-system-info ( path -- file-system-info ) normalize-path root-directory (file-system-info) ; -:: volume>paths ( string -- array ) - 16384 :> names-buf-length - names-buf-length :> names - 0 :> names-length +CONSTANT: names-buf-length 16384 - string names names-buf-length names-length GetVolumePathNamesForVolumeName :> ret - ret 0 = [ - ret win32-error-string throw - ] [ - names names-length *uint ushort heap-size * head - utf16n alien>string { CHAR: \0 } split - ] if ; +: volume>paths ( string -- array ) + { { ushort names-buf-length } uint } + [ [ names-buf-length ] dip GetVolumePathNamesForVolumeName win32-error=0/f ] + [ head utf16n alien>string { CHAR: \0 } split ] + with-out-parameters ; : find-first-volume ( -- string handle ) - MAX_PATH 1 + [ ] keep - dupd - FindFirstVolume dup win32-error=0/f - [ utf16n alien>string ] dip ; - -:: find-next-volume ( handle -- string/f ) - MAX_PATH 1 + :> buf-length - buf-length :> buf - - handle buf buf-length FindNextVolume :> ret - ret 0 = [ - GetLastError ERROR_NO_MORE_FILES = - [ f ] [ win32-error-string throw ] if - ] [ - buf utf16n alien>string - ] if ; + { { ushort path-length } } + [ path-length FindFirstVolume dup win32-error=0/f ] + [ utf16n alien>string ] + with-out-parameters swap ; + +: find-next-volume ( handle -- string/f ) + { { ushort path-length } } + [ path-length FindNextVolume ] + [ + swap 0 = [ + GetLastError ERROR_NO_MORE_FILES = + [ drop f ] [ win32-error-string throw ] if + ] [ utf16n alien>string ] if + ] with-out-parameters ; : find-volumes ( -- array ) find-first-volume @@ -202,11 +187,10 @@ M: winnt file-systems ( -- array ) : file-times ( path -- timestamp timestamp timestamp ) [ normalize-path open-read &dispose handle>> - FILETIME - FILETIME - FILETIME - [ GetFileTime win32-error=0/f ] 3keep - [ FILETIME>timestamp >local-time ] tri@ + { FILETIME FILETIME FILETIME } + [ GetFileTime win32-error=0/f ] + [ [ FILETIME>timestamp >local-time ] tri@ ] + with-out-parameters ] with-destructors ; : set-file-times ( path timestamp/f timestamp/f timestamp/f -- ) diff --git a/basis/io/launcher/unix/unix.factor b/basis/io/launcher/unix/unix.factor index 87af808df2..e036f34cc6 100644 --- a/basis/io/launcher/unix/unix.factor +++ b/basis/io/launcher/unix/unix.factor @@ -1,10 +1,11 @@ ! Copyright (C) 2007, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types arrays assocs combinators -continuations environment io io.backend io.backend.unix -io.files io.files.private io.files.unix io.launcher io.pathnames -io.ports kernel math namespaces sequences strings system threads -unix unix.process unix.ffi simple-tokenizer ; +USING: accessors alien.c-types alien.data arrays assocs +combinators continuations environment io io.backend +io.backend.unix io.files io.files.private io.files.unix +io.launcher io.pathnames io.ports kernel math namespaces +sequences strings system threads unix unix.process unix.ffi +simple-tokenizer ; IN: io.launcher.unix : get-arguments ( process -- seq ) @@ -94,10 +95,10 @@ TUPLE: signal n ; dup WIFSIGNALED [ WTERMSIG signal boa ] [ WEXITSTATUS ] if ; M: unix wait-for-processes ( -- ? ) - 0 -1 over WNOHANG waitpid - dup 0 <= [ + { int } [ -1 swap WNOHANG waitpid ] [ ] with-out-parameters + swap dup 0 <= [ 2drop t ] [ find-process dup - [ swap *int code>status notify-exit f ] [ 2drop f ] if + [ swap code>status notify-exit f ] [ 2drop f ] if ] if ; diff --git a/basis/io/launcher/windows/windows.factor b/basis/io/launcher/windows/windows.factor index b279b1e964..cee6f3d60e 100755 --- a/basis/io/launcher/windows/windows.factor +++ b/basis/io/launcher/windows/windows.factor @@ -159,7 +159,7 @@ M: windows kill-process* ( handle -- ) : exit-code ( process -- n ) hProcess>> - 0 [ GetExitCodeProcess ] keep *ulong + { DWORD } [ GetExitCodeProcess ] [ ] with-out-parameters swap win32-error=0/f ; : process-exited ( process -- ) diff --git a/basis/io/sockets/windows/nt/nt.factor b/basis/io/sockets/windows/nt/nt.factor index 7a961518a0..17e92b9b9f 100644 --- a/basis/io/sockets/windows/nt/nt.factor +++ b/basis/io/sockets/windows/nt/nt.factor @@ -17,7 +17,7 @@ M: winnt WSASocket-flags ( -- DWORD ) SIO_GET_EXTENSION_FUNCTION_POINTER WSAID_CONNECTEX GUID heap-size - void* + { void* } [ void* heap-size DWORD @@ -26,7 +26,7 @@ M: winnt WSASocket-flags ( -- DWORD ) WSAIoctl SOCKET_ERROR = [ winsock-error-string throw ] when - ] keep *void* ; + ] [ ] with-out-parameters ; TUPLE: ConnectEx-args port s name namelen lpSendBuffer dwSendDataLength diff --git a/basis/iokit/iokit.factor b/basis/iokit/iokit.factor index 577c9e1273..5720fc5997 100644 --- a/basis/iokit/iokit.factor +++ b/basis/iokit/iokit.factor @@ -1,4 +1,4 @@ -USING: alien.syntax alien.c-types core-foundation +USING: alien.syntax alien.c-types alien.data core-foundation core-foundation.bundles core-foundation.dictionaries system combinators kernel sequences io accessors unix.types ; IN: iokit @@ -131,12 +131,11 @@ TUPLE: mach-error error-code error-string ; dup KERN_SUCCESS = [ drop ] [ throw ] if ; : master-port ( -- port ) - MACH_PORT_NULL 0 [ IOMasterPort mach-error ] keep *uint ; + MACH_PORT_NULL { uint } [ IOMasterPort mach-error ] [ ] with-out-parameters ; : io-services-matching-dictionary ( nsdictionary -- iterator ) - master-port swap 0 - [ IOServiceGetMatchingServices mach-error ] keep - *uint ; + master-port swap + { uint } [ IOServiceGetMatchingServices mach-error ] [ ] with-out-parameters ; : io-services-matching-service ( service -- iterator ) IOServiceMatching io-services-matching-dictionary ; diff --git a/basis/opengl/framebuffers/framebuffers.factor b/basis/opengl/framebuffers/framebuffers.factor index d3e6d7e25a..ce19a2ec89 100644 --- a/basis/opengl/framebuffers/framebuffers.factor +++ b/basis/opengl/framebuffers/framebuffers.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. USING: opengl opengl.gl combinators continuations kernel -alien.c-types ; +alien.c-types alien.data ; IN: opengl.framebuffers : gen-framebuffer ( -- id ) @@ -51,4 +51,4 @@ IN: opengl.framebuffers : framebuffer-attachment ( attachment -- id ) GL_FRAMEBUFFER swap GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME - 0 [ glGetFramebufferAttachmentParameteriv ] keep *uint ; + { uint } [ glGetFramebufferAttachmentParameteriv ] [ ] with-out-parameters ; diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index 6dcb4110a2..893a8dfbd6 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -2,11 +2,11 @@ ! Portions copyright (C) 2007 Eduardo Cavazos. ! Portions copyright (C) 2008 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types ascii calendar combinators.short-circuit -continuations kernel libc math macros namespaces math.vectors -math.parser opengl.gl combinators combinators.smart arrays -sequences splitting words byte-arrays assocs vocabs -colors colors.constants accessors generalizations +USING: alien alien.c-types alien.data ascii calendar +combinators.short-circuit continuations kernel libc math macros +namespaces math.vectors math.parser opengl.gl combinators +combinators.smart arrays sequences splitting words byte-arrays +assocs vocabs colors colors.constants accessors generalizations sequences.generalizations locals fry specialized-arrays ; FROM: alien.c-types => float ; SPECIALIZED-ARRAY: float @@ -139,7 +139,7 @@ MACRO: all-enabled-client-state ( seq quot -- ) swap glPushAttrib call glPopAttrib ; inline : (gen-gl-object) ( quot -- id ) - [ 1 0 ] dip keep *uint ; inline + [ 1 { uint } ] dip [ ] with-out-parameters ; inline : (delete-gl-object) ( id quot -- ) [ 1 swap ] dip call ; inline diff --git a/basis/opengl/shaders/shaders.factor b/basis/opengl/shaders/shaders.factor index 562cbc91ce..4e17a01624 100644 --- a/basis/opengl/shaders/shaders.factor +++ b/basis/opengl/shaders/shaders.factor @@ -20,7 +20,7 @@ IN: opengl.shaders dup integer? [ glIsShader c-bool> ] [ drop f ] if ; : gl-shader-get-int ( shader enum -- value ) - 0 [ glGetShaderiv ] keep *int ; + { int } [ glGetShaderiv ] [ ] with-out-parameters ; : gl-shader-ok? ( shader -- ? ) GL_COMPILE_STATUS gl-shader-get-int c-bool> ; @@ -79,7 +79,7 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ; dup integer? [ glIsProgram c-bool> ] [ drop f ] if ; : gl-program-get-int ( program enum -- value ) - 0 [ glGetProgramiv ] keep *int ; + { int } [ glGetProgramiv ] [ ] with-out-parameters ; : gl-program-ok? ( program -- ? ) GL_LINK_STATUS gl-program-get-int c-bool> ; diff --git a/basis/opengl/textures/textures.factor b/basis/opengl/textures/textures.factor index 2341706f4c..dacea0888a 100644 --- a/basis/opengl/textures/textures.factor +++ b/basis/opengl/textures/textures.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs cache colors.constants destructors -kernel opengl opengl.gl opengl.capabilities combinators images -images.tesselation grouping sequences math math.vectors -generalizations fry arrays namespaces system -locals literals specialized-arrays ; -FROM: alien.c-types => float *float *int ; +USING: accessors alien.data assocs cache colors.constants +destructors kernel opengl opengl.gl opengl.capabilities +combinators images images.tesselation grouping sequences math +math.vectors generalizations fry arrays namespaces system locals +literals specialized-arrays ; +FROM: alien.c-types => int float ; SPECIALIZED-ARRAY: float IN: opengl.textures @@ -406,7 +406,7 @@ PRIVATE> [ [ max-texture-size tesselate ] dip ] if ; : get-texture-float ( target level enum -- value ) - 0 [ glGetTexLevelParameterfv ] keep *float ; inline -: get-texture-int ( target level enum -- value ) - 0 [ glGetTexLevelParameteriv ] keep *int ; inline + { float } [ glGetTexLevelParameterfv ] [ ] with-out-parameters ; inline +: get-texture-int ( target level enum -- value ) + { int } [ glGetTexLevelParameteriv ] [ ] with-out-parameters ; inline diff --git a/basis/pango/cairo/cairo.factor b/basis/pango/cairo/cairo.factor index 85d4cef424..68a9f2f6df 100644 --- a/basis/pango/cairo/cairo.factor +++ b/basis/pango/cairo/cairo.factor @@ -3,12 +3,13 @@ ! See http://factorcode.org/license.txt for BSD license. ! ! pangocairo bindings, from pango/pangocairo.h -USING: arrays sequences alien alien.c-types alien.destructors -alien.libraries alien.syntax math math.functions math.vectors -destructors combinators colors fonts accessors assocs namespaces -kernel pango pango.fonts pango.layouts glib unicode.data images -cache init system math.rectangles fry memoize io.encodings.utf8 -classes.struct cairo cairo.ffi ; +USING: arrays sequences alien alien.c-types alien.data +alien.destructors alien.libraries alien.syntax math +math.functions math.vectors destructors combinators colors fonts +accessors assocs namespaces kernel pango pango.fonts +pango.layouts glib unicode.data images cache init system +math.rectangles fry memoize io.encodings.utf8 classes.struct +cairo cairo.ffi ; IN: pango.cairo << { @@ -136,16 +137,17 @@ SYMBOL: dpi : line-offset>x ( layout n -- x ) #! n is an index into the UTF8 encoding of the text [ drop first-line ] [ swap string>> >utf8-index ] 2bi - 0 0 [ pango_layout_line_index_to_x ] keep - *int pango>float ; + 0 { int } [ pango_layout_line_index_to_x ] [ ] with-out-parameters + pango>float ; : x>line-offset ( layout x -- n ) #! n is an index into the UTF8 encoding of the text [ [ first-line ] dip - float>pango 0 0 - [ pango_layout_line_x_to_index drop ] 2keep - [ *int ] bi@ swap + float>pango + { int int } + [ pango_layout_line_x_to_index drop ] [ ] with-out-parameters + swap ] [ drop string>> ] 2bi utf8-index> + ; : selection-start/end ( selection -- start end ) diff --git a/basis/random/windows/windows.factor b/basis/random/windows/windows.factor index 72b908a32f..f6918eb8f8 100644 --- a/basis/random/windows/windows.factor +++ b/basis/random/windows/windows.factor @@ -16,24 +16,22 @@ M: windows-crypto-context dispose ( tuple -- ) CONSTANT: factor-crypto-container "FactorCryptoContainer" -:: (acquire-crypto-context) ( provider type flags -- handle ret ) - HCRYPTPROV :> handle - handle - factor-crypto-container - provider - type - flags - CryptAcquireContextW handle swap ; +:: (acquire-crypto-context) ( provider type flags -- handle ) + { HCRYPTPROV } [ + factor-crypto-container + provider + type + flags + CryptAcquireContextW + ] [ ] with-out-parameters ; : acquire-crypto-context ( provider type -- handle ) CRYPT_MACHINE_KEYSET (acquire-crypto-context) - 0 = [ + swap 0 = [ GetLastError NTE_BAD_KEYSET = [ drop f ] [ win32-error-string throw ] if - ] [ - *void* - ] if ; + ] when ; : create-crypto-context ( provider type -- handle ) flags{ CRYPT_MACHINE_KEYSET CRYPT_NEWKEYSET } diff --git a/basis/system-info/windows/nt/nt-tests.factor b/basis/system-info/windows/nt/nt-tests.factor new file mode 100644 index 0000000000..4ea274df04 --- /dev/null +++ b/basis/system-info/windows/nt/nt-tests.factor @@ -0,0 +1,5 @@ +USING: math.order strings ; +IN: system-info.windows.nt + +[ t ] [ cpus 0 1024 between? ] unit-test +[ t ] [ username string? ] unit-test diff --git a/basis/system-info/windows/nt/nt.factor b/basis/system-info/windows/nt/nt.factor index 6d293affba..804eb25def 100644 --- a/basis/system-info/windows/nt/nt.factor +++ b/basis/system-info/windows/nt/nt.factor @@ -12,7 +12,7 @@ M: winnt cpus ( -- n ) : memory-status ( -- MEMORYSTATUSEX ) MEMORYSTATUSEX - dup class heap-size >>dwLength + MEMORYSTATUSEX heap-size >>dwLength dup GlobalMemoryStatusEx win32-error=0/f ; M: winnt memory-load ( -- n ) diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor index 0ce6a8cb08..72a9abcef0 100644 --- a/basis/ui/backend/cocoa/cocoa.factor +++ b/basis/ui/backend/cocoa/cocoa.factor @@ -1,14 +1,14 @@ ! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types arrays assocs classes cocoa -cocoa.application cocoa.classes cocoa.messages cocoa.nibs +USING: accessors alien.c-types alien.data arrays assocs classes +cocoa cocoa.application cocoa.classes cocoa.messages cocoa.nibs cocoa.pasteboard cocoa.runtime cocoa.subclassing cocoa.types cocoa.views cocoa.windows combinators command-line core-foundation core-foundation.run-loop core-graphics core-graphics.types destructors fry generalizations io.thread -kernel libc literals locals math math.bitwise math.rectangles memory -namespaces sequences threads ui colors -ui.backend ui.backend.cocoa.views ui.clipboards ui.gadgets +kernel libc literals locals math math.bitwise math.rectangles +memory namespaces sequences threads ui colors ui.backend +ui.backend.cocoa.views ui.clipboards ui.gadgets ui.gadgets.worlds ui.pixel-formats ui.pixel-formats.private ui.private words.symbol ; IN: ui.backend.cocoa @@ -55,8 +55,11 @@ M: cocoa-ui-backend (free-pixel-format) M: cocoa-ui-backend (pixel-format-attribute) [ handle>> ] [ >NSOpenGLPFA ] bi* [ drop f ] - [ first 0 [ swap 0 -> getValues:forAttribute:forVirtualScreen: ] keep *int ] - if-empty ; + [ + first + { int } [ swap 0 -> getValues:forAttribute:forVirtualScreen: ] [ ] + with-out-parameters + ] if-empty ; TUPLE: pasteboard handle ; diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 00fdb907fd..42b565121e 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -59,16 +59,16 @@ PIXEL-FORMAT-ATTRIBUTE-TABLE: WGL_ARB { $ WGL_SUPPORT_OPENGL_ARB 1 } H{ drop f ; : arb-make-pixel-format ( world attributes -- pf ) - [ handle>> hDC>> ] dip >WGL_ARB-int-array f 1 0 0 - [ wglChoosePixelFormatARB win32-error=0/f ] 2keep drop *int ; + [ handle>> hDC>> ] dip >WGL_ARB-int-array f 1 { int int } + [ wglChoosePixelFormatARB win32-error=0/f ] with-out-parameters drop ; : arb-pixel-format-attribute ( pixel-format attribute -- value ) >WGL_ARB [ drop f ] [ [ [ world>> handle>> hDC>> ] [ handle>> ] bi 0 1 ] dip - first 0 + first { int } [ wglGetPixelFormatAttribivARB win32-error=0/f ] - keep *int + with-out-parameters ] if-empty ; CONSTANT: pfd-flag-map H{ diff --git a/basis/ui/backend/x11/x11.factor b/basis/ui/backend/x11/x11.factor index 2f979ee4f1..ef0618dff3 100644 --- a/basis/ui/backend/x11/x11.factor +++ b/basis/ui/backend/x11/x11.factor @@ -60,7 +60,7 @@ M: x11-ui-backend (pixel-format-attribute) [ handle>> ] [ >glx-visual ] bi* [ 2drop f ] [ first - 0 [ glXGetConfig drop ] keep *int + { int } [ glXGetConfig drop ] with-out-parameters ] if-empty ; CONSTANT: modifiers diff --git a/basis/unix/process/process.factor b/basis/unix/process/process.factor index 1e9129af58..a112b9829a 100644 --- a/basis/unix/process/process.factor +++ b/basis/unix/process/process.factor @@ -95,6 +95,3 @@ CONSTANT: WNOWAIT HEX: 1000000 FUNCTION: pid_t wait ( int* status ) ; FUNCTION: pid_t waitpid ( pid_t wpid, int* status, int options ) ; - -: wait-for-pid ( pid -- status ) - 0 [ 0 waitpid drop ] keep *int WEXITSTATUS ; diff --git a/basis/windows/dwmapi/dwmapi.factor b/basis/windows/dwmapi/dwmapi.factor index 60fa5b4d83..b9830a5347 100755 --- a/basis/windows/dwmapi/dwmapi.factor +++ b/basis/windows/dwmapi/dwmapi.factor @@ -34,5 +34,5 @@ CONSTANT: WM_DWMCOMPOSITIONCHANGED HEX: 31E : composition-enabled? ( -- ? ) windows-major 6 >= - [ 0 [ DwmIsCompositionEnabled drop ] keep *int c-bool> ] + [ { bool } [ DwmIsCompositionEnabled drop ] [ ] with-out-parameters ] [ f ] if ; diff --git a/basis/windows/offscreen/offscreen.factor b/basis/windows/offscreen/offscreen.factor index 4b4847f964..c2587698d0 100644 --- a/basis/windows/offscreen/offscreen.factor +++ b/basis/windows/offscreen/offscreen.factor @@ -26,8 +26,8 @@ IN: windows.offscreen : make-bitmap ( dim dc -- hBitmap bits ) [ nip ] [ - swap (bitmap-info) DIB_RGB_COLORS f - [ f 0 CreateDIBSection ] keep *void* + swap (bitmap-info) DIB_RGB_COLORS { void* } + [ f 0 CreateDIBSection ] [ ] with-out-parameters ] 2bi [ [ SelectObject drop ] keep ] dip ; diff --git a/basis/windows/uniscribe/uniscribe.factor b/basis/windows/uniscribe/uniscribe.factor index 2783840df0..ca90450f1f 100644 --- a/basis/windows/uniscribe/uniscribe.factor +++ b/basis/windows/uniscribe/uniscribe.factor @@ -20,14 +20,12 @@ TUPLE: script-string < disposable font string metrics ssa size image ; swap ! icp FALSE ! fTrailing ] if - 0 [ ScriptStringCPtoX ole32-error ] keep *int ; + { int } [ ScriptStringCPtoX ole32-error ] [ ] with-out-parameters ; : x>line-offset ( x script-string -- n trailing ) ssa>> ! ssa swap ! iX - 0 ! pCh - 0 ! piTrailing - [ ScriptStringXtoCP ole32-error ] 2keep [ *int ] bi@ ; + { int int } [ ScriptStringXtoCP ole32-error ] [ ] with-out-parameters ;