Merge pull request #9551 from nojb/microbfd · anil.recoil.org/unpac-unpac@0802bac

+7

.depend

··· 3 3 utils/arg_helper.cmx : \ 4 4 utils/arg_helper.cmi 5 5 utils/arg_helper.cmi : 6 + utils/binutils.cmo : \ 7 + utils/binutils.cmi 8 + utils/binutils.cmx : \ 9 + utils/binutils.cmi 10 + utils/binutils.cmi : 6 11 utils/build_path_prefix_map.cmo : \ 7 12 utils/build_path_prefix_map.cmi 8 13 utils/build_path_prefix_map.cmx : \ ··· 1857 1862 bytecomp/dll.cmo : \ 1858 1863 utils/misc.cmi \ 1859 1864 utils/config.cmi \ 1865 + utils/binutils.cmi \ 1860 1866 bytecomp/dll.cmi 1861 1867 bytecomp/dll.cmx : \ 1862 1868 utils/misc.cmx \ 1863 1869 utils/config.cmx \ 1870 + utils/binutils.cmx \ 1864 1871 bytecomp/dll.cmi 1865 1872 bytecomp/dll.cmi : 1866 1873 bytecomp/emitcode.cmo : \

-1

.gitignore

··· 246 246 /tools/ocamlmklib 247 247 /tools/ocamlmklib.opt 248 248 /tools/ocamlmklibconfig.ml 249 - /tools/objinfo_helper 250 249 /tools/ocamlcmt 251 250 /tools/ocamlcmt.opt 252 251 /tools/cmpbyt

+11

Changes

··· 90 90 91 91 ### Code generation and optimizations: 92 92 93 + - #9551: ocamlc no longer loads DLLs at link time to check that 94 + external functions referenced from OCaml code are defined. 95 + Instead, .so/.dll files are parsed directly by pure OCaml code. 96 + (Nicolás Ojeda Bär, review by Daniel Bünzli, Gabriel Scherer, 97 + Anil Madhavapeddy, and Xavier Leroy) 98 + 93 99 - #9620: Limit the number of parameters for an uncurried or untupled 94 100 function. Functions with more parameters than that are left 95 101 partially curried or tupled. ··· 156 162 (David Allsopp, review by Xavier Leroy) 157 163 158 164 ### Tools: 165 + 166 + - #9551: ocamlobjinfo is now able to display information on .cmxs shared 167 + libraries natively; it no longer requires libbfd to do so 168 + (Nicolás Ojeda Bär, review by Daniel Bünzli, Gabriel Scherer, 169 + Anil Madhavapeddy, and Xavier Leroy) 159 170 160 171 - #9606, #9635, #9637: fix performance regression in the debugger 161 172 (behaviors quadratic in the size of the debugged program)

+1 -3

INSTALL.adoc

··· 15 15 16 16 * Under Cygwin, the `gcc-core` and `make` packages are required. `flexdll` is 17 17 necessary for shared library support. `libX11-devel` is necessary for graph 18 - library support and `libintl-devel` is necessary for the `ocamlobjinfo` tool 19 - to be able to process `.cmxs` files. `diffutils` is necessary to run the test 20 - suite. 18 + library support. `diffutils` is necessary to run the test suite. 21 19 22 20 == Configuration 23 21

-3

Makefile.config.in

··· 176 176 177 177 UNIX_OR_WIN32=@unix_or_win32@ 178 178 UNIXLIB=@unixlib@ 179 - BFD_CPPFLAGS=@bfd_cppflags@ 180 - BFD_LDFLAGS=@bfd_ldflags@ 181 - BFD_LDLIBS=@bfd_ldlibs@ 182 179 INSTALL_SOURCE_ARTIFACTS=@install_source_artifacts@ 183 180 184 181 OC_CFLAGS=@oc_cflags@

+47 -16

bytecomp/dll.ml

