You signed in with another tab or window. Reload to refresh your session.You signed out in another tab or window. Reload to refresh your session.You switched accounts on another tab or window. Reload to refresh your session.Dismiss alert
(* 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
The text was updated successfully, but these errors were encountered:
This issue has been open one year with no activity. Consequently, it is being marked with the "stale" label. What this means is that the issue will be automatically closed in 30 days unless more comments are added or the "stale" label is removed. Comments that provide new information on the issue are especially welcome: is it still reproducible? did it appear in other contexts? how critical is it? etc.
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
The text was updated successfully, but these errors were encountered: