Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

extract_unit #8490

Open
vicuna opened this Issue Feb 19, 2004 · 1 comment

Comments

Projects
None yet
1 participant
@vicuna
Copy link
Collaborator

vicuna commented Feb 19, 2004

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



@vicuna

This comment has been minimized.

Copy link
Collaborator Author

vicuna commented Apr 1, 2004

Comment author: administrator

See #2375 for a more general suggestion

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.