steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://github.com/erikcharlebois/factor

release
Slava Pestov 2010-04-14 17:20:12 -07:00
parent bd4e920995 b4a0fd8b17
commit b7164ee4c1
10 changed files with 447 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
extra/elf/a.elf Executable file
View File

Binary file not shown.

180
extra/elf/elf-tests.factor Normal file
View File

@ -0,0 +1,180 @@
! Copyright (C) 2010 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors byte-arrays elf kernel sequences tools.test ;
IN: elf.tests
{
{
""
".interp"
".note.ABI-tag"
".note.gnu.build-id"
".hash"
".gnu.hash"
".dynsym"
".dynstr"
".gnu.version"
".gnu.version_r"
".rela.dyn"
".rela.plt"
".init"
".plt"
".text"
".fini"
".rodata"
".eh_frame_hdr"
".eh_frame"
".ctors"
".dtors"
".jcr"
".dynamic"
".got"
".got.plt"
".data"
".bss"
".comment"
".debug_aranges"
".debug_pubnames"
".debug_info"
".debug_abbrev"
".debug_line"
".debug_str"
".shstrtab"
".symtab"
".strtab"
}
}
[
"resource:extra/elf/a.elf" [
sections [ name>> ] map
] with-mapped-elf
]
unit-test
{
{
".interp"
".note.ABI-tag"
".note.gnu.build-id"
".hash"
".gnu.hash"
".dynsym"
".dynstr"
".gnu.version"
".gnu.version_r"
".rela.dyn"
".rela.plt"
".init"
".plt"
".text"
".fini"
".rodata"
".eh_frame_hdr"
".eh_frame"
}
}
[
"resource:extra/elf/a.elf" [
segments [ program-header>> p_type>> PT_LOAD = ] find nip
sections [ name>> ] map
] with-mapped-elf
]
unit-test
{
{
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
""
"init.c"
"call_gmon_start"
"crtstuff.c"
"__CTOR_LIST__"
"__DTOR_LIST__"
"__JCR_LIST__"
"__do_global_dtors_aux"
"completed.7342"
"dtor_idx.7344"
"frame_dummy"
"crtstuff.c"
"__CTOR_END__"
"__FRAME_END__"
"__JCR_END__"
"__do_global_ctors_aux"
"test.c"
"_GLOBAL_OFFSET_TABLE_"
"__init_array_end"
"__init_array_start"
"_DYNAMIC"
"data_start"
"printf@@GLIBC_2.2.5"
"__libc_csu_fini"
"_start"
"__gmon_start__"
"_Jv_RegisterClasses"
"_fini"
"__libc_start_main@@GLIBC_2.2.5"
"_IO_stdin_used"
"__data_start"
"__dso_handle"
"__DTOR_END__"
"__libc_csu_init"
"__bss_start"
"_end"
"_edata"
"main"
"_init"
}
}
[
"resource:extra/elf/a.elf" [
sections ".symtab" find-section symbols
[ name>> ] map
] with-mapped-elf
]
unit-test
{
B{
85 72 137 229 184 44 6 64 0 72 137 199 184 0 0 0 0 232 222
254 255 255 201 195
}
}
[
"resource:extra/elf/a.elf" [
sections ".symtab" "main" find-section-symbol
symbol-data >byte-array
] with-mapped-elf
]
unit-test

16
extra/elf/elf.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2010 Erik Charlebois. ! Copyright (C) 2010 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.strings alien.syntax arrays USING: accessors alien alien.c-types alien.strings alien.syntax arrays
classes.struct fry io.encodings.ascii kernel locals math classes.struct fry io.encodings.ascii io.mmap kernel locals math
math.intervals sequences specialized-arrays strings typed ; math.intervals sequences specialized-arrays strings typed ;
IN: elf IN: elf
@ -611,4 +611,16 @@ M:: segment sections ( segment -- sections )
symbol sym>> st_size>> <direct-uchar-array> ; symbol sym>> st_size>> <direct-uchar-array> ;
: find-section ( sections name -- section/f ) : find-section ( sections name -- section/f )
'[ name>> _ = ] find nip ; '[ name>> _ = ] find nip ; inline
: find-symbol ( symbols name -- symbol/f )
'[ name>> _ = ] find nip ; inline
: find-section-symbol ( sections section symbol -- symbol/f )
[ find-section ] dip over [
[ symbols ] dip find-symbol ] [ 2drop f ] if ;
: with-mapped-elf ( path quot -- )
'[
address>> <elf> @
] with-mapped-file ; inline