··· 31 31 (* Current search path for DLLs *) 32 32 let search_path = ref ([] : string list) 33 33 34 + type opened_dll = 35 + | Checking of Binutils.t 36 + | Execution of dll_handle 37 + 38 + let dll_close = function 39 + | Checking _ -> () 40 + | Execution dll -> dll_close dll 41 + 34 42 (* DLLs currently opened *) 35 - let opened_dlls = ref ([] : dll_handle list) 43 + let opened_dlls = ref ([] : opened_dll list) 36 44 37 45 (* File names for those DLLs *) 38 46 let names_of_opened_dlls = ref ([] : string list) ··· 67 75 else fullname 68 76 with Not_found -> name in 69 77 if not (List.mem fullname !names_of_opened_dlls) then begin 70 - try 71 - let dll = dll_open mode fullname in 72 - names_of_opened_dlls := fullname :: !names_of_opened_dlls; 73 - opened_dlls := dll :: !opened_dlls 74 - with Failure msg -> 75 - failwith (fullname ^ ": " ^ msg) 78 + let dll = 79 + match mode with 80 + | For_checking -> 81 + begin match Binutils.read fullname with 82 + | Ok t -> Checking t 83 + | Error err -> 84 + failwith (fullname ^ ": " ^ Binutils.error_to_string err) 85 + end 86 + | For_execution -> 87 + begin match dll_open mode fullname with 88 + | dll -> 89 + Execution dll 90 + | exception Failure msg -> 91 + failwith (fullname ^ ": " ^ msg) 92 + end 93 + in 94 + names_of_opened_dlls := fullname :: !names_of_opened_dlls; 95 + opened_dlls := dll :: !opened_dlls 76 96 end 77 97 78 98 let open_dlls mode names = ··· 85 105 opened_dlls := []; 86 106 names_of_opened_dlls := [] 87 107 88 - (* Find a primitive in the currently opened DLLs. 89 - Raise [Not_found] if not found. *) 108 + (* Find a primitive in the currently opened DLLs. *) 109 + 110 + type primitive_address = 111 + | Prim_loaded of dll_address 112 + | Prim_exists 90 113 91 114 let find_primitive prim_name = 92 115 let rec find seen = function 93 116 [] -> 94 - raise Not_found 95 - | dll :: rem -> 117 + None 118 + | Execution dll as curr :: rem -> 96 119 let addr = dll_sym dll prim_name in 97 - if addr == Obj.magic () then find (dll :: seen) rem else begin 98 - if seen <> [] then opened_dlls := dll :: List.rev_append seen rem; 99 - addr 100 - end in 120 + if addr == Obj.magic () then find (curr :: seen) rem else begin 121 + if seen <> [] then opened_dlls := curr :: List.rev_append seen rem; 122 + Some (Prim_loaded addr) 123 + end 124 + | Checking t as curr :: rem -> 125 + if Binutils.defines_symbol t prim_name then 126 + Some Prim_exists 127 + else 128 + find (curr :: seen) rem 129 + in 101 130 find [] !opened_dlls 102 131 103 132 (* If linking in core (dynlink or toplevel), synchronize the VM ··· 156 185 ld_library_path_contents() @ 157 186 split_dll_path dllpath @ 158 187 ld_conf_contents(); 159 - opened_dlls := Array.to_list (get_current_dlls()); 188 + opened_dlls := 189 + List.map (fun dll -> Execution dll) 190 + (Array.to_list (get_current_dlls())); 160 191 names_of_opened_dlls := []; 161 192 linking_in_core := true 162 193

+7 -2

bytecomp/dll.mli

··· 34 34 (* The abstract type representing C function pointers *) 35 35 type dll_address 36 36 37 + type primitive_address = 38 + | Prim_loaded of dll_address (* Primitive found in a DLL opened 39 + "for execution" *) 40 + | Prim_exists (* Primitive found in a DLL opened "for checking" *) 41 + 37 42 (* Find a primitive in the currently opened DLLs and return its address. 38 - Raise [Not_found] if not found. *) 39 - val find_primitive: string -> dll_address 43 + Return [None] if the primitive is not found. *) 44 + val find_primitive: string -> primitive_address option 40 45 41 46 (* If linking in core (dynlink or toplevel), synchronize the VM 42 47 table of primitive with the linker's table of primitive

+8 -6

bytecomp/symtable.ml

··· 98 98 then 99 99 PrimMap.enter c_prim_table name 100 100 else begin 101 - let symb = 102 - try Dll.find_primitive name 103 - with Not_found -> raise(Error(Unavailable_primitive name)) in 104 - let num = PrimMap.enter c_prim_table name in 105 - Dll.synchronize_primitive num symb; 106 - num 101 + match Dll.find_primitive name with 102 + | None -> raise(Error(Unavailable_primitive name)) 103 + | Some Prim_exists -> 104 + PrimMap.enter c_prim_table name 105 + | Some (Prim_loaded symb) -> 106 + let num = PrimMap.enter c_prim_table name in 107 + Dll.synchronize_primitive num symb; 108 + num 107 109 end 108 110 109 111 let require_primitive name =

+1 -1

compilerlibs/Makefile.compilerlibs

··· 30 30 utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo \ 31 31 utils/consistbl.cmo utils/strongly_connected_components.cmo \ 32 32 utils/targetint.cmo utils/int_replace_polymorphic_compare.cmo \ 33 - utils/domainstate.cmo 33 + utils/domainstate.cmo utils/binutils.cmo 34 34 UTILS_CMI= 35 35 36 36 PARSING=parsing/location.cmo parsing/longident.cmo \

-305

configure

··· 731 731 LD 732 732 DEFAULT_STRING 733 733 WINDOWS_UNICODE_MODE 734 - BFD_LIB_DIR 735 - BFD_INCLUDE_DIR 736 734 LIBUNWIND_LIB_DIR 737 735 LIBUNWIND_INCLUDE_DIR 738 736 DLLIBS ··· 783 781 AS 784 782 endianness 785 783 ASPP 786 - bfd_ldlibs 787 - bfd_ldflags 788 - bfd_cppflags 789 784 x_libraries 790 785 x_includes 791 786 pthread_link ··· 894 889 enable_vmthreads 895 890 enable_systhreads 896 891 with_libunwind 897 - with_bfd 898 892 enable_graph_lib 899 893 enable_str_lib 900 894 enable_unix_lib ··· 937 931 DLLIBS 938 932 LIBUNWIND_INCLUDE_DIR 939 933 LIBUNWIND_LIB_DIR 940 - BFD_INCLUDE_DIR 941 - BFD_LIB_DIR 942 934 WINDOWS_UNICODE_MODE 943 935 DEFAULT_STRING 944 936 CC ··· 1612 1604 --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] 1613 1605 --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) 1614 1606 --without-libunwind disable libunwind support for Spacetime profiling 1615 - --without-bfd disable BFD (Binary File Description) library 1616 - support 1617 1607 --with-target-bindir location of binary programs on target system 1618 1608 --with-afl use the AFL fuzzer 1619 1609 --with-pic[=PKGS] try to use only PIC/non-PIC objects [default=use ··· 1635 1625 location of header files for libunwind 1636 1626 LIBUNWIND_LIB_DIR 1637 1627 location of library files for libunwind 1638 - BFD_INCLUDE_DIR 1639 - location of header files for the BFD library 1640 - BFD_LIB_DIR location of library files for the BFD library 1641 1628 WINDOWS_UNICODE_MODE 1642 1629 how to handle Unicode under Windows: ansi, compatible 1643 1630 DEFAULT_STRING ··· 2906 2893 2907 2894 2908 2895 2909 - 2910 - 2911 - 2912 2896 ## Generated files 2913 2897 2914 2898 ac_config_files="$ac_config_files Makefile.build_config" ··· 3108 3092 # Check whether --with-libunwind was given. 3109 3093 if test "${with_libunwind+set}" = set; then : 3110 3094 withval=$with_libunwind; 3111 - fi 3112 - 3113 - 3114 - 3115 - 3116 - 3117 - 3118 - 3119 - # Check whether --with-bfd was given. 3120 - if test "${with_bfd+set}" = set; then : 3121 - withval=$with_bfd; 3122 - else 3123 - with_bfd=auto 3124 3095 fi 3125 3096 3126 3097 ··· 16404 16375 16405 16376 ;; 16406 16377 esac 16407 - fi 16408 - 16409 - ## BFD (Binary File Description) library 16410 - 16411 - bfd_cppflags="" 16412 - bfd_ldflags="" 16413 - bfd_ldlibs="" 16414 - 16415 - if test x"$with_bfd" != "xno"; then : 16416 - bfd_available=false 16417 - case $host in #( 16418 - x86_64-*-darwin*) : 16419 - if test -z "$BFD_INCLUDE_DIR"; then : 16420 - BFD_INCLUDE_DIR="/opt/local/include" 16421 - fi 16422 - if test -z "$BFD_LIB_DIR"; then : 16423 - BFD_LIB_DIR="/opt/local/lib" 16424 - fi ;; #( 16425 - *-*-openbsd*|*-*-freebsd*) : 16426 - if test -z "$BFD_INCLUDE_DIR"; then : 16427 - BFD_INCLUDE_DIR="/usr/local/include" 16428 - fi 16429 - if test -z "$BFD_LIB_DIR"; then : 16430 - BFD_LIB_DIR="/usr/local/lib" 16431 - fi ;; #( 16432 - *) : 16433 - ;; 16434 - esac 16435 - if test -n "$BFD_INCLUDE_DIR"; then : 16436 - bfd_cppflags="-I$BFD_INCLUDE_DIR" 16437 - fi 16438 - if test -n "$BFD_LIB_DIR"; then : 16439 - bfd_ldflags="-L$BFD_LIB_DIR" 16440 - fi 16441 - SAVED_CPPFLAGS="$CPPFLAGS" 16442 - SAVED_LDFLAGS="$LDFLAGS" 16443 - CPPFLAGS="$CPPFLAGS $bfd_cppflags" 16444 - LDFLAGS="$LDFLAGS $bfd_ldflags" 16445 - ac_fn_c_check_header_mongrel "$LINENO" "bfd.h" "ac_cv_header_bfd_h" "$ac_includes_default" 16446 - if test "x$ac_cv_header_bfd_h" = xyes; then : 16447 - bfd_ldlibs="" 16448 - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bfd_openr in -lbfd" >&5 16449 - $as_echo_n "checking for bfd_openr in -lbfd... " >&6; } 16450 - if ${ac_cv_lib_bfd_bfd_openr+:} false; then : 16451 - $as_echo_n "(cached) " >&6 16452 - else 16453 - ac_check_lib_save_LIBS=$LIBS 16454 - LIBS="-lbfd $LIBS" 16455 - cat confdefs.h - <<_ACEOF >conftest.$ac_ext 16456 - /* end confdefs.h. */ 16457 - 16458 - /* Override any GCC internal prototype to avoid an error. 16459 - Use char because int might match the return type of a GCC 16460 - builtin and then its argument prototype would still apply. */ 16461 - #ifdef __cplusplus 16462 - extern "C" 16463 - #endif 16464 - char bfd_openr (); 16465 - int 16466 - main () 16467 - { 16468 - return bfd_openr (); 16469 - ; 16470 - return 0; 16471 - } 16472 - _ACEOF 16473 - if ac_fn_c_try_link "$LINENO"; then : 16474 - ac_cv_lib_bfd_bfd_openr=yes 16475 - else 16476 - ac_cv_lib_bfd_bfd_openr=no 16477 - fi 16478 - rm -f core conftest.err conftest.$ac_objext \ 16479 - conftest$ac_exeext conftest.$ac_ext 16480 - LIBS=$ac_check_lib_save_LIBS 16481 - fi 16482 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5 16483 - $as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; } 16484 - if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then : 16485 - bfd_ldlibs="-lbfd" 16486 - fi 16487 - 16488 - if test -z "$bfd_ldlibs"; then : 16489 - unset ac_cv_lib_bfd_bfd_openr 16490 - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bfd_openr in -lbfd" >&5 16491 - $as_echo_n "checking for bfd_openr in -lbfd... " >&6; } 16492 - if ${ac_cv_lib_bfd_bfd_openr+:} false; then : 16493 - $as_echo_n "(cached) " >&6 16494 - else 16495 - ac_check_lib_save_LIBS=$LIBS 16496 - LIBS="-lbfd $DLLIBS $LIBS" 16497 - cat confdefs.h - <<_ACEOF >conftest.$ac_ext 16498 - /* end confdefs.h. */ 16499 - 16500 - /* Override any GCC internal prototype to avoid an error. 16501 - Use char because int might match the return type of a GCC 16502 - builtin and then its argument prototype would still apply. */ 16503 - #ifdef __cplusplus 16504 - extern "C" 16505 - #endif 16506 - char bfd_openr (); 16507 - int 16508 - main () 16509 - { 16510 - return bfd_openr (); 16511 - ; 16512 - return 0; 16513 - } 16514 - _ACEOF 16515 - if ac_fn_c_try_link "$LINENO"; then : 16516 - ac_cv_lib_bfd_bfd_openr=yes 16517 - else 16518 - ac_cv_lib_bfd_bfd_openr=no 16519 - fi 16520 - rm -f core conftest.err conftest.$ac_objext \ 16521 - conftest$ac_exeext conftest.$ac_ext 16522 - LIBS=$ac_check_lib_save_LIBS 16523 - fi 16524 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5 16525 - $as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; } 16526 - if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then : 16527 - bfd_ldlibs="-lbfd $DLLIBS" 16528 - fi 16529 - 16530 - fi 16531 - if test -z "$bfd_ldlibs"; then : 16532 - unset ac_cv_lib_bfd_bfd_openr 16533 - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bfd_openr in -lbfd" >&5 16534 - $as_echo_n "checking for bfd_openr in -lbfd... " >&6; } 16535 - if ${ac_cv_lib_bfd_bfd_openr+:} false; then : 16536 - $as_echo_n "(cached) " >&6 16537 - else 16538 - ac_check_lib_save_LIBS=$LIBS 16539 - LIBS="-lbfd $DLLIBS -liberty $LIBS" 16540 - cat confdefs.h - <<_ACEOF >conftest.$ac_ext 16541 - /* end confdefs.h. */ 16542 - 16543 - /* Override any GCC internal prototype to avoid an error. 16544 - Use char because int might match the return type of a GCC 16545 - builtin and then its argument prototype would still apply. */ 16546 - #ifdef __cplusplus 16547 - extern "C" 16548 - #endif 16549 - char bfd_openr (); 16550 - int 16551 - main () 16552 - { 16553 - return bfd_openr (); 16554 - ; 16555 - return 0; 16556 - } 16557 - _ACEOF 16558 - if ac_fn_c_try_link "$LINENO"; then : 16559 - ac_cv_lib_bfd_bfd_openr=yes 16560 - else 16561 - ac_cv_lib_bfd_bfd_openr=no 16562 - fi 16563 - rm -f core conftest.err conftest.$ac_objext \ 16564 - conftest$ac_exeext conftest.$ac_ext 16565 - LIBS=$ac_check_lib_save_LIBS 16566 - fi 16567 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5 16568 - $as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; } 16569 - if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then : 16570 - bfd_ldlibs="-lbfd $DLLIBS -liberty" 16571 - fi 16572 - 16573 - fi 16574 - if test -z "$bfd_ldlibs"; then : 16575 - unset ac_cv_lib_bfd_bfd_openr 16576 - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bfd_openr in -lbfd" >&5 16577 - $as_echo_n "checking for bfd_openr in -lbfd... " >&6; } 16578 - if ${ac_cv_lib_bfd_bfd_openr+:} false; then : 16579 - $as_echo_n "(cached) " >&6 16580 - else 16581 - ac_check_lib_save_LIBS=$LIBS 16582 - LIBS="-lbfd $DLLIBS -liberty -lz $LIBS" 16583 - cat confdefs.h - <<_ACEOF >conftest.$ac_ext 16584 - /* end confdefs.h. */ 16585 - 16586 - /* Override any GCC internal prototype to avoid an error. 16587 - Use char because int might match the return type of a GCC 16588 - builtin and then its argument prototype would still apply. */ 16589 - #ifdef __cplusplus 16590 - extern "C" 16591 - #endif 16592 - char bfd_openr (); 16593 - int 16594 - main () 16595 - { 16596 - return bfd_openr (); 16597 - ; 16598 - return 0; 16599 - } 16600 - _ACEOF 16601 - if ac_fn_c_try_link "$LINENO"; then : 16602 - ac_cv_lib_bfd_bfd_openr=yes 16603 - else 16604 - ac_cv_lib_bfd_bfd_openr=no 16605 - fi 16606 - rm -f core conftest.err conftest.$ac_objext \ 16607 - conftest$ac_exeext conftest.$ac_ext 16608 - LIBS=$ac_check_lib_save_LIBS 16609 - fi 16610 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5 16611 - $as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; } 16612 - if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then : 16613 - bfd_ldlibs="-lbfd $DLLIBS -liberty -lz" 16614 - fi 16615 - 16616 - fi 16617 - if test -z "$bfd_ldlibs"; then : 16618 - unset ac_cv_lib_bfd_bfd_openr 16619 - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bfd_openr in -lbfd" >&5 16620 - $as_echo_n "checking for bfd_openr in -lbfd... " >&6; } 16621 - if ${ac_cv_lib_bfd_bfd_openr+:} false; then : 16622 - $as_echo_n "(cached) " >&6 16623 - else 16624 - ac_check_lib_save_LIBS=$LIBS 16625 - LIBS="-lbfd $DLLIBS -liberty -lz -lintl $LIBS" 16626 - cat confdefs.h - <<_ACEOF >conftest.$ac_ext 16627 - /* end confdefs.h. */ 16628 - 16629 - /* Override any GCC internal prototype to avoid an error. 16630 - Use char because int might match the return type of a GCC 16631 - builtin and then its argument prototype would still apply. */ 16632 - #ifdef __cplusplus 16633 - extern "C" 16634 - #endif 16635 - char bfd_openr (); 16636 - int 16637 - main () 16638 - { 16639 - return bfd_openr (); 16640 - ; 16641 - return 0; 16642 - } 16643 - _ACEOF 16644 - if ac_fn_c_try_link "$LINENO"; then : 16645 - ac_cv_lib_bfd_bfd_openr=yes 16646 - else 16647 - ac_cv_lib_bfd_bfd_openr=no 16648 - fi 16649 - rm -f core conftest.err conftest.$ac_objext \ 16650 - conftest$ac_exeext conftest.$ac_ext 16651 - LIBS=$ac_check_lib_save_LIBS 16652 - fi 16653 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5 16654 - $as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; } 16655 - if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then : 16656 - bfd_ldlibs="-lbfd $DLLIBS -liberty -lz -lintl" 16657 - fi 16658 - 16659 - fi 16660 - if test -n "$bfd_ldlibs"; then : 16661 - bfd_available=true 16662 - $as_echo "#define HAS_LIBBFD 1" >>confdefs.h 16663 - 16664 - fi 16665 - fi 16666 - 16667 - 16668 - if ! $bfd_available; then : 16669 - if test x"$with_bfd" = "xyes"; then : 16670 - as_fn_error $? "BFD library support requested but not available" "$LINENO" 5 16671 - else 16672 - bfd_cppflags="" 16673 - bfd_ldflags="" 16674 - { $as_echo "$as_me:${as_lineno-$LINENO}: BFD library not found, 'ocamlobjinfo' will be unable to display info on .cmxs files." >&5 16675 - $as_echo "$as_me: BFD library not found, 'ocamlobjinfo' will be unable to display info on .cmxs files." >&6;} 16676 - fi 16677 - fi 16678 - LDFLAGS="$SAVED_LDFLAGS" 16679 - CPP_FLAGS="$SAVED_CPPFLAGS" 16680 - else 16681 - { $as_echo "$as_me:${as_lineno-$LINENO}: Support for the BFD (Binary File Description) library disabled, 'ocamlobjinfo' will be unable to display info on .cmxs files." >&5 16682 - $as_echo "$as_me: Support for the BFD (Binary File Description) library disabled, 'ocamlobjinfo' will be unable to display info on .cmxs files." >&6;} 16683 16378 fi 16684 16379 16685 16380 ## Does the assembler support debug prefix map and CFI directives

-81

configure.ac

··· 132 132 AC_SUBST([pthread_link]) 133 133 AC_SUBST([x_includes]) 134 134 AC_SUBST([x_libraries]) 135 - AC_SUBST([bfd_cppflags]) 136 - AC_SUBST([bfd_ldflags]) 137 - AC_SUBST([bfd_ldlibs]) 138 135 AC_SUBST([ASPP]) 139 136 AC_SUBST([endianness]) 140 137 AC_SUBST([AS]) ··· 249 246 250 247 AC_ARG_VAR([LIBUNWIND_LIB_DIR], 251 248 [location of library files for libunwind]) 252 - 253 - AC_ARG_WITH([bfd], 254 - [AS_HELP_STRING([--without-bfd], 255 - [disable BFD (Binary File Description) library support])], 256 - [], 257 - [with_bfd=auto]) 258 - 259 - AC_ARG_VAR([BFD_INCLUDE_DIR], 260 - [location of header files for the BFD library]) 261 - 262 - AC_ARG_VAR([BFD_LIB_DIR], 263 - [location of library files for the BFD library]) 264 249 265 250 AC_ARG_ENABLE([graph-lib], [], 266 251 [AC_MSG_ERROR([The graphics library is no longer distributed with OCaml \ ··· 1653 1638 [AC_MSG_ERROR([the POSIX thread library is not available])], 1654 1639 [systhread_support=false 1655 1640 AC_MSG_NOTICE([the POSIX threads library is not supported])])])])]) 1656 - 1657 - ## BFD (Binary File Description) library 1658 - 1659 - bfd_cppflags="" 1660 - bfd_ldflags="" 1661 - bfd_ldlibs="" 1662 - 1663 - AS_IF([test x"$with_bfd" != "xno"], 1664 - [bfd_available=false 1665 - AS_CASE([$host], 1666 - [x86_64-*-darwin*], 1667 - [AS_IF([test -z "$BFD_INCLUDE_DIR"], 1668 - [BFD_INCLUDE_DIR="/opt/local/include"]) 1669 - AS_IF([test -z "$BFD_LIB_DIR"], 1670 - [BFD_LIB_DIR="/opt/local/lib"])], 1671 - [*-*-openbsd*|*-*-freebsd*], 1672 - [AS_IF([test -z "$BFD_INCLUDE_DIR"], 1673 - [BFD_INCLUDE_DIR="/usr/local/include"]) 1674 - AS_IF([test -z "$BFD_LIB_DIR"], 1675 - [BFD_LIB_DIR="/usr/local/lib"])]) 1676 - AS_IF([test -n "$BFD_INCLUDE_DIR"], 1677 - [bfd_cppflags="-I$BFD_INCLUDE_DIR"]) 1678 - AS_IF([test -n "$BFD_LIB_DIR"], 1679 - [bfd_ldflags="-L$BFD_LIB_DIR"]) 1680 - SAVED_CPPFLAGS="$CPPFLAGS" 1681 - SAVED_LDFLAGS="$LDFLAGS" 1682 - CPPFLAGS="$CPPFLAGS $bfd_cppflags" 1683 - LDFLAGS="$LDFLAGS $bfd_ldflags" 1684 - AC_CHECK_HEADER([bfd.h], 1685 - [bfd_ldlibs="" 1686 - AC_CHECK_LIB([bfd], [bfd_openr], [bfd_ldlibs="-lbfd"]) 1687 - AS_IF([test -z "$bfd_ldlibs"], 1688 - [unset ac_cv_lib_bfd_bfd_openr 1689 - AC_CHECK_LIB([bfd], [bfd_openr], 1690 - [bfd_ldlibs="-lbfd $DLLIBS"], [], [$DLLIBS])]) 1691 - AS_IF([test -z "$bfd_ldlibs"], 1692 - [unset ac_cv_lib_bfd_bfd_openr 1693 - AC_CHECK_LIB([bfd], [bfd_openr], 1694 - [bfd_ldlibs="-lbfd $DLLIBS -liberty"], [], [$DLLIBS -liberty])]) 1695 - AS_IF([test -z "$bfd_ldlibs"], 1696 - [unset ac_cv_lib_bfd_bfd_openr 1697 - AC_CHECK_LIB([bfd], [bfd_openr], 1698 - [bfd_ldlibs="-lbfd $DLLIBS -liberty -lz"], [], [$DLLIBS -liberty -lz])]) 1699 - AS_IF([test -z "$bfd_ldlibs"], 1700 - [unset ac_cv_lib_bfd_bfd_openr 1701 - AC_CHECK_LIB([bfd], [bfd_openr], 1702 - [bfd_ldlibs="-lbfd $DLLIBS -liberty -lz -lintl"], [], 1703 - [$DLLIBS -liberty -lz -lintl])]) 1704 - AS_IF([test -n "$bfd_ldlibs"], 1705 - [bfd_available=true 1706 - AC_DEFINE([HAS_LIBBFD])])]) 1707 - AS_IF([! $bfd_available], 1708 - [AS_IF([test x"$with_bfd" = "xyes"], 1709 - [AC_MSG_ERROR([BFD library support requested but not available])], 1710 - [bfd_cppflags="" 1711 - bfd_ldflags="" 1712 - AC_MSG_NOTICE(m4_normalize([ 1713 - BFD library not found, 'ocamlobjinfo' will be unable to display 1714 - info on .cmxs files. 1715 - ]))])]) 1716 - LDFLAGS="$SAVED_LDFLAGS" 1717 - CPP_FLAGS="$SAVED_CPPFLAGS"], 1718 - [AC_MSG_NOTICE(m4_normalize([ 1719 - Support for the BFD (Binary File Description) library disabled, 1720 - 'ocamlobjinfo' will be unable to display info on .cmxs files. 1721 - ]))]) 1722 1641 1723 1642 ## Does the assembler support debug prefix map and CFI directives 1724 1643 as_has_debug_prefix_map=false

+1

otherlibs/dynlink/Makefile

··· 70 70 71 71 # .ml files from compilerlibs that have corresponding .mli files. 72 72 COMPILERLIBS_SOURCES=\ 73 + utils/binutils.ml \ 73 74 utils/config.ml \ 74 75 utils/build_path_prefix_map.ml \ 75 76 utils/misc.ml \

-2

runtime/caml/s.h.in

··· 256 256 257 257 #undef HAS_SIGWAIT 258 258 259 - #undef HAS_LIBBFD 260 - 261 259 #undef HAS_HUGE_PAGES 262 260 263 261 #undef HUGE_PAGE_SIZE

-7

testsuite/tests/tool-ocamlobjinfo/has-lib-bfd.sh

··· 1 - #!/bin/sh 2 - 3 - if grep -q "#define HAS_LIBBFD" ${ocamlsrcdir}/runtime/caml/s.h; then 4 - exit ${TEST_PASS}; 5 - fi 6 - echo libbfd not available > ${ocamltest_response} 7 - exit ${TEST_SKIP}

+5 -7

testsuite/tests/tool-ocamlobjinfo/question.ml

··· 1 1 (* TEST 2 - script = "sh ${test_source_directory}/has-lib-bfd.sh" 3 2 * shared-libraries 4 - ** script 5 - *** setup-ocamlopt.byte-build-env 6 - **** ocamlopt.byte 3 + ** setup-ocamlopt.byte-build-env 4 + *** ocamlopt.byte 7 5 flags = "-shared" 8 6 all_modules = "question.ml" 9 7 program = "question.cmxs" 10 - ***** check-ocamlopt.byte-output 11 - ****** ocamlobjinfo 12 - ******* check-program-output 8 + **** check-ocamlopt.byte-output 9 + ***** ocamlobjinfo 10 + ****** check-program-output 13 11 *) 14 12 15 13 let answer = 42

