Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
binary-compat: 3.12.0 ok
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/binary-compat@10825 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
  • Loading branch information
lefessan committed Nov 18, 2010
1 parent 0ed363b commit 9e259f0
Show file tree
Hide file tree
Showing 3 changed files with 473 additions and 29 deletions.
82 changes: 53 additions & 29 deletions binary-compat/compat/3.12.0/v3120_cmi.ml
@@ -1,12 +1,25 @@
module Current_cmi_format = Cmi_format

exception TODO

module CMI = struct

module Asttypes = struct

open Asttypes
module T = V3120_types.Asttypes



let constant c =
match c with
T.Const_int int -> Const_int int
| T.Const_char char -> Const_char char
| T.Const_string string -> Const_string string
| T.Const_float string -> Const_float string
| T.Const_int32 int32 -> Const_int32 int32
| T.Const_int64 int64 -> Const_int64 int64
| T.Const_nativeint nativeint -> Const_nativeint nativeint


let virtual_flag vf =
match vf with
T.Virtual -> Virtual
Expand All @@ -27,6 +40,11 @@ module Asttypes = struct
match mf with
T.Immutable -> Immutable
| T.Mutable -> Mutable

let direction_flag d =
match d with
T.Upto -> Upto
| T.Downto -> Downto

end

Expand Down Expand Up @@ -122,7 +140,11 @@ module Types : sig

val signature_item :
V3120_types.Types.signature_item -> Types.signature_item


val record_representation :
V3120_types.Types.record_representation ->
Types.record_representation

end = struct

open Asttypes
Expand Down Expand Up @@ -367,32 +389,34 @@ end
;;

module Cmi_format : sig

val pers_flags :
V3120_types.Cmi_format.pers_flags -> Cmi_format.pers_flags
;;

end = struct

val pers_flags :
V3120_types.Cmi_format.pers_flags -> Cmi_format.pers_flags
;;

module T = V3120_types.Cmi_format
open Cmi_format
end = struct

module T = V3120_types.Cmi_format
open Cmi_format

let pers_flags flag =
match flag with
T.Rectypes -> Rectypes
end

let pers_flags flag =
match flag with
T.Rectypes -> Rectypes
end

let input_cmi_file ic magic =
if magic <> V3120_types.cmi_magic_number then
raise Current_cmi_format.No_such_magic;

Ident.reset ();
Types.reset ();

let (cmi_name, cmi_sign) = (input_value ic : string * V3120_types.Types.signature_item list) in
let cmi_crcs = (input_value ic : (string * Digest.t) list) in
let cmi_flags = (input_value ic : V3120_types.Cmi_format.pers_flags list) in

let cmi_sign = List.map Types.signature_item cmi_sign in
let cmi_flags = List.map Cmi_format.pers_flags cmi_flags in
{ Current_cmi_format.cmi_name ; cmi_sign; cmi_crcs; cmi_flags }
if magic <> V3120_types.cmi_magic_number then
raise Cmi_format.No_such_magic;
CMI.Ident.reset ();
CMI.Types.reset ();
let (cmi_name, cmi_sign) = (input_value ic : string * V3120_types.Types.signature_item list) in
let cmi_crcs = (input_value ic : (string * Digest.t) list) in
let cmi_flags = (input_value ic : V3120_types.Cmi_format.pers_flags list) in
let cmi_sign = List.map CMI.Types.signature_item cmi_sign in
let cmi_flags = List.map CMI.Cmi_format.pers_flags cmi_flags in
{ Cmi_format.cmi_name ; cmi_sign; cmi_crcs; cmi_flags }
252 changes: 252 additions & 0 deletions binary-compat/compat/3.12.0/v3120_cmo.ml
@@ -1 +1,253 @@

exception TODO

module CMO = struct

module Lambda : sig

val structured_constant :
V3120_types.Lambda.structured_constant ->
Lambda.structured_constant

val primitive :
V3120_types.Lambda.primitive ->
Lambda.primitive

val meth_kind :
V3120_types.Lambda.meth_kind ->
Lambda.meth_kind

end = struct

open V3120_cmi.CMI
open Asttypes

open Lambda
module T = V3120_types.Lambda

