Original bug ID: 2272
Reporter: administrator
Status: acknowledged
Resolution: open
Priority: normal
Severity: feature
Category: tools (ocaml{lex,yacc,dep,debug,...})
Tags: patch
Child of: #2375

Bug description

Encore moi.

Je propose d'inclure dans la distribution le tout petit programme
ci-dessous, extract_unit, qui permet d'extraire des .cmo à partir d'un
.cma.

Il vérifie plus ou moins l'invariant:

ocamlc -a -o new.cma extract_unit old.cma
===>
new.cma = old.cma

(modulo les petites infos de link des .cma qui sont perdues).
On peut aussi indiquer quelles unités extraire.

Ça permet d'implémenter à la main ce que je proposais dans un mail
précédent (-packer des .cmo qui ont été mis dans un .cma).

Ça se compile en ajoutant dans tools/Makefile:

extract_unit: extract_unit.cmo
$(CAMLC) $(LINKFLAGS) -o extract_unit config.cmo extract_unit.cmo

-- Alain

(* Extract the compilations units (.cmo) from a library (.cma) *)

open Config
open Emitcode

let copy_file_chunk ic oc len =
let buff = String.create 0x1000 in
let rec copy n =
if n <= 0 then () else begin
let r = input ic buff 0 (min n 0x1000) in
if r = 0 then raise End_of_file else (output oc buff 0 r; copy(n-r))
end
in copy len

let copy_out ic compunit filename =
let outchan = open_out_bin filename in
output_string outchan cmo_magic_number;
let pos_depl = pos_out outchan in
output_binary_int outchan 0;

seek_in ic compunit.cu_pos;
compunit.cu_pos <- pos_out outchan;
copy_file_chunk ic outchan compunit.cu_codesize;

if compunit.cu_debug > 0 then begin
seek_in ic compunit.cu_debug;
compunit.cu_debug <- pos_out outchan;
copy_file_chunk ic outchan compunit.cu_debugsize
end;

let pos_compunit = pos_out outchan in
output_value outchan compunit;
seek_out outchan pos_depl;
output_binary_int outchan pos_compunit;
close_out outchan

let extract predicate ic toc =
List.iter
(fun cu ->
let fn = cu.cu_name ^ ".cmo" in
fn.[0] <- Char.lowercase fn.[0];
if predicate fn then begin
Printf.printf "%s " fn;
copy_out ic cu fn
end
) toc.lib_units

let load_cma filename f =
let ic = open_in_bin filename in
let buffer = String.create (String.length cma_magic_number) in
really_input ic buffer 0 (String.length cma_magic_number);
if buffer = cma_magic_number then begin
let toc_pos = input_binary_int ic in
seek_in ic toc_pos;
let toc = (input_value ic : library) in
f ic toc;
close_in ic
end else begin
prerr_endline "Not a library file"; exit 2
end

let usage () =
prerr_endline
"Usage: extract_unit <lib.cma> unit1.cmo unit2.cmo ...
Extract some compilation units from a library.
If no compilation unit name is given, all the units are extracted
from the library."

let main() =
let predicate =
match Array.length Sys.argv with
| 1 -> usage (); exit 2
| 2 -> (fun _ -> true)
| n ->
let h = Hashtbl.create 30 in
for i = 2 to n - 1 do Hashtbl.add h Sys.argv.(i) () done;
Hashtbl.mem h
in
load_cma Sys.argv.(1) (extract predicate);
exit 0

let _ = Printexc.catch main (); exit 0