0002272: extract_unit

View Issue Details [ Jump to Notes ]

[ Issue History ] [ Print ]

Project

Category

View Status

Date Submitted

Last Update

0002272

OCaml

OCaml general

public

2004-02-19 10:18

2009-08-20 14:19

Reporter

administrator

Assigned To

Priority

normal

Severity

feature

Reproducibility

always

Status

acknowledged

Resolution

open

Platform

OS Version

Product Version

Target Version

Fixed in Version

Summary

0002272: extract_unit

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

----------------
----------------

Issue History
Date Modified	Username	Field	Change
2005-11-18 10:13	administrator	New Issue
2009-08-20 14:19	xclerc	Relationship added	child of 0002375

Notes
(0000205) administrator (administrator) 2004-04-01 15:55	See PR#2375 for a more general suggestion