From 904a2057282cb31af9511173cfa8f1f03d939e6a Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Mon, 12 Apr 2010 21:23:26 -0700 Subject: [PATCH 1/5] Test cases for ELF --- extra/elf/elf-tests.factor | 180 +++++++++++++++++++++++++++++++++++ extra/elf/elf.factor | 16 +++- extra/elf/nm/nm-docs.factor | 2 +- extra/elf/nm/nm-tests.factor | 51 ++++++++++ extra/elf/nm/nm.factor | 5 +- 5 files changed, 248 insertions(+), 6 deletions(-) create mode 100644 extra/elf/elf-tests.factor create mode 100644 extra/elf/nm/nm-tests.factor diff --git a/extra/elf/elf-tests.factor b/extra/elf/elf-tests.factor new file mode 100644 index 0000000000..c0ade1bcd1 --- /dev/null +++ b/extra/elf/elf-tests.factor @@ -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.out" [ + 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.out" [ + 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.out" [ + 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.out" [ + sections ".symtab" "main" find-section-symbol + symbol-data >byte-array + ] with-mapped-elf +] +unit-test diff --git a/extra/elf/elf.factor b/extra/elf/elf.factor index b2fe7db8a4..19bb3bfbf9 100644 --- a/extra/elf/elf.factor +++ b/extra/elf/elf.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2010 Erik Charlebois. ! See http://factorcode.org/license.txt for BSD license. 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 ; IN: elf @@ -611,4 +611,16 @@ M:: segment sections ( segment -- sections ) symbol sym>> st_size>> ; : 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>> @ + ] with-mapped-file ; inline diff --git a/extra/elf/nm/nm-docs.factor b/extra/elf/nm/nm-docs.factor index f07af890c8..a7b7ad426e 100644 --- a/extra/elf/nm/nm-docs.factor +++ b/extra/elf/nm/nm-docs.factor @@ -16,7 +16,7 @@ HELP: print-symbol { $description "Prints the value, section and name of the given symbol." } ; 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" diff --git a/extra/elf/nm/nm-tests.factor b/extra/elf/nm/nm-tests.factor new file mode 100644 index 0000000000..e420976d9e --- /dev/null +++ b/extra/elf/nm/nm-tests.factor @@ -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 +0000000004195436 .text call_gmon_start +0000000000000000 absolute crtstuff.c +0000000006295064 .ctors __CTOR_LIST__ +0000000006295080 .dtors __DTOR_LIST__ +0000000006295096 .jcr __JCR_LIST__ +0000000004195472 .text __do_global_dtors_aux +0000000006295584 .bss completed.7342 +0000000006295592 .bss dtor_idx.7344 +0000000004195584 .text frame_dummy +0000000000000000 absolute crtstuff.c +0000000006295072 .ctors __CTOR_END__ +0000000004196056 .eh_frame __FRAME_END__ +0000000006295096 .jcr __JCR_END__ +0000000004195808 .text __do_global_ctors_aux +0000000000000000 absolute test.c +0000000006295528 .got.plt _GLOBAL_OFFSET_TABLE_ +0000000006295060 .ctors __init_array_end +0000000006295060 .ctors __init_array_start +0000000006295104 .dynamic _DYNAMIC +0000000006295568 .data data_start +0000000000000000 undefined printf@@GLIBC_2.2.5 +0000000004195648 .text __libc_csu_fini +0000000004195392 .text _start +0000000000000000 undefined __gmon_start__ +0000000000000000 undefined _Jv_RegisterClasses +0000000004195864 .fini _fini +0000000000000000 undefined __libc_start_main@@GLIBC_2.2.5 +0000000004195880 .rodata _IO_stdin_used +0000000006295568 .data __data_start +0000000006295576 .data __dso_handle +0000000006295088 .dtors __DTOR_END__ +0000000004195664 .text __libc_csu_init +0000000006295584 absolute __bss_start +0000000006295600 absolute _end +0000000006295584 absolute _edata +0000000004195620 .text main +0000000004195312 .init _init + +; + +{ $ validation-output } +[ dup [ "resource:extra/elf/a.out" nm ] with-output-stream >string ] +unit-test diff --git a/extra/elf/nm/nm.factor b/extra/elf/nm/nm.factor index f9df61249d..87c9abf00b 100644 --- a/extra/elf/nm/nm.factor +++ b/extra/elf/nm/nm.factor @@ -18,8 +18,7 @@ IN: elf.nm : nm ( path -- ) [ - address>> sections - dup ".symtab" find-section + sections dup ".symtab" find-section symbols [ name>> empty? not ] filter [ print-symbol ] with each - ] with-mapped-file ; + ] with-mapped-elf ; From f31929ca5b5aa0076eeb9aa18b791d17bd36229f Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Mon, 12 Apr 2010 21:38:01 -0700 Subject: [PATCH 2/5] a.elf for elf tests --- extra/elf/a.elf | Bin 0 -> 9849 bytes extra/elf/elf-tests.factor | 8 ++++---- extra/elf/nm/nm-tests.factor | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) create mode 100755 extra/elf/a.elf diff --git a/extra/elf/a.elf b/extra/elf/a.elf new file mode 100755 index 0000000000000000000000000000000000000000..0f10a2fb3132b888ea405b8221886079dfa431a5 GIT binary patch literal 9849 zcmeHNU2Ggz6}~gGcGfttH@0b=rX?G?MlRH2J9Sg{FCE8DvM$@CO<e((&56wzpmH zy1TQ%sVdc#+tS6P_<@Irf`|k{edrTNs8B>*LL2%5MMw}qK_+U1+q96XGz6-4`Ockt zc4xEmW1595OZykRan1h5SHi= zpA_{#>Tp@Igs7WidP$jP8dP!yXaHBg?gIU~B{NK~c45JkYe zop{c%ZGo_iQxtZJnOrL4OrV?~RX!b0WyHSN@a{o-hq=SNksMJAb+kbf6f?Rg6|PD( z5PpNpisj}}nWH{dL&_})x%dWfRCi864^Hvp6rF!NxRM9AqC6z`c2!g&gryr1s`=38~|E#FL9RUjs`8lzQJ8F8=ENXz^@x{*4QFj|`t)vg#}m zJ^j+%lAMl!th@+?zb!73@908Z3WlOjEIE4VHR*cMn+`{d=MItJ-0gFa6NS&d(1S+~ zY7djzW9K`Gd+7rsI)7e^-h3t>nP}cNB+!T@En2KQ453on%Tj2eZXc=Kd?t7HmAV^{ z)yUnES5Hk$Oqk8v9+&k$9G${Fi;M4(HIKb$F&#M*D<&e#(c@j;4~9kTc*k=@fUm@gPUJ$Y_(0&CGPG`ek%;wUG?H@y+w5`Uih@5;rS0H*D z@&R=9eV}ci4pCf`w1*E0Z8oHB-MAsRh*3oEb-KO-y>=29XbKHJsc+(U80nF{lPLF& z_Xw~NTql4RLB%~^se7{CZnE~yZ}_VIv~fH@;N^5V0+%CjIRcj>a5(~(BkM!3nICx9A^YB<9;}pVuW}n&H z)mM;Q|8*`e))u*$MJiUWN7n5FHSGd@=z* z$Zd);D&x#XAK=EB-T7nrL~AKIQ>{XsIH(4! zTTF(0W2x+9d@7!E{gM>d#mpa@cH(2g%sV-kPH_%m$=r-EGg&8T4(uN8a^jPUo6HnU zIl{V931Jd970*uzGjS{fdoFcyZpqPPE}zO~su&w(xnw#{3Mw~~c7#c_5~h=!#eD({ z%Cd>L6BlN3%AUx@r<3+n0=mozbKJ@1@^I*q2gXqdoAK$?I2>kS1~*gMcI}MiAw8a* zo=zeNW+FLOn6%@$cxEz5RwO%97=wWdpUO;Rxhy_5mP;OG4#z}E&Le8FXa5Jct*}AE zjo<72x&^Lsu1I@KZ<0gP1JD?x$C33%bPHVN+%7D+%8lnQMtYI)>N~n6iyUPzBDu=V zuOCH`d?_fA6S^gHCw%&Nj%DKchwTgjy@)x5>%XL1KxjUdqW*pCd&p{&2G zTi}FPR=}v_+%{6|*gwyAp94m7EbH^UZ4rpX^R&ykeZ_gA_v4~DlJ$9BoKyPjkL%BJ zOdo_k&AH6;y!({W52KtC^^v#!62$FcTog;z=Xw5FrO)kT|6Cu&ANT1m85R)4U+MEY zgY;=F17}bmI^SbGR&p$+D;(lkI&Op5S!GI-;f=ZD6vpnnbdhKgIeST+KO7ILB z_axS1=f{Oa} zf8f&}t+%A)sPg}a(qqE?$NUm9)PB`np6?2-gg;(>{nI{uI=Q6OsRFm2{x2Zw^-sr^ zl=_vv-=ClVHDsx&Tz_6C^7oFDs{iTvp~U)Juh)Tj{qs5XaZ`dmN(+2Zzxm45g?)PEnk)czh^-o*NQy&&=` zoMrlv2lI-~DF1%D3NDLofHmEl{p;4y|M6y5(OyUY zrZx1pst5n6b@T_7zCTXiUPm8lGEp_T?-eA;XJ`eCw4ViCc2)eSnBQGWM3N<1)*>yb z_Xxd*cH-i3%ku~AA8YxaQ!lQ6tm7Z*YbFD=?boeUl|;Pftv98r5X>26T0Pv zWZuBaWl6VW-g`6fMp@P^FC_B@W?{>yg$Ko4O}s(yeC{=7;1q!8>1w>Oyl=0@H!B8gCXnzg6QQ!Shx%zPbF}wi<5{JkM0)t>yWn8gIjVFzSV5-oR-G zzwf<;hPVRXt82+$S^kb#E#EHqy<3fM5&S-_#;+3mo~*`cHNH9-itRc3ofrr3r?IA8H1PgJBACz+@7Dtlk-!0v&VePHk2LwiQ-k%8T@ zJyd6ECC*NA@nd!}lc)ydshO~cKEHq9uHivJXD{yWBI*|s%kus)qW&kr!K5uueUzy0 zHx&EMqxQk%WGatisljwSpT`l6lK20Q;xk`;x@y~=>VU~-?WuSskxp_ya7^S+E>tOb WEM?m`JK~zj1}Ei_lKlV075NvT7Pr*^ literal 0 HcmV?d00001 diff --git a/extra/elf/elf-tests.factor b/extra/elf/elf-tests.factor index c0ade1bcd1..d68885e6b7 100644 --- a/extra/elf/elf-tests.factor +++ b/extra/elf/elf-tests.factor @@ -45,7 +45,7 @@ IN: elf.tests } } [ - "resource:extra/elf/a.out" [ + "resource:extra/elf/a.elf" [ sections [ name>> ] map ] with-mapped-elf ] @@ -74,7 +74,7 @@ unit-test } } [ - "resource:extra/elf/a.out" [ + "resource:extra/elf/a.elf" [ segments [ program-header>> p_type>> PT_LOAD = ] find nip sections [ name>> ] map ] with-mapped-elf @@ -158,7 +158,7 @@ unit-test } } [ - "resource:extra/elf/a.out" [ + "resource:extra/elf/a.elf" [ sections ".symtab" find-section symbols [ name>> ] map ] with-mapped-elf @@ -172,7 +172,7 @@ unit-test } } [ - "resource:extra/elf/a.out" [ + "resource:extra/elf/a.elf" [ sections ".symtab" "main" find-section-symbol symbol-data >byte-array ] with-mapped-elf diff --git a/extra/elf/nm/nm-tests.factor b/extra/elf/nm/nm-tests.factor index e420976d9e..2ecb499081 100644 --- a/extra/elf/nm/nm-tests.factor +++ b/extra/elf/nm/nm-tests.factor @@ -47,5 +47,5 @@ STRING: validation-output ; { $ validation-output } -[ dup [ "resource:extra/elf/a.out" nm ] with-output-stream >string ] +[ dup [ "resource:extra/elf/a.elf" nm ] with-output-stream >string ] unit-test From 017f772c4844d58d6d19d85f3eba8c49b2b66a53 Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Tue, 13 Apr 2010 17:58:45 -0700 Subject: [PATCH 3/5] Macho version of nm and testcase for it. --- extra/elf/nm/nm-tests.factor | 62 ++++++++-------- extra/elf/nm/nm.factor | 4 +- extra/macho/a.macho | Bin 0 -> 8792 bytes extra/macho/macho-tests.factor | 26 +++++++ extra/macho/macho.factor | 128 ++++++++++++++++++++++++++++++++- 5 files changed, 186 insertions(+), 34 deletions(-) create mode 100755 extra/macho/a.macho create mode 100644 extra/macho/macho-tests.factor diff --git a/extra/elf/nm/nm-tests.factor b/extra/elf/nm/nm-tests.factor index 2ecb499081..9e529ae43d 100644 --- a/extra/elf/nm/nm-tests.factor +++ b/extra/elf/nm/nm-tests.factor @@ -6,46 +6,46 @@ IN: elf.nm.tests STRING: validation-output 0000000000000000 absolute init.c -0000000004195436 .text call_gmon_start +000000000040046c .text call_gmon_start 0000000000000000 absolute crtstuff.c -0000000006295064 .ctors __CTOR_LIST__ -0000000006295080 .dtors __DTOR_LIST__ -0000000006295096 .jcr __JCR_LIST__ -0000000004195472 .text __do_global_dtors_aux -0000000006295584 .bss completed.7342 -0000000006295592 .bss dtor_idx.7344 -0000000004195584 .text frame_dummy +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 -0000000006295072 .ctors __CTOR_END__ -0000000004196056 .eh_frame __FRAME_END__ -0000000006295096 .jcr __JCR_END__ -0000000004195808 .text __do_global_ctors_aux +0000000000600e20 .ctors __CTOR_END__ +00000000004006d8 .eh_frame __FRAME_END__ +0000000000600e38 .jcr __JCR_END__ +00000000004005e0 .text __do_global_ctors_aux 0000000000000000 absolute test.c -0000000006295528 .got.plt _GLOBAL_OFFSET_TABLE_ -0000000006295060 .ctors __init_array_end -0000000006295060 .ctors __init_array_start -0000000006295104 .dynamic _DYNAMIC -0000000006295568 .data data_start +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 -0000000004195648 .text __libc_csu_fini -0000000004195392 .text _start +0000000000400540 .text __libc_csu_fini +0000000000400440 .text _start 0000000000000000 undefined __gmon_start__ 0000000000000000 undefined _Jv_RegisterClasses -0000000004195864 .fini _fini +0000000000400618 .fini _fini 0000000000000000 undefined __libc_start_main@@GLIBC_2.2.5 -0000000004195880 .rodata _IO_stdin_used -0000000006295568 .data __data_start -0000000006295576 .data __dso_handle -0000000006295088 .dtors __DTOR_END__ -0000000004195664 .text __libc_csu_init -0000000006295584 absolute __bss_start -0000000006295600 absolute _end -0000000006295584 absolute _edata -0000000004195620 .text main -0000000004195312 .init _init +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 } -[ dup [ "resource:extra/elf/a.elf" nm ] with-output-stream >string ] +[ dup [ "resource:extra/elf/a.elf" elf-nm ] with-output-stream >string ] unit-test diff --git a/extra/elf/nm/nm.factor b/extra/elf/nm/nm.factor index 87c9abf00b..52e1c66902 100644 --- a/extra/elf/nm/nm.factor +++ b/extra/elf/nm/nm.factor @@ -4,7 +4,7 @@ USING: accessors combinators elf formatting io.mmap kernel sequences ; IN: elf.nm : print-symbol ( sections symbol -- ) - [ sym>> st_value>> "%016d " printf ] + [ sym>> st_value>> "%016x " printf ] [ sym>> st_shndx>> { @@ -16,7 +16,7 @@ IN: elf.nm ] [ name>> "%s\n" printf ] tri ; -: nm ( path -- ) +: elf-nm ( path -- ) [ sections dup ".symtab" find-section symbols [ name>> empty? not ] filter diff --git a/extra/macho/a.macho b/extra/macho/a.macho new file mode 100755 index 0000000000000000000000000000000000000000..bc233d70958e9d5652303936e0c97bd425b1f405 GIT binary patch literal 8792 zcmeHN-)me&6h1dun^co@+Xs!<=vG=9Y)L9YsbFCv4cX9A*Cv%9%D6vnvMV>c%iX)_ zMkoe?Vvs<<7r_@F{S$oXgH`YcKBy0U5ue0Lf(S)KVjqm(ckj&Z-Q706D89@gGiT1s zoHH}u%)Oa=&VFoDh3Q4KJZ3bEZ>$Z1e1dBoaobE!I>uOO#)>>s0 zl&Y^T=c}Ho2aWvGz4nraB74MzWaLN^8PxXL^P?eEa=n`Cqf__%j%s_ywE@Z<)HA#xgmNNou&b<;TT+XD zZrP0*y65+iwwKjxgghW?Z&U9?WJ@V%JF?@YeuE^bAM^}^2O;3v*wwFfsTEEOj^*3!D6zr^HokntxA$eQ3Z!#(*HGSBoU$3)%-$2pNK5{Z47IMzWVv*#%G z(1*}xziz^7Asm;_^<<;&PkQD2WO3Ci>W+_ra~@uDXLjc6&%YdcZ*KC<;qM>j9(;_% zF`q*EzsbDs{%IcJdmWv)CSoTCiON8G?O1<3C>Bngnm9WF9Ljli(*F;@jh-XdAvqm- zbF1~hU7mP8u18%<76FTZMZh9p5wHkY1paLVUYE?q?aca5cQWr@AIxkvk{fr|KXq>Y z*q?EJ%WQo2OCqy=b1<|1tTg^$X?qY8*!W_bSKHsOQg!qEd6apblWkrkzxqt}PV_l~ zJc0bu=Gbl2PR;F|xCOpdLMA&u@9piCc%9n$fhE`Ts;O&L-zz@IW~j+g%~P5m2M_OD z;7Q!ONzdu@C%%VBlzAT?LOvQ=5!oFPhu@o^!?a0q-pF1NrmLj!|b98yjr zah!3?iS!67NnD7GB;W2!(EPCZPG!@6bXtG6oz;B5z8t}PU(~QZ%1zDJG~Z9(wpj!$ z0u}*_fJML}U=gqgSOhEr76FTZMZhBP-y(20t(017HWk9v^=c*Om4j8aaz dup [ "resource:extra/macho/a.macho" macho-nm ] with-output-stream >string ] +unit-test diff --git a/extra/macho/macho.factor b/extra/macho/macho.factor index e3765260bb..b18ea57ce5 100644 --- a/extra/macho/macho.factor +++ b/extra/macho/macho.factor @@ -1,8 +1,13 @@ ! Copyright (C) 2010 Erik Charlebois. ! 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 +! FFI data TYPEDEF: int integer_t TYPEDEF: int vm_prot_t TYPEDEF: integer_t cpu_type_t @@ -804,3 +809,124 @@ C-ENUM: reloc_type_ppc PPC_RELOC_JBSR PPC_RELOC_LO14_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 ] 2bi ; + +TYPED: load-commands ( macho: mach_header_32/64 -- load-commands ) + [ + [ class heap-size ] + [ >c-ptr ] + [ 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 ] + [ nsects>> ] + [ segment_command_64? ] + } cleave + [ ] + [ ] if ; + +: sections-array ( segment-commands -- sections-array ) + [ + dup first segment_command_64? + [ section_64 ] [ section ] if , + segment-commands [ segment-sections [ , ] each ] each + ] { } make ; + +: symbols ( mach-header symtab-command -- symbols string-table ) + [ symoff>> swap >c-ptr ] + [ nsyms>> swap 64-bit? + [ ] + [ ] if ] + [ stroff>> swap >c-ptr ] 2tri ; + +: symbol-name ( symbol string-table -- name ) + [ n_strx>> ] dip 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 ; From bb0c4d94e05663e44af8e1da5abb1822bcb24a60 Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Wed, 14 Apr 2010 00:08:10 -0700 Subject: [PATCH 4/5] Replace info and 2info macros with simple inline words. --- extra/opencl/opencl.factor | 37 ++++++++++++++++++++++--------------- 1 file changed, 22 insertions(+), 15 deletions(-) diff --git a/extra/opencl/opencl.factor b/extra/opencl/opencl.factor index ddcf16a3b2..91a264e85c 100644 --- a/extra/opencl/opencl.factor +++ b/extra/opencl/opencl.factor @@ -1,10 +1,9 @@ ! Copyright (C) 2010 Erik Charlebois. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.accessors alien.c-types arrays -byte-arrays combinators combinators.smart continuations destructors -fry io.encodings.ascii io.encodings.string kernel libc locals macros -math math.order multiline opencl.ffi prettyprint sequences -specialized-arrays typed variants namespaces ; +USING: accessors alien alien.c-types arrays byte-arrays combinators +combinators.smart destructors io.encodings.ascii io.encodings.string +kernel libc locals math namespaces opencl.ffi sequences shuffle +specialized-arrays variants ; IN: opencl SPECIALIZED-ARRAYS: void* char size_t ; @@ -16,17 +15,25 @@ ERROR: cl-error err ; : cl-not-null ( err -- ) dup f = [ cl-error ] [ drop ] if ; inline + +: info-data-size ( handle name info-quot -- size_t ) + [ 0 f 0 ] dip [ call cl-success ] 2keep drop *size_t ; inline -MACRO: info ( info-quot lift-quot -- quot ) - [ dup ] dip '[ 2dup 0 f 0 _ '[ _ call cl-success ] keep - *size_t dup _ '[ f _ call cl-success ] keep - _ call ] ; - -MACRO: 2info ( info-quot lift-quot -- quot ) - [ dup ] dip '[ 3dup 0 f 0 _ '[ _ call cl-success ] keep - *size_t dup _ '[ f _ call cl-success ] keep - _ call ] ; - +: info-data-bytes ( handle name info-quot size -- bytes ) + swap [ dup f ] dip [ call cl-success ] 3keep 2drop ; inline + +: 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 ] dip [ call cl-success ] 2keep drop *size_t ; inline + +: 2info-data-bytes ( handle1 handle2 name info-quot size -- bytes ) + swap [ dup 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 -- ? ) [ *uint CL_TRUE = ] info ; inline From b4a0fd8b17e1c8530067a33a7b24d389e8536bc2 Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Wed, 14 Apr 2010 01:28:21 -0700 Subject: [PATCH 5/5] Remove some inline flags for info words to avoid out of memory on 32-bit archs. --- extra/opencl/opencl.factor | 44 +++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/extra/opencl/opencl.factor b/extra/opencl/opencl.factor index 91a264e85c..17f0143ae1 100644 --- a/extra/opencl/opencl.factor +++ b/extra/opencl/opencl.factor @@ -163,6 +163,7 @@ C: cl-buffer-range SYMBOLS: cl-current-context cl-current-queue cl-current-device ; char*-array ( strings -- char*-array ) [ 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 ) [ handle>> ] dip [ @@ -354,19 +355,19 @@ M: cl-filter-linear filter-mode-constant drop CL_FILTER_LINEAR ; } case ; : kernel-info-string ( handle name -- string ) - [ clGetKernelInfo ] info-string ; inline + [ clGetKernelInfo ] info-string ; : kernel-info-uint ( handle name -- uint ) - [ clGetKernelInfo ] info-uint ; inline + [ clGetKernelInfo ] info-uint ; : 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 ) - [ clGetEventInfo ] info-uint ; inline + [ clGetEventInfo ] info-uint ; : event-info-int ( handle name -- int ) - [ clGetEventInfo ] info-int ; inline + [ clGetEventInfo ] info-int ; : cl_command_type>command-type ( cl_command-type -- command-type ) { @@ -399,8 +400,7 @@ M: cl-filter-linear filter-mode-constant drop CL_FILTER_LINEAR ; } case ; inline : profiling-info-ulong ( handle name -- ulong ) - [ clGetEventProfilingInfo ] info-ulong ; inline - + [ clGetEventProfilingInfo ] info-ulong ; : bind-kernel-arg-buffer ( kernel index buffer -- ) [ handle>> ] [ cl_mem heap-size ] [ handle>> ] tri* @@ -535,10 +535,10 @@ PRIVATE> cl-kernel new-disposable swap >>handle ; inline : 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 ) - handle>> CL_KERNEL_NUM_ARGS kernel-info-uint ; inline + handle>> CL_KERNEL_NUM_ARGS kernel-info-uint ; : cl-kernel-local-size ( kernel -- size ) (current-cl-device) [ handle>> ] bi@ CL_KERNEL_WORK_GROUP_SIZE kernel-work-group-info-size_t ; inline