let rec structured_constant sc =
match sc with
T.Const_base c -> Const_base (Asttypes.constant c)
| T.Const_pointer int -> Const_pointer int
| T.Const_block (int, list) ->
Const_block (int, List.map structured_constant list)
| T.Const_float_array slist -> Const_float_array slist
| T.Const_immstring string -> Const_immstring string

let rec primitive p =
match p with
T.Pidentity -> Pidentity
| T.Pignore -> Pignore

| T.Pgetglobal id -> Pgetglobal (Ident.t id)
| T.Psetglobal id -> Psetglobal (Ident.t id)

| T.Pmakeblock (int, m) -> Pmakeblock (int, mutable_flag m)
| T.Pfield int -> Pfield int
| T.Psetfield (int, bool) -> Psetfield (int, bool)
| T.Pfloatfield int -> Pfloatfield int
| T.Psetfloatfield int -> Psetfloatfield int
| T.Pduprecord (r, int) ->
Pduprecord (Types.record_representation r, int)

| T.Plazyforce -> Plazyforce

| T.Pccall d -> Pccall (Primitive.description d)

| T.Praise -> Praise

| T.Psequand -> Psequand
| T.Psequor -> Psequor
| T.Pnot -> Pnot

| T.Pnegint -> Pnegint
| T.Paddint -> Paddint
| T.Psubint -> Psubint
| T.Pmulint -> Pmulint
| T.Pdivint -> Pdivint
| T.Pmodint -> Pmodint
| T.Pandint -> Pandint
| T.Porint -> Porint
| T.Pxorint -> Pxorint
| T.Plslint -> Plslint
| T.Plsrint -> Plsrint
| T.Pasrint -> Pasrint
| T.Pintcomp c -> Pintcomp (comparison c)
| T.Poffsetint int -> Poffsetint int
| T.Poffsetref int -> Poffsetref int

| T.Pintoffloat -> Pintoffloat
| T.Pfloatofint -> Pfloatofint

| T.Pnegfloat -> Pnegfloat
| T.Pabsfloat -> Pabsfloat

| T.Paddfloat -> Paddfloat
| T.Psubfloat -> Psubfloat
| T.Pmulfloat -> Pmulfloat
| T.Pdivfloat -> Pdivfloat

| T.Pfloatcomp c -> Pfloatcomp (comparison c)

| T.Pstringlength -> Pstringlength
| T.Pstringrefu -> Pstringrefu
| T.Pstringsetu -> Pstringsetu
| T.Pstringrefs -> Pstringrefs
| T.Pstringsets -> Pstringsets

| T.Pmakearray k -> Pmakearray (array_kind k)
| T.Parraylength k -> Parraylength (array_kind k)
| T.Parrayrefu k -> Parrayrefu (array_kind k)
| T.Parraysetu k -> Parraysetu (array_kind k)
| T.Parrayrefs k -> Parrayrefs (array_kind k)
| T.Parraysets k -> Parraysets (array_kind k)

| T.Pisint -> Pisint

| T.Pisout -> Pisout

| T.Pbittest -> Pbittest

| T.Pbintofint b -> Pbintofint (boxed_integer b)
| T.Pintofbint b -> Pintofbint (boxed_integer b)
| T.Pcvtbint (s, d) ->
Pcvtbint (boxed_integer s, boxed_integer d)
| T.Pnegbint b -> Pnegbint (boxed_integer b)
| T.Paddbint b -> Paddbint (boxed_integer b)
| T.Psubbint b -> Psubbint (boxed_integer b)
| T.Pmulbint b -> Pmulbint (boxed_integer b)
| T.Pdivbint b -> Pdivbint (boxed_integer b)
| T.Pmodbint b -> Pmodbint (boxed_integer b)
| T.Pandbint b -> Pandbint (boxed_integer b)
| T.Porbint b -> Porbint (boxed_integer b)
| T.Pxorbint b -> Pxorbint (boxed_integer b)
| T.Plslbint b -> Plslbint (boxed_integer b)
| T.Plsrbint b -> Plsrbint (boxed_integer b)
| T.Pasrbint b -> Pasrbint (boxed_integer b)
| T.Pbintcomp (b,c) -> Pbintcomp (boxed_integer b, comparison c)