+4 -4

tools/.depend

··· 92 92 ../middle_end/linkage_name.cmi \ 93 93 ../typing/ident.cmi \ 94 94 ../middle_end/flambda/export_info.cmi \ 95 - ../utils/config.cmi \ 96 95 ../middle_end/compilation_unit.cmi \ 97 96 ../file_formats/cmxs_format.cmi \ 98 97 ../file_formats/cmx_format.cmi \ 99 98 ../file_formats/cmt_format.cmi \ 100 99 ../file_formats/cmo_format.cmi \ 101 100 ../file_formats/cmi_format.cmi \ 102 - ../bytecomp/bytesections.cmi 101 + ../bytecomp/bytesections.cmi \ 102 + ../utils/binutils.cmi 103 103 objinfo.cmx : \ 104 104 ../bytecomp/symtable.cmx \ 105 105 ../middle_end/symbol.cmx \ ··· 108 108 ../middle_end/linkage_name.cmx \ 109 109 ../typing/ident.cmx \ 110 110 ../middle_end/flambda/export_info.cmx \ 111 - ../utils/config.cmx \ 112 111 ../middle_end/compilation_unit.cmx \ 113 112 ../file_formats/cmxs_format.cmi \ 114 113 ../file_formats/cmx_format.cmi \ 115 114 ../file_formats/cmt_format.cmx \ 116 115 ../file_formats/cmo_format.cmi \ 117 116 ../file_formats/cmi_format.cmx \ 118 - ../bytecomp/bytesections.cmx 117 + ../bytecomp/bytesections.cmx \ 118 + ../utils/binutils.cmx 119 119 ocamlcmt.cmo : \ 120 120 ../typing/untypeast.cmi \ 121 121 ../typing/stypes.cmi \

+1 -17

tools/Makefile