2
extra/elf/nm/nm-docs.factor
View File

@ -16,7 +16,7 @@ HELP: print-symbol
{ $description "Prints the value, section and name of the given symbol." } ; { $description "Prints the value, section and name of the given symbol." } ;
ARTICLE: "elf.nm" "ELF nm" ARTICLE: "elf.nm" "ELF nm"
{ $description "Utility to print the values, sections and names of the symbols in a given ELF file. In an ELF executable or shared library, the symbol values are typically their virtual addresses. In a relocatable ELF object, they are section-relative offsets." } "The " { $vocab-link "elf.nm" } " vocab prints the values, sections and names of the symbols in a given ELF file. In an ELF executable or shared library, the symbol values are typically their virtual addresses. In a relocatable ELF object, they are section-relative offsets."
; ;
ABOUT: "elf.nm" ABOUT: "elf.nm"

51
extra/elf/nm/nm-tests.factor Normal file
View File

@ -0,0 +1,51 @@
! Copyright (C) 2010 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
USING: elf.nm io io.streams.string kernel multiline strings tools.test
literals ;
IN: elf.nm.tests
STRING: validation-output
0000000000000000 absolute init.c
000000000040046c .text call_gmon_start
0000000000000000 absolute crtstuff.c
0000000000600e18 .ctors __CTOR_LIST__
0000000000600e28 .dtors __DTOR_LIST__
0000000000600e38 .jcr __JCR_LIST__
0000000000400490 .text __do_global_dtors_aux
0000000000601020 .bss completed.7342
0000000000601028 .bss dtor_idx.7344
0000000000400500 .text frame_dummy
0000000000000000 absolute crtstuff.c
0000000000600e20 .ctors __CTOR_END__
00000000004006d8 .eh_frame __FRAME_END__
0000000000600e38 .jcr __JCR_END__
00000000004005e0 .text __do_global_ctors_aux
0000000000000000 absolute test.c
0000000000600fe8 .got.plt _GLOBAL_OFFSET_TABLE_
0000000000600e14 .ctors __init_array_end
0000000000600e14 .ctors __init_array_start
0000000000600e40 .dynamic _DYNAMIC
0000000000601010 .data data_start
0000000000000000 undefined printf@@GLIBC_2.2.5
0000000000400540 .text __libc_csu_fini
0000000000400440 .text _start
0000000000000000 undefined __gmon_start__
0000000000000000 undefined _Jv_RegisterClasses
0000000000400618 .fini _fini
0000000000000000 undefined __libc_start_main@@GLIBC_2.2.5
0000000000400628 .rodata _IO_stdin_used
0000000000601010 .data __data_start
0000000000601018 .data __dso_handle
0000000000600e30 .dtors __DTOR_END__
0000000000400550 .text __libc_csu_init
0000000000601020 absolute __bss_start
0000000000601030 absolute _end
0000000000601020 absolute _edata
0000000000400524 .text main
00000000004003f0 .init _init
;
{ $ validation-output }
[ <string-writer> dup [ "resource:extra/elf/a.elf" elf-nm ] with-output-stream >string ]
unit-test

9
extra/elf/nm/nm.factor
View File