| T.Pbigarrayref (bool, int, kind, layout) ->
Pbigarrayref (bool, int,
bigarray_kind kind, bigarray_layout layout)
| T.Pbigarrayset (bool, int, kind, layout) ->
Pbigarrayset (bool, int,
bigarray_kind kind, bigarray_layout layout)

and comparison c =
match c with
T.Ceq -> Ceq
| T.Cneq -> Cneq
| T.Clt -> Clt
| T.Cgt -> Cgt
| T.Cle -> Cle
| T.Cge -> Cge

and array_kind k =
match k with
T.Pgenarray -> Pgenarray
| T.Paddrarray -> Paddrarray
| T.Pintarray -> Pintarray
| T.Pfloatarray -> Pfloatarray

and boxed_integer b =
match b with
T.Pnativeint -> Pnativeint
| T.Pint32 -> Pint32
| T.Pint64 -> Pint64

and bigarray_kind kind =
match kind with
T.Pbigarray_unknown -> Pbigarray_unknown
| T.Pbigarray_float32 -> Pbigarray_float32
| T.Pbigarray_float64 -> Pbigarray_float64
| T.Pbigarray_sint8 -> Pbigarray_sint8
| T.Pbigarray_uint8 -> Pbigarray_uint8
| T.Pbigarray_sint16 -> Pbigarray_sint16
| T.Pbigarray_uint16 -> Pbigarray_uint16
| T.Pbigarray_int32 -> Pbigarray_int32
| T.Pbigarray_int64 -> Pbigarray_int64
| T.Pbigarray_caml_int -> Pbigarray_caml_int
| T.Pbigarray_native_int -> Pbigarray_native_int
| T.Pbigarray_complex32 -> Pbigarray_complex32
| T.Pbigarray_complex64 -> Pbigarray_complex64

and bigarray_layout layout =
match layout with
T.Pbigarray_unknown_layout -> Pbigarray_unknown_layout
| T.Pbigarray_c_layout -> Pbigarray_c_layout
| T.Pbigarray_fortran_layout -> Pbigarray_fortran_layout


let meth_kind k =
match k with
T.Self -> Self
| T.Public -> Public
| T.Cached -> Cached
end


module Cmo_format : sig


val compilation_unit :
V3120_types.Cmo_format.compilation_unit ->
Cmo_format.compilation_unit
val library : V3120_types.Cmo_format.library -> Cmo_format.library

end = struct

open V3120_cmi.CMI

open Cmo_format
module T = V3120_types.Cmo_format

let reloc_info r =
match r with
T.Reloc_literal sc ->
Reloc_literal (Lambda.structured_constant sc)
| T.Reloc_getglobal id ->
Reloc_getglobal (Ident.t id)
| T.Reloc_setglobal id -> Reloc_setglobal (Ident.t id)
| T.Reloc_primitive s -> Reloc_primitive s


let compilation_unit v =
{
cu_name = v.T.cu_name;
cu_pos = v.T.cu_pos;
cu_codesize = v.T.cu_codesize;
cu_reloc = List.map (fun (r,i) ->
(reloc_info r,i)) v.T.cu_reloc;
cu_imports = v.T.cu_imports;
cu_primitives = v.T.cu_primitives;
cu_force_link = v.T.cu_force_link;
cu_debug = v.T.cu_debug;
cu_debugsize = v.T.cu_debugsize;
}

let library v =
{
lib_units = List.map compilation_unit v.T.lib_units;
lib_custom = v.T.lib_custom;
lib_ccobjs = v.T.lib_ccobjs;
lib_ccopts = v.T.lib_ccopts;
lib_dllibs = v.T.lib_dllibs;
}


end

end

open Cmo_format

let input_cmo_file ic magic =
if magic = V3120_types.cmo_magic_number then
let v = (input_value ic : V3120_types.Cmo_format.compilation_unit) in
Compunit (CMO.Cmo_format.compilation_unit v)
else
if magic = V3120_types.cma_magic_number then
let v = (input_value ic : V3120_types.Cmo_format.library) in
Library (CMO.Cmo_format.library v)
else
raise Cmi_format.No_such_magic

0 comments on commit 9e259f0

Please sign in to comment.