··· 267 267 DEF_SYMBOL_PREFIX = '-Dsymbol_prefix="_"' 268 268 endif 269 269 270 - objinfo_helper$(EXE): objinfo_helper.$(O) 271 - $(CC) $(BFD_LDFLAGS) $(OC_CFLAGS) $(OUTPUTEXE)$@ $< $(BFD_LDLIBS) 272 - 273 - objinfo_helper.$(O): $(ROOTDIR)/runtime/caml/s.h 274 - 275 - objinfo_helper.$(O): \ 276 - OC_CPPFLAGS += -I$(ROOTDIR)/runtime $(DEF_SYMBOL_PREFIX) $(BFD_CPPFLAGS) 277 - 278 270 OBJINFO=$(ROOTDIR)/compilerlibs/ocamlcommon.cma \ 279 271 $(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \ 280 272 $(ROOTDIR)/compilerlibs/ocamlmiddleend.cma \ 281 273 objinfo.cmo 282 274 283 - $(call byte_and_opt,ocamlobjinfo,$(OBJINFO),objinfo_helper$(EXE)) 284 - 285 - install:: 286 - $(INSTALL_PROG) objinfo_helper$(EXE) "$(INSTALL_LIBDIR)" 275 + $(call byte_and_opt,ocamlobjinfo,$(OBJINFO),) 287 276 288 277 primreq=$(ROOTDIR)/compilerlibs/ocamlcommon.cma \ 289 278 $(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \ ··· 304 293 clean:: 305 294 rm -f -- lintapidiff.opt lintapidiff.opt.exe 306 295 rm -f lintapidiff.cm? lintapidiff.o lintapidiff.obj 307 - 308 - 309 - clean:: 310 - rm -f "objinfo_helper" "objinfo_helper.manifest" 311 - rm -f "objinfo_helper.exe" "objinfo_helper.exe.manifest" 312 296 313 297 # Eventlog metadata file 314 298

-5

tools/ci/inria/main

··· 112 112 ocaml-ppc-64) 113 113 CCOMP="CC='gcc -m64'" 114 114 OCAML_CONFIGURE_OPTIONS=;; 115 - ocaml-freebsd-64|ocaml-openbsd-64) 116 - OCAML_CONFIGURE_OPTIONS='--with-bfd' 117 115 esac 118 116 119 117 ######################################################################### ··· 137 135 case "${OCAML_ARCH}" in 138 136 bsd) 139 137 make=gmake 140 - ;; 141 - macos) 142 - confoptions="$confoptions --with-bfd " 143 138 ;; 144 139 linux) 145 140 check_make_alldepend=true

+5 -20

tools/objinfo.ml

··· 244 244 toc 245 245 246 246 let find_dyn_offset filename = 247 - let helper_name = "objinfo_helper" ^ Config.ext_exe in 248 - let helper = Filename.concat Config.standard_library helper_name in 249 - let tempfile = Filename.temp_file "objinfo" ".out" in 250 - match 251 - Fun.protect 252 - ~finally:(fun () -> remove_file tempfile) 253 - (fun () -> 254 - let rc = 255 - Sys.command 256 - (Filename.quote_command helper ~stdout:tempfile [filename]) 257 - in 258 - if rc <> 0 then failwith "cannot read"; 259 - let tc = Scanf.Scanning.from_file tempfile in 260 - Fun.protect 261 - ~finally:(fun () -> Scanf.Scanning.close_in tc) 262 - (fun () -> 263 - Scanf.bscanf tc "%Ld" (fun x -> x))) 264 - with 265 - | offset -> Some offset 266 - | exception (Failure _ | Sys_error _) -> None 247 + match Binutils.read filename with 248 + | Ok t -> 249 + Binutils.symbol_offset t "caml_plugin_header" 250 + | Error _ -> 251 + None 267 252 268 253 let exit_err msg = print_endline msg; exit 2 269 254 let exit_errf fmt = Printf.ksprintf exit_err fmt

-148

tools/objinfo_helper.c

··· 1 - /**************************************************************************/ 2 - /* */ 3 - /* OCaml */ 4 - /* */ 5 - /* Mehdi Dogguy, PPS laboratory, University Paris Diderot */ 6 - /* */ 7 - /* Copyright 2010 Mehdi Dogguy */ 8 - /* */ 9 - /* All rights reserved. This file is distributed under the terms of */ 10 - /* the GNU Lesser General Public License version 2.1, with the */ 11 - /* special exception on linking described in the file LICENSE. */ 12 - /* */ 13 - /**************************************************************************/ 14 - 15 - #include "caml/s.h" 16 - #include <stdio.h> 17 - 18 - #ifdef HAS_LIBBFD 19 - #include <stdlib.h> 20 - #include <string.h> 21 - #include <stdarg.h> 22 - 23 - // PACKAGE: protect against binutils change 24 - // https://sourceware.org/bugzilla/show_bug.cgi?id=14243 25 - #define PACKAGE "ocamlobjinfo" 26 - #include <bfd.h> 27 - #undef PACKAGE 28 - 29 - #define plugin_header_sym (symbol_prefix "caml_plugin_header") 30 - 31 - /* We need to refer to a few functions of the BFD library that are */ 32 - /* actually defined as macros. We thus define equivalent */ 33 - /* functions below */ 34 - 35 - long get_static_symtab_upper_bound(bfd *fd) 36 - { 37 - return bfd_get_symtab_upper_bound(fd); 38 - } 39 - 40 - long get_dynamic_symtab_upper_bound(bfd *fd) 41 - { 42 - return bfd_get_dynamic_symtab_upper_bound(fd); 43 - } 44 - 45 - long canonicalize_static_symtab(bfd * fd, asymbol **symbolTable) 46 - { 47 - return bfd_canonicalize_symtab(fd, symbolTable); 48 - } 49 - 50 - long canonicalize_dynamic_symtab(bfd * fd, asymbol **symbolTable) 51 - { 52 - return bfd_canonicalize_dynamic_symtab(fd, symbolTable); 53 - } 54 - 55 - typedef struct { 56 - long (*get_upper_bound)(bfd *); 57 - long (*canonicalize)(bfd *, asymbol **); 58 - } symTable_ops; 59 - 60 - symTable_ops staticSymTable_ops = { 61 - &get_static_symtab_upper_bound, 62 - &canonicalize_static_symtab 63 - }; 64 - 65 - symTable_ops dynamicSymTable_ops = { 66 - &get_dynamic_symtab_upper_bound, 67 - &canonicalize_dynamic_symtab 68 - }; 69 - 70 - /* Print an error message and exit */ 71 - static void error(bfd *fd, char *msg, ...) 72 - { 73 - va_list ap; 74 - va_start(ap, msg); 75 - vfprintf (stderr, msg, ap); 76 - va_end(ap); 77 - fprintf(stderr, "\n"); 78 - if (fd!=NULL) bfd_close(fd); 79 - exit(2); 80 - } 81 - 82 - /* Look for plugin_header_sym in the specified symbol table */ 83 - /* Return its address, -1 if not found */ 84 - long lookup(bfd* fd, symTable_ops *ops) 85 - { 86 - long st_size; 87 - asymbol ** symbol_table; 88 - long sym_count, i; 89 - 90 - st_size = ops->get_upper_bound (fd); 91 - if (st_size <= 0) return -1; 92 - 93 - symbol_table = malloc(st_size); 94 - if (! symbol_table) 95 - error(fd, "Error: out of memory"); 96 - 97 - sym_count = ops->canonicalize (fd, symbol_table); 98 - 99 - for (i = 0; i < sym_count; i++) { 100 - if (strcmp(symbol_table[i]->name, plugin_header_sym) == 0) 101 - return symbol_table[i]->value; 102 - } 103 - return -1; 104 - } 105 - 106 - int main(int argc, char ** argv) 107 - { 108 - bfd *fd; 109 - asection *sec; 110 - file_ptr offset; 111 - long value; 112 - 113 - if (argc != 2) 114 - error(NULL, "Usage: %s <dynamic library>", argv[0]); 115 - 116 - fd = bfd_openr(argv[1], "default"); 117 - if (!fd) 118 - error(NULL, "Error opening file %s", argv[1]); 119 - if (! bfd_check_format (fd, bfd_object)) 120 - error(fd, "Error: wrong format"); 121 - 122 - sec = bfd_get_section_by_name(fd, ".data"); 123 - if (! sec) 124 - error(fd, "Error: section .data not found"); 125 - 126 - offset = sec->filepos; 127 - 128 - value = lookup(fd, &dynamicSymTable_ops); 129 - 130 - if (value == -1) 131 - value = lookup(fd, &staticSymTable_ops); 132 - bfd_close(fd); 133 - 134 - if (value == -1) 135 - error(NULL, "Error: missing symbol %s", plugin_header_sym); 136 - 137 - printf("%ld\n", (long) offset + value); 138 - } 139 - 140 - #else 141 - 142 - int main(int argc, char ** argv) 143 - { 144 - fprintf(stderr,"BFD library unavailable, cannot print info on .cmxs files\n"); 145 - return 2; 146 - } 147 - 148 - #endif

+689

utils/binutils.ml