@ -4,7 +4,7 @@ USING: accessors combinators elf formatting io.mmap kernel sequences ;
IN: elf.nm IN: elf.nm
: print-symbol ( sections symbol -- ) : print-symbol ( sections symbol -- )
[ sym>> st_value>> "%016d " printf ] [ sym>> st_value>> "%016x " printf ]
[ [
sym>> st_shndx>> sym>> st_shndx>>
{ {
@ -16,10 +16,9 @@ IN: elf.nm
] ]
[ name>> "%s\n" printf ] tri ; [ name>> "%s\n" printf ] tri ;
: nm ( path -- ) : elf-nm ( path -- )
[ [
address>> <elf> sections sections dup ".symtab" find-section
dup ".symtab" find-section
symbols [ name>> empty? not ] filter symbols [ name>> empty? not ] filter
[ print-symbol ] with each [ print-symbol ] with each
] with-mapped-file ; ] with-mapped-elf ;

BIN
extra/macho/a.macho Executable file
View File

Binary file not shown.

26
extra/macho/macho-tests.factor Normal file
View File

@ -0,0 +1,26 @@
! Copyright (C) 2010 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
USING: io io.streams.string kernel literals macho multiline strings
tools.test ;
IN: macho.tests
STRING: validation-output
0000000100000f1c __stub_helper stub helpers
0000000100001040 __program_vars _pvars
0000000100001068 __data _NXArgc
0000000100001070 __data _NXArgv
0000000100001080 __data ___progname
0000000100000000 __mh_execute_header
0000000100001078 __data _environ
0000000100000ef8 __text _main
0000000100000ebc __text start
0000000000000000 ___gxx_personality_v0
0000000000000000 _exit
0000000000000000 _printf
0000000000000000 dyld_stub_binder
;
{ $ validation-output }
[ <string-writer> dup [ "resource:extra/macho/a.macho" macho-nm ] with-output-stream >string ]
unit-test

128
extra/macho/macho.factor
View File

@ -1,8 +1,13 @@
! Copyright (C) 2010 Erik Charlebois. ! Copyright (C) 2010 Erik Charlebois.
! See http:// factorcode.org/license.txt for BSD license. ! See http:// factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.syntax classes.struct kernel literals math ; USING: accessors alien alien.c-types alien.strings alien.syntax
classes classes.struct combinators io.encodings.ascii
io.encodings.string kernel literals make math sequences
specialized-arrays typed fry io.mmap formatting locals ;
FROM: alien.c-types => short ;
IN: macho IN: macho
! FFI data
TYPEDEF: int integer_t TYPEDEF: int integer_t
TYPEDEF: int vm_prot_t TYPEDEF: int vm_prot_t
TYPEDEF: integer_t cpu_type_t TYPEDEF: integer_t cpu_type_t
@ -804,3 +809,124 @@ C-ENUM: reloc_type_ppc
PPC_RELOC_JBSR PPC_RELOC_JBSR
PPC_RELOC_LO14_SECTDIFF PPC_RELOC_LO14_SECTDIFF
PPC_RELOC_LOCAL_SECTDIFF ; PPC_RELOC_LOCAL_SECTDIFF ;
! Low-level interface
SPECIALIZED-ARRAYS: section section_64 nlist nlist_64 ;
UNION: mach_header_32/64 mach_header mach_header_64 ;
UNION: segment_command_32/64 segment_command segment_command_64 ;
UNION: load-command segment_command segment_command_64
dylib_command sub_framework_command
sub_client_command sub_umbrella_command sub_library_command
prebound_dylib_command dylinker_command thread_command
routines_command routines_command_64 symtab_command
dysymtab_command twolevel_hints_command uuid_command ;
UNION: section_32/64 section section_64 ;
UNION: section_32/64-array section-array section_64-array ;
UNION: nlist_32/64 nlist nlist_64 ;
UNION: nlist_32/64-array nlist-array nlist_64-array ;
TYPED: 64-bit? ( macho: mach_header_32/64 -- ? )
magic>> {
{ MH_MAGIC_64 [ t ] }
{ MH_CIGAM_64 [ t ] }
[ drop f ]
} case ;
TYPED: macho-header ( c-ptr -- macho: mach_header_32/64 )
dup mach_header_64 memory>struct 64-bit?
[ mach_header_64 memory>struct ]
[ mach_header memory>struct ] if ;
: cmd>load-command ( cmd -- load-command )
{
{ LC_UUID [ uuid_command ] }
{ LC_SEGMENT [ segment_command ] }
{ LC_SEGMENT_64 [ segment_command_64 ] }
{ LC_SYMTAB [ symtab_command ] }
{ LC_DYSYMTAB [ dysymtab_command ] }
{ LC_THREAD [ thread_command ] }
{ LC_UNIXTHREAD [ thread_command ] }
{ LC_LOAD_DYLIB [ dylib_command ] }
{ LC_ID_DYLIB [ dylib_command ] }
{ LC_PREBOUND_DYLIB [ prebound_dylib_command ] }
{ LC_LOAD_DYLINKER [ dylinker_command ] }
{ LC_ID_DYLINKER [ dylinker_command ] }
{ LC_ROUTINES [ routines_command ] }
{ LC_ROUTINES_64 [ routines_command_64 ] }
{ LC_TWOLEVEL_HINTS [ twolevel_hints_command ] }
{ LC_SUB_FRAMEWORK [ sub_framework_command ] }
{ LC_SUB_UMBRELLA [ sub_umbrella_command ] }
{ LC_SUB_LIBRARY [ sub_library_command ] }
{ LC_SUB_CLIENT [ sub_client_command ] }
{ LC_DYLD_INFO [ dyld_info_command ] }
{ LC_DYLD_INFO_ONLY [ dyld_info_command ] }
} case ;
: read-command ( cmd -- next-cmd )
dup load_command memory>struct
[ cmd>> cmd>load-command memory>struct , ]
[ cmdsize>> swap <displaced-alien> ] 2bi ;
TYPED: load-commands ( macho: mach_header_32/64 -- load-commands )
[
[ class heap-size ]
[ >c-ptr <displaced-alien> ]
[ ncmds>> ] tri iota [
drop read-command
] each drop
] { } make ;
: segment-commands ( load-commands -- segment-commands )
[ segment_command_32/64? ] filter ; inline
: symtab-commands ( load-commands -- segment-commands )
[ symtab_command? ] filter ; inline
: read-array-string ( uchar-array -- string )
ascii decode [ 0 = not ] filter ;
: segment-sections ( segment-command -- sections )
{
[ class heap-size ]
[ >c-ptr <displaced-alien> ]
[ nsects>> ]
[ segment_command_64? ]
} cleave
[ <direct-section_64-array> ]
[ <direct-section-array> ] if ;
: sections-array ( segment-commands -- sections-array )
[
dup first segment_command_64?
[ section_64 ] [ section ] if <struct> ,
segment-commands [ segment-sections [ , ] each ] each
] { } make ;
: symbols ( mach-header symtab-command -- symbols string-table )
[ symoff>> swap >c-ptr <displaced-alien> ]
[ nsyms>> swap 64-bit?
[ <direct-nlist_64-array> ]
[ <direct-nlist-array> ] if ]
[ stroff>> swap >c-ptr <displaced-alien> ] 2tri ;
: symbol-name ( symbol string-table -- name )
[ n_strx>> ] dip <displaced-alien> ascii alien>string ;
: with-mapped-macho ( path quot -- )
'[
address>> macho-header @
] with-mapped-file ; inline
: macho-nm ( path -- )
[| macho |
macho load-commands segment-commands sections-array :> sections
macho load-commands symtab-commands [| symtab |
macho symtab symbols [
[ drop n_value>> "%016x " printf ]
[ drop n_sect>> sections nth sectname>>
read-array-string "%-16s" printf ]
[ symbol-name "%s\n" printf ] 2tri
] curry each
] each
] with-mapped-macho ;

77
extra/opencl/opencl.factor
View File

@ -1,10 +1,9 @@
! Copyright (C) 2010 Erik Charlebois. ! Copyright (C) 2010 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.accessors alien.c-types arrays USING: accessors alien alien.c-types arrays byte-arrays combinators
byte-arrays combinators combinators.smart continuations destructors combinators.smart destructors io.encodings.ascii io.encodings.string
fry io.encodings.ascii io.encodings.string kernel libc locals macros kernel libc locals math namespaces opencl.ffi sequences shuffle
math math.order multiline opencl.ffi prettyprint sequences specialized-arrays variants ;
specialized-arrays typed variants namespaces ;
IN: opencl IN: opencl
SPECIALIZED-ARRAYS: void* char size_t ; SPECIALIZED-ARRAYS: void* char size_t ;
@ -17,15 +16,23 @@ ERROR: cl-error err ;
: cl-not-null ( err -- ) : cl-not-null ( err -- )
dup f = [ cl-error ] [ drop ] if ; inline dup f = [ cl-error ] [ drop ] if ; inline
MACRO: info ( info-quot lift-quot -- quot ) : info-data-size ( handle name info-quot -- size_t )
[ dup ] dip '[ 2dup 0 f 0 <size_t> _ '[ _ call cl-success ] keep [ 0 f 0 <size_t> ] dip [ call cl-success ] 2keep drop *size_t ; inline
*size_t dup <byte-array> _ '[ f _ call cl-success ] keep
_ call ] ;
MACRO: 2info ( info-quot lift-quot -- quot ) : info-data-bytes ( handle name info-quot size -- bytes )
[ dup ] dip '[ 3dup 0 f 0 <size_t> _ '[ _ call cl-success ] keep swap [ dup <byte-array> f ] dip [ call cl-success ] 3keep 2drop ; inline
*size_t dup <byte-array> _ '[ f _ call cl-success ] keep
_ call ] ; : info ( handle name info-quot lift-quot -- value )
[ 3dup info-data-size info-data-bytes ] dip call ; inline
: 2info-data-size ( handle1 handle2 name info-quot -- size_t )
[ 0 f 0 <size_t> ] dip [ call cl-success ] 2keep drop *size_t ; inline
: 2info-data-bytes ( handle1 handle2 name info-quot size -- bytes )
swap [ dup <byte-array> f ] dip [ call cl-success ] 3keep 2drop ; inline
: 2info ( handle1 handle2 name info_quot lift_quot -- value )
[ 4dup 2info-data-size 2info-data-bytes ] dip call ; inline
: info-bool ( handle name quot -- ? ) : info-bool ( handle name quot -- ? )
[ *uint CL_TRUE = ] info ; inline [ *uint CL_TRUE = ] info ; inline
@ -156,6 +163,7 @@ C: <cl-buffer-range> cl-buffer-range
SYMBOLS: cl-current-context cl-current-queue cl-current-device ; SYMBOLS: cl-current-context cl-current-queue cl-current-device ;
<PRIVATE <PRIVATE
: (current-cl-context) ( -- cl-context ) : (current-cl-context) ( -- cl-context )
cl-current-context get ; inline cl-current-context get ; inline
@ -200,7 +208,7 @@ M: cl-filter-linear filter-mode-constant drop CL_FILTER_LINEAR ;
} case ; inline } case ; inline
: platform-info-string ( handle name -- string ) : platform-info-string ( handle name -- string )
[ clGetPlatformInfo ] info-string ; inline [ clGetPlatformInfo ] info-string ;
: platform-info ( id -- profile version name vendor extensions ) : platform-info ( id -- profile version name vendor extensions )
{ {
@ -229,22 +237,22 @@ M: cl-filter-linear filter-mode-constant drop CL_FILTER_LINEAR ;
} case ; inline } case ; inline
: device-info-bool ( handle name -- ? ) : device-info-bool ( handle name -- ? )
[ clGetDeviceInfo ] info-bool ; inline [ clGetDeviceInfo ] info-bool ;
: device-info-ulong ( handle name -- ulong ) : device-info-ulong ( handle name -- ulong )
[ clGetDeviceInfo ] info-ulong ; inline [ clGetDeviceInfo ] info-ulong ;
: device-info-uint ( handle name -- uint ) : device-info-uint ( handle name -- uint )
[ clGetDeviceInfo ] info-uint ; inline [ clGetDeviceInfo ] info-uint ;
: device-info-string ( handle name -- string ) : device-info-string ( handle name -- string )
[ clGetDeviceInfo ] info-string ; inline [ clGetDeviceInfo ] info-string ;
: device-info-size_t ( handle name -- size_t ) : device-info-size_t ( handle name -- size_t )
[ clGetDeviceInfo ] info-size_t ; inline [ clGetDeviceInfo ] info-size_t ;
: device-info-size_t-array ( handle name -- size_t-array ) : device-info-size_t-array ( handle name -- size_t-array )
[ clGetDeviceInfo ] info-size_t-array ; inline [ clGetDeviceInfo ] info-size_t-array ;
: device-info ( device-id -- device ) : device-info ( device-id -- device )
dup { dup {
@ -309,23 +317,23 @@ M: cl-filter-linear filter-mode-constant drop CL_FILTER_LINEAR ;
] 2bi ; inline ] 2bi ; inline
: command-queue-info-ulong ( handle name -- ulong ) : command-queue-info-ulong ( handle name -- ulong )
[ clGetCommandQueueInfo ] info-ulong ; inline [ clGetCommandQueueInfo ] info-ulong ;
: sampler-info-bool ( handle name -- ? ) : sampler-info-bool ( handle name -- ? )
[ clGetSamplerInfo ] info-bool ; inline [ clGetSamplerInfo ] info-bool ;
: sampler-info-uint ( handle name -- uint ) : sampler-info-uint ( handle name -- uint )
[ clGetSamplerInfo ] info-uint ; inline [ clGetSamplerInfo ] info-uint ;
: program-build-info-string ( program-handle device-handle name -- string ) : program-build-info-string ( program-handle device-handle name -- string )
[ clGetProgramBuildInfo ] 2info-string ; inline [ clGetProgramBuildInfo ] 2info-string ;
: program-build-log ( program-handle device-handle -- string ) : program-build-log ( program-handle device-handle -- string )
CL_PROGRAM_BUILD_LOG program-build-info-string ; inline CL_PROGRAM_BUILD_LOG program-build-info-string ;
: strings>char*-array ( strings -- char*-array ) : strings>char*-array ( strings -- char*-array )
[ ascii encode dup length dup malloc [ cl-not-null ] [ ascii encode dup length dup malloc [ cl-not-null ]
keep &free [ -rot memcpy ] keep ] void*-array{ } map-as ; inline keep &free [ -rot memcpy ] keep ] void*-array{ } map-as ;
: (program) ( cl-context sources -- program-handle ) : (program) ( cl-context sources -- program-handle )
[ handle>> ] dip [ [ handle>> ] dip [
@ -347,19 +355,19 @@ M: cl-filter-linear filter-mode-constant drop CL_FILTER_LINEAR ;
} case ; } case ;
: kernel-info-string ( handle name -- string ) : kernel-info-string ( handle name -- string )
[ clGetKernelInfo ] info-string ; inline [ clGetKernelInfo ] info-string ;
: kernel-info-uint ( handle name -- uint ) : kernel-info-uint ( handle name -- uint )
[ clGetKernelInfo ] info-uint ; inline [ clGetKernelInfo ] info-uint ;
: kernel-work-group-info-size_t ( handle1 handle2 name -- size_t ) : kernel-work-group-info-size_t ( handle1 handle2 name -- size_t )
[ clGetKernelWorkGroupInfo ] 2info-size_t ; inline [ clGetKernelWorkGroupInfo ] 2info-size_t ;
: event-info-uint ( handle name -- uint ) : event-info-uint ( handle name -- uint )
[ clGetEventInfo ] info-uint ; inline [ clGetEventInfo ] info-uint ;
: event-info-int ( handle name -- int ) : event-info-int ( handle name -- int )
[ clGetEventInfo ] info-int ; inline [ clGetEventInfo ] info-int ;
: cl_command_type>command-type ( cl_command-type -- command-type ) : cl_command_type>command-type ( cl_command-type -- command-type )
{ {
@ -392,8 +400,7 @@ M: cl-filter-linear filter-mode-constant drop CL_FILTER_LINEAR ;
} case ; inline } case ; inline
: profiling-info-ulong ( handle name -- ulong ) : profiling-info-ulong ( handle name -- ulong )
[ clGetEventProfilingInfo ] info-ulong ; inline [ clGetEventProfilingInfo ] info-ulong ;
: bind-kernel-arg-buffer ( kernel index buffer -- ) : bind-kernel-arg-buffer ( kernel index buffer -- )
[ handle>> ] [ cl_mem heap-size ] [ handle>> <void*> ] tri* [ handle>> ] [ cl_mem heap-size ] [ handle>> <void*> ] tri*
@ -528,10 +535,10 @@ PRIVATE>
cl-kernel new-disposable swap >>handle ; inline cl-kernel new-disposable swap >>handle ; inline
: cl-kernel-name ( kernel -- string ) : cl-kernel-name ( kernel -- string )
handle>> CL_KERNEL_FUNCTION_NAME kernel-info-string ; inline handle>> CL_KERNEL_FUNCTION_NAME kernel-info-string ;
: cl-kernel-arity ( kernel -- arity ) : cl-kernel-arity ( kernel -- arity )
handle>> CL_KERNEL_NUM_ARGS kernel-info-uint ; inline handle>> CL_KERNEL_NUM_ARGS kernel-info-uint ;
: cl-kernel-local-size ( kernel -- size ) : cl-kernel-local-size ( kernel -- size )
(current-cl-device) [ handle>> ] bi@ CL_KERNEL_WORK_GROUP_SIZE kernel-work-group-info-size_t ; inline (current-cl-device) [ handle>> ] bi@ CL_KERNEL_WORK_GROUP_SIZE kernel-work-group-info-size_t ; inline