··· 1 + (**************************************************************************) 2 + (* *) 3 + (* OCaml *) 4 + (* *) 5 + (* Nicolas Ojeda Bar, LexiFi *) 6 + (* *) 7 + (* Copyright 2020 Institut National de Recherche en Informatique et *) 8 + (* en Automatique. *) 9 + (* *) 10 + (* All rights reserved. This file is distributed under the terms of *) 11 + (* the GNU Lesser General Public License version 2.1, with the *) 12 + (* special exception on linking described in the file LICENSE. *) 13 + (* *) 14 + (**************************************************************************) 15 + 16 + let char_to_hex c = 17 + Printf.sprintf "0x%02x" (Char.code c) 18 + 19 + let int_to_hex n = 20 + Printf.sprintf "0x%x" n 21 + 22 + type error = 23 + | Truncated_file 24 + | Unrecognized of string 25 + | Unsupported of string * int64 26 + | Out_of_range of string 27 + 28 + let error_to_string = function 29 + | Truncated_file -> 30 + "Truncated file" 31 + | Unrecognized magic -> 32 + Printf.sprintf "Unrecognized magic: %s" 33 + (String.concat " " 34 + (List.init (String.length magic) 35 + (fun i -> char_to_hex magic.[i]))) 36 + | Unsupported (s, n) -> 37 + Printf.sprintf "Unsupported: %s: 0x%Lx" s n 38 + | Out_of_range s -> 39 + Printf.sprintf "Out of range constant: %s" s 40 + 41 + exception Error of error 42 + 43 + let name_at ?max_len buf start = 44 + if start < 0 || start > Bytes.length buf then 45 + raise (Error (Out_of_range (int_to_hex start))); 46 + let max_pos = 47 + match max_len with 48 + | None -> Bytes.length buf 49 + | Some n -> min (Bytes.length buf) (start + n) 50 + in 51 + let rec loop pos = 52 + if pos >= max_pos || Bytes.get buf pos = '\000' 53 + then 54 + Bytes.sub_string buf start (pos - start) 55 + else 56 + loop (succ pos) 57 + in 58 + loop start 59 + 60 + let array_find_map f a = 61 + let rec loop i = 62 + if i >= Array.length a then None 63 + else begin 64 + match f a.(i) with 65 + | None -> loop (succ i) 66 + | Some _ as r -> r 67 + end 68 + in 69 + loop 0 70 + 71 + let array_find f a = 72 + array_find_map (fun x -> if f x then Some x else None) a 73 + 74 + let really_input_bytes ic len = 75 + let buf = Bytes.create len in 76 + really_input ic buf 0 len; 77 + buf 78 + 79 + let uint64_of_uint32 n = 80 + Int64.(logand (of_int32 n) 0xffffffffL) 81 + 82 + type endianness = 83 + | LE 84 + | BE 85 + 86 + type bitness = 87 + | B32 88 + | B64 89 + 90 + type decoder = 91 + { 92 + ic: in_channel; 93 + endianness: endianness; 94 + bitness: bitness; 95 + } 96 + 97 + let word_size = function 98 + | {bitness = B64; _} -> 8 99 + | {bitness = B32; _} -> 4 100 + 101 + let get_uint16 {endianness; _} buf idx = 102 + match endianness with 103 + | LE -> Bytes.get_uint16_le buf idx 104 + | BE -> Bytes.get_uint16_be buf idx 105 + 106 + let get_uint32 {endianness; _} buf idx = 107 + match endianness with 108 + | LE -> Bytes.get_int32_le buf idx 109 + | BE -> Bytes.get_int32_be buf idx 110 + 111 + let get_uint s d buf idx = 112 + let n = get_uint32 d buf idx in 113 + match Int32.unsigned_to_int n with 114 + | None -> raise (Error (Unsupported (s, Int64.of_int32 n))) 115 + | Some n -> n 116 + 117 + let get_uint64 {endianness; _} buf idx = 118 + match endianness with 119 + | LE -> Bytes.get_int64_le buf idx 120 + | BE -> Bytes.get_int64_be buf idx 121 + 122 + let get_word d buf idx = 123 + match d.bitness with 124 + | B64 -> get_uint64 d buf idx 125 + | B32 -> uint64_of_uint32 (get_uint32 d buf idx) 126 + 127 + let uint64_to_int s n = 128 + match Int64.unsigned_to_int n with 129 + | None -> raise (Error (Unsupported (s, n))) 130 + | Some n -> n 131 + 132 + let load_bytes d off len = 133 + LargeFile.seek_in d.ic off; 134 + really_input_bytes d.ic len 135 + 136 + type t = 137 + { 138 + defines_symbol: string -> bool; 139 + symbol_offset: string -> int64 option; 140 + } 141 + 142 + module ELF = struct 143 + 144 + (* Reference: http://man7.org/linux/man-pages/man5/elf.5.html *) 145 + 146 + let header_size d = 147 + 40 + 3 * word_size d 148 + 149 + type header = 150 + { 151 + e_shoff: int64; 152 + e_shentsize: int; 153 + e_shnum: int; 154 + e_shstrndx: int; 155 + } 156 + 157 + let read_header d = 158 + let buf = load_bytes d 0L (header_size d) in 159 + let word_size = word_size d in 160 + let e_shnum = get_uint16 d buf (36 + 3 * word_size) in 161 + let e_shentsize = get_uint16 d buf (34 + 3 * word_size) in 162 + let e_shoff = get_word d buf (24 + 2 * word_size) in 163 + let e_shstrndx = get_uint16 d buf (38 + 3 * word_size) in 164 + {e_shnum; e_shentsize; e_shoff; e_shstrndx} 165 + 166 + type sh_type = 167 + | SHT_STRTAB 168 + | SHT_DYNSYM 169 + | SHT_OTHER 170 + 171 + type section = 172 + { 173 + sh_name: int; 174 + sh_type: sh_type; 175 + sh_addr: int64; 176 + sh_offset: int64; 177 + sh_size: int; 178 + sh_entsize: int; 179 + sh_name_str: string; 180 + } 181 + 182 + let load_section_body d {sh_offset; sh_size; _} = 183 + load_bytes d sh_offset sh_size 184 + 185 + let read_sections d {e_shoff; e_shnum; e_shentsize; e_shstrndx; _} = 186 + let buf = load_bytes d e_shoff (e_shnum * e_shentsize) in 187 + let word_size = word_size d in 188 + let mk i = 189 + let base = i * e_shentsize in 190 + let sh_name = get_uint "sh_name" d buf (base + 0) in 191 + let sh_type = 192 + match get_uint32 d buf (base + 4) with 193 + | 3l -> SHT_STRTAB 194 + | 11l -> SHT_DYNSYM 195 + | _ -> SHT_OTHER 196 + in 197 + let sh_addr = get_word d buf (base + 8 + word_size) in 198 + let sh_offset = get_word d buf (base + 8 + 2 * word_size) in 199 + let sh_size = 200 + uint64_to_int "sh_size" 201 + (get_word d buf (base + 8 + 3 * word_size)) 202 + in 203 + let sh_entsize = 204 + uint64_to_int "sh_entsize" 205 + (get_word d buf (base + 16 + 5 * word_size)) 206 + in 207 + {sh_name; sh_type; sh_addr; sh_offset; 208 + sh_size; sh_entsize; sh_name_str = ""} 209 + in 210 + let sections = Array.init e_shnum mk in 211 + if e_shstrndx = 0 then 212 + (* no string table *) 213 + sections 214 + else 215 + let shstrtbl = load_section_body d sections.(e_shstrndx) in 216 + let set_name sec = 217 + let sh_name_str = name_at shstrtbl sec.sh_name in 218 + {sec with sh_name_str} 219 + in 220 + Array.map set_name sections 221 + 222 + let read_sections d h = 223 + let {e_shoff; e_shentsize; e_shnum; e_shstrndx} = h in 224 + if e_shoff = 0L then 225 + [||] 226 + else begin 227 + let buf = lazy (load_bytes d e_shoff e_shentsize) in 228 + let word_size = word_size d in 229 + let e_shnum = 230 + if e_shnum = 0 then 231 + (* The real e_shnum is the sh_size of the initial section.*) 232 + uint64_to_int "e_shnum" 233 + (get_word d (Lazy.force buf) (8 + 3 * word_size)) 234 + else 235 + e_shnum 236 + in 237 + let e_shstrndx = 238 + if e_shstrndx = 0xffff then 239 + (* The real e_shstrndx is the sh_link of the initial section. *) 240 + get_uint "e_shstrndx" d (Lazy.force buf) (8 + 4 * word_size) 241 + else 242 + e_shstrndx 243 + in 244 + read_sections d {h with e_shnum; e_shstrndx} 245 + end 246 + 247 + type symbol = 248 + { 249 + st_name: string; 250 + st_value: int64; 251 + st_shndx: int; 252 + } 253 + 254 + let find_section sections type_ sectname = 255 + let f {sh_type; sh_name_str; _} = 256 + sh_type = type_ && sh_name_str = sectname 257 + in 258 + array_find f sections 259 + 260 + let read_symbols d sections = 261 + match find_section sections SHT_DYNSYM ".dynsym" with 262 + | None -> [| |] 263 + | Some {sh_entsize = 0; _} -> 264 + raise (Error (Out_of_range "sh_entsize=0")) 265 + | Some dynsym -> 266 + begin match find_section sections SHT_STRTAB ".dynstr" with 267 + | None -> [| |] 268 + | Some dynstr -> 269 + let strtbl = load_section_body d dynstr in 270 + let buf = load_section_body d dynsym in 271 + let word_size = word_size d in 272 + let mk i = 273 + let base = i * dynsym.sh_entsize in 274 + let st_name = name_at strtbl (get_uint "st_name" d buf base) in 275 + let st_value = get_word d buf (base + word_size (* ! *)) in 276 + let st_shndx = 277 + let off = match d.bitness with B64 -> 6 | B32 -> 14 in 278 + get_uint16 d buf (base + off) 279 + in 280 + {st_name; st_value; st_shndx} 281 + in 282 + Array.init (dynsym.sh_size / dynsym.sh_entsize) mk 283 + end 284 + 285 + let find_symbol symbols symname = 286 + let f = function 287 + | {st_shndx = 0; _} -> false 288 + | {st_name; _} -> st_name = symname 289 + in 290 + array_find f symbols 291 + 292 + let symbol_offset sections symbols symname = 293 + match find_symbol symbols symname with 294 + | None -> 295 + None 296 + | Some {st_shndx; st_value; _} -> 297 + (* st_value in executables and shared objects holds a virtual (absolute) 298 + address. See https://refspecs.linuxfoundation.org/elf/elf.pdf, page 299 + 1-21, "Symbol Values". *) 300 + Some Int64.(add sections.(st_shndx).sh_offset 301 + (sub st_value sections.(st_shndx).sh_addr)) 302 + 303 + let defines_symbol symbols symname = 304 + Option.is_some (find_symbol symbols symname) 305 + 306 + let read ic = 307 + seek_in ic 0; 308 + let identification = really_input_bytes ic 16 in 309 + let bitness = 310 + match Bytes.get identification 4 with 311 + | '\x01' -> B32 312 + | '\x02' -> B64 313 + | _ as c -> 314 + raise (Error (Unsupported ("ELFCLASS", Int64.of_int (Char.code c)))) 315 + in 316 + let endianness = 317 + match Bytes.get identification 5 with 318 + | '\x01' -> LE 319 + | '\x02' -> BE 320 + | _ as c -> 321 + raise (Error (Unsupported ("ELFDATA", Int64.of_int (Char.code c)))) 322 + in 323 + let d = {ic; bitness; endianness} in 324 + let header = read_header d in 325 + let sections = read_sections d header in 326 + let symbols = read_symbols d sections in 327 + let symbol_offset = symbol_offset sections symbols in 328 + let defines_symbol = defines_symbol symbols in 329 + {symbol_offset; defines_symbol} 330 + end 331 + 332 + module Mach_O = struct 333 + 334 + (* Reference: 335 + https://github.com/aidansteele/osx-abi-macho-file-format-reference *) 336 + 337 + let size_int = 4 338 + 339 + let header_size {bitness; _} = 340 + (match bitness with B64 -> 6 | B32 -> 5) * 4 + 2 * size_int 341 + 342 + type header = 343 + { 344 + ncmds: int; 345 + sizeofcmds: int; 346 + } 347 + 348 + let read_header d = 349 + let buf = load_bytes d 0L (header_size d) in 350 + let ncmds = get_uint "ncmds" d buf (8 + 2 * size_int) in 351 + let sizeofcmds = get_uint "sizeofcmds" d buf (12 + 2 * size_int) in 352 + {ncmds; sizeofcmds} 353 + 354 + type lc_symtab = 355 + { 356 + symoff: int32; 357 + nsyms: int; 358 + stroff: int32; 359 + strsize: int; 360 + } 361 + 362 + type load_command = 363 + | LC_SYMTAB of lc_symtab 364 + | OTHER 365 + 366 + let read_load_commands d {ncmds; sizeofcmds} = 367 + let buf = load_bytes d (Int64.of_int (header_size d)) sizeofcmds in 368 + let base = ref 0 in 369 + let mk _ = 370 + let cmd = get_uint32 d buf (!base + 0) in 371 + let cmdsize = get_uint "cmdsize" d buf (!base + 4) in 372 + let lc = 373 + match cmd with 374 + | 0x2l -> 375 + let symoff = get_uint32 d buf (!base + 8) in 376 + let nsyms = get_uint "nsyms" d buf (!base + 12) in 377 + let stroff = get_uint32 d buf (!base + 16) in 378 + let strsize = get_uint "strsize" d buf (!base + 20) in 379 + LC_SYMTAB {symoff; nsyms; stroff; strsize} 380 + | _ -> 381 + OTHER 382 + in 383 + base := !base + cmdsize; 384 + lc 385 + in 386 + Array.init ncmds mk 387 + 388 + type symbol = 389 + { 390 + n_name: string; 391 + n_type: int; 392 + n_value: int64; 393 + } 394 + 395 + let size_nlist d = 396 + 8 + word_size d 397 + 398 + let read_symbols d load_commands = 399 + match 400 + (* Can it happen there be more than one LC_SYMTAB? *) 401 + array_find_map (function 402 + | LC_SYMTAB symtab -> Some symtab 403 + | _ -> None 404 + ) load_commands 405 + with 406 + | None -> [| |] 407 + | Some {symoff; nsyms; stroff; strsize} -> 408 + let strtbl = load_bytes d (uint64_of_uint32 stroff) strsize in 409 + let buf = 410 + load_bytes d (uint64_of_uint32 symoff) (nsyms * size_nlist d) in 411 + let size_nlist = size_nlist d in 412 + let mk i = 413 + let base = i * size_nlist in 414 + let n_name = name_at strtbl (get_uint "n_name" d buf (base + 0)) in 415 + let n_type = Bytes.get_uint8 buf (base + 4) in 416 + let n_value = get_word d buf (base + 8) in 417 + {n_name; n_type; n_value} 418 + in 419 + Array.init nsyms mk 420 + 421 + let fix symname = 422 + "_" ^ symname 423 + 424 + let find_symbol symbols symname = 425 + let f {n_name; n_type; _} = 426 + n_type land 0b1111 = 0b1111 (* N_EXT + N_SECT *) && 427 + n_name = symname 428 + in 429 + array_find f symbols 430 + 431 + let symbol_offset symbols symname = 432 + let symname = fix symname in 433 + match find_symbol symbols symname with 434 + | None -> None 435 + | Some {n_value; _} -> Some n_value 436 + 437 + let defines_symbol symbols symname = 438 + let symname = fix symname in 439 + Option.is_some (find_symbol symbols symname) 440 + 441 + type magic = 442 + | MH_MAGIC 443 + | MH_CIGAM 444 + | MH_MAGIC_64 445 + | MH_CIGAM_64 446 + 447 + let read ic = 448 + seek_in ic 0; 449 + let magic = really_input_bytes ic 4 in 450 + let magic = 451 + match Bytes.get_int32_ne magic 0 with 452 + | 0xFEEDFACEl -> MH_MAGIC 453 + | 0xCEFAEDFEl -> MH_CIGAM 454 + | 0xFEEDFACFl -> MH_MAGIC_64 455 + | 0xCFFAEDFEl -> MH_CIGAM_64 456 + | _ -> (* should not happen *) 457 + raise (Error (Unrecognized (Bytes.to_string magic))) 458 + in 459 + let bitness = 460 + match magic with 461 + | MH_MAGIC | MH_CIGAM -> B32 462 + | MH_MAGIC_64 | MH_CIGAM_64 -> B64 463 + in 464 + let endianness = 465 + match magic, Sys.big_endian with 466 + | (MH_MAGIC | MH_MAGIC_64), false 467 + | (MH_CIGAM | MH_CIGAM_64), true -> LE 468 + | (MH_MAGIC | MH_MAGIC_64), true 469 + | (MH_CIGAM | MH_CIGAM_64), false -> BE 470 + in 471 + let d = {ic; endianness; bitness} in 472 + let header = read_header d in 473 + let load_commands = read_load_commands d header in 474 + let symbols = read_symbols d load_commands in 475 + let symbol_offset = symbol_offset symbols in 476 + let defines_symbol = defines_symbol symbols in 477 + {symbol_offset; defines_symbol} 478 + end 479 + 480 + module FlexDLL = struct 481 + 482 + (* Reference: 483 + https://docs.microsoft.com/en-us/windows/win32/debug/pe-format *) 484 + 485 + let header_size = 24 486 + 487 + type header = 488 + { 489 + e_lfanew: int64; 490 + number_of_sections: int; 491 + size_of_optional_header: int; 492 + characteristics: int; 493 + } 494 + 495 + let read_header e_lfanew d buf = 496 + let number_of_sections = get_uint16 d buf 6 in 497 + let size_of_optional_header = get_uint16 d buf 20 in 498 + let characteristics = get_uint16 d buf 22 in 499 + {e_lfanew; number_of_sections; size_of_optional_header; characteristics} 500 + 501 + type optional_header_magic = 502 + | PE32 503 + | PE32PLUS 504 + 505 + type optional_header = 506 + { 507 + magic: optional_header_magic; 508 + image_base: int64; 509 + } 510 + 511 + let read_optional_header d {e_lfanew; size_of_optional_header; _} = 512 + if size_of_optional_header = 0 then 513 + raise (Error (Unrecognized "SizeOfOptionalHeader=0")); 514 + let buf = 515 + load_bytes d Int64.(add e_lfanew (of_int header_size)) 516 + size_of_optional_header 517 + in 518 + let magic = 519 + match get_uint16 d buf 0 with 520 + | 0x10b -> PE32 521 + | 0x20b -> PE32PLUS 522 + | n -> 523 + raise (Error (Unsupported ("optional_header_magic", Int64.of_int n))) 524 + in 525 + let image_base = 526 + match magic with 527 + | PE32 -> uint64_of_uint32 (get_uint32 d buf 28) 528 + | PE32PLUS -> get_uint64 d buf 24 529 + in 530 + {magic; image_base} 531 + 532 + type section = 533 + { 534 + name: string; 535 + virtual_size: int; 536 + virtual_address: int64; 537 + size_of_raw_data: int; 538 + pointer_to_raw_data: int64; 539 + } 540 + 541 + let section_header_size = 40 542 + 543 + let read_sections d 544 + {e_lfanew; number_of_sections; size_of_optional_header; _} = 545 + let buf = 546 + load_bytes d 547 + Int64.(add e_lfanew (of_int (header_size + size_of_optional_header))) 548 + (number_of_sections * section_header_size) 549 + in 550 + let mk i = 551 + let base = i * section_header_size in 552 + let name = name_at ~max_len:8 buf (base + 0) in 553 + let virtual_size = get_uint "virtual_size" d buf (base + 8) in 554 + let virtual_address = uint64_of_uint32 (get_uint32 d buf (base + 12)) in 555 + let size_of_raw_data = get_uint "size_of_raw_data" d buf (base + 16) in 556 + let pointer_to_raw_data = 557 + uint64_of_uint32 (get_uint32 d buf (base + 20)) in 558 + {name; virtual_size; virtual_address; 559 + size_of_raw_data; pointer_to_raw_data} 560 + in 561 + Array.init number_of_sections mk 562 + 563 + type symbol = 564 + { 565 + name: string; 566 + address: int64; 567 + } 568 + 569 + let load_section_body d {size_of_raw_data; pointer_to_raw_data; _} = 570 + load_bytes d pointer_to_raw_data size_of_raw_data 571 + 572 + let find_section sections sectname = 573 + array_find (function ({name; _} : section) -> name = sectname) sections 574 + 575 + (* We extract the list of exported symbols as encoded by flexlink, see 576 + https://github.com/alainfrisch/flexdll/blob/bd636def70d941674275b2f4b6c13a34ba23f9c9/reloc.ml 577 + #L500-L525 *) 578 + 579 + let read_symbols d {image_base; _} sections = 580 + match find_section sections ".exptbl" with 581 + | None -> [| |] 582 + | Some ({virtual_address; _} as exptbl) -> 583 + let buf = load_section_body d exptbl in 584 + let numexports = 585 + uint64_to_int "numexports" (get_word d buf 0) 586 + in 587 + let word_size = word_size d in 588 + let mk i = 589 + let address = get_word d buf (word_size * (2 * i + 1)) in 590 + let nameoff = get_word d buf (word_size * (2 * i + 2)) in 591 + let name = 592 + let off = Int64.(sub nameoff (add virtual_address image_base)) in 593 + name_at buf (uint64_to_int "exptbl name offset" off) 594 + in 595 + {name; address} 596 + in 597 + Array.init numexports mk 598 + 599 + let symbol_offset {image_base; _} sections symbols = 600 + match find_section sections ".data" with 601 + | None -> Fun.const None 602 + | Some {virtual_address; pointer_to_raw_data; _} -> 603 + fun symname -> 604 + begin match 605 + array_find (function {name; _} -> name = symname) symbols 606 + with 607 + | None -> None 608 + | Some {address; _} -> 609 + Some Int64.(add pointer_to_raw_data 610 + (sub address (add virtual_address image_base))) 611 + end 612 + 613 + let defines_symbol symbols symname = 614 + Array.exists (fun {name; _} -> name = symname) symbols 615 + 616 + type machine_type = 617 + | IMAGE_FILE_MACHINE_ARM 618 + | IMAGE_FILE_MACHINE_ARM64 619 + | IMAGE_FILE_MACHINE_AMD64 620 + | IMAGE_FILE_MACHINE_I386 621 + 622 + let read ic = 623 + let e_lfanew = 624 + seek_in ic 0x3c; 625 + let buf = really_input_bytes ic 4 in 626 + uint64_of_uint32 (Bytes.get_int32_le buf 0) 627 + in 628 + LargeFile.seek_in ic e_lfanew; 629 + let buf = really_input_bytes ic header_size in 630 + let magic = Bytes.sub_string buf 0 4 in 631 + if magic <> "PE\000\000" then raise (Error (Unrecognized magic)); 632 + let machine = 633 + match Bytes.get_uint16_le buf 4 with 634 + | 0x1c0 -> IMAGE_FILE_MACHINE_ARM 635 + | 0xaa64 -> IMAGE_FILE_MACHINE_ARM64 636 + | 0x8664 -> IMAGE_FILE_MACHINE_AMD64 637 + | 0x14c -> IMAGE_FILE_MACHINE_I386 638 + | n -> raise (Error (Unsupported ("MACHINETYPE", Int64.of_int n))) 639 + in 640 + let bitness = 641 + match machine with 642 + | IMAGE_FILE_MACHINE_AMD64 643 + | IMAGE_FILE_MACHINE_ARM64 -> B64 644 + | IMAGE_FILE_MACHINE_I386 645 + | IMAGE_FILE_MACHINE_ARM -> B32 646 + in 647 + let d = {ic; endianness = LE; bitness} in 648 + let header = read_header e_lfanew d buf in 649 + let opt_header = read_optional_header d header in 650 + let sections = read_sections d header in 651 + let symbols = read_symbols d opt_header sections in 652 + let symbol_offset = symbol_offset opt_header sections symbols in 653 + let defines_symbol = defines_symbol symbols in 654 + {symbol_offset; defines_symbol} 655 + end 656 + 657 + let read ic = 658 + seek_in ic 0; 659 + let magic = really_input_string ic 4 in 660 + match magic.[0], magic.[1], magic.[2], magic.[3] with 661 + | '\x7F', 'E', 'L', 'F' -> 662 + ELF.read ic 663 + | '\xFE', '\xED', '\xFA', '\xCE' 664 + | '\xCE', '\xFA', '\xED', '\xFE' 665 + | '\xFE', '\xED', '\xFA', '\xCF' 666 + | '\xCF', '\xFA', '\xED', '\xFE' -> 667 + Mach_O.read ic 668 + | 'M', 'Z', _, _ -> 669 + FlexDLL.read ic 670 + | _ -> 671 + raise (Error (Unrecognized magic)) 672 + 673 + let with_open_in fn f = 674 + let ic = open_in_bin fn in 675 + Fun.protect ~finally:(fun () -> close_in_noerr ic) (fun () -> f ic) 676 + 677 + let read filename = 678 + match with_open_in filename read with 679 + | t -> Ok t 680 + | exception End_of_file -> 681 + Result.Error Truncated_file 682 + | exception Error err -> 683 + Result.Error err 684 + 685 + let defines_symbol {defines_symbol; _} symname = 686 + defines_symbol symname 687 + 688 + let symbol_offset {symbol_offset; _} symname = 689 + symbol_offset symname

+30

utils/binutils.mli

··· 1 + (**************************************************************************) 2 + (* *) 3 + (* OCaml *) 4 + (* *) 5 + (* Nicolas Ojeda Bar, LexiFi *) 6 + (* *) 7 + (* Copyright 2020 Institut National de Recherche en Informatique et *) 8 + (* en Automatique. *) 9 + (* *) 10 + (* All rights reserved. This file is distributed under the terms of *) 11 + (* the GNU Lesser General Public License version 2.1, with the *) 12 + (* special exception on linking described in the file LICENSE. *) 13 + (* *) 14 + (**************************************************************************) 15 + 16 + type error = 17 + | Truncated_file 18 + | Unrecognized of string 19 + | Unsupported of string * int64 20 + | Out_of_range of string 21 + 22 + val error_to_string: error -> string 23 + 24 + type t 25 + 26 + val read: string -> (t, error) Result.t 27 + 28 + val defines_symbol: t -> string -> bool 29 + 30 + val symbol_offset: t -> string -> int64 option

Configure Feed

Configure Feed