purge ilib and javalib

libs/ilib/Makefile

@@ -1,26 +0,0 @@
-OCAMLOPT=ocamlopt
-OCAMLC=ocamlc
-
-SRCS=peData.ml peReader.ml peWriter.ml ilMeta.mli ilData.mli ilMetaTools.ml ilMetaDebug.ml ilMetaReader.ml
-
-all: native bytecode
-
-native: ilib.cmxa
-bytecode: ilib.cma
-
-ilib.cmxa: $(SRCS)
-	ocamlfind $(OCAMLOPT) -g -package extlib -safe-string -a -o ilib.cmxa $(SRCS)
-
-ilib.cma: $(SRCS)
-	ocamlfind $(OCAMLC) -g -package extlib -safe-string -a -o ilib.cma $(SRCS)
-
-dump: ilib.cmxa dump.ml peDataDebug.ml ilMetaDebug.ml
-	ocamlfind $(OCAMLOPT) -g -package extlib -safe-string -o dump ../extlib/extLib.cmxa ilib.cmxa peDataDebug.ml dump.ml
-
-clean:
-	rm -f ilib.cma ilib.cmxa ilib.lib ilib.a $(wildcard *.cmx) $(wildcard *.cmo) $(wildcard *.obj) $(wildcard *.o) $(wildcard *.cmi) dump
-
-.PHONY: all bytecode native clean
-
-Makefile: ;
-$(SRCS): ;

libs/ilib/dump.ml

@@ -1,38 +0,0 @@
-open PeDataDebug;;
-open PeData;;
-open PeReader;;
-open Printf;;
-open IlData;;
-open IlMetaTools;;
-open IlMetaDebug;;
-
-let main () =
-	if Array.length Sys.argv <> 2 then
-		print_endline "Usage: dump <exe-path>"
-	else begin
-		let r = create_r (open_in Sys.argv.(1)) PMap.empty in
-		let ctx = read r in
-		let pe = ctx.pe_header in
-		print_endline (coff_header_s pe.pe_coff_header);
-		print_endline (pe_header_s pe);
-		let idata = read_idata ctx in
-		List.iter (fun t -> print_endline (idata_table_s t)) idata;
-		let clr_header = read_clr_header ctx in
-		print_endline (clr_header_s (clr_header));
-		let cache = IlMetaReader.create_cache () in
-		let meta = IlMetaReader.read_meta_tables ctx clr_header cache in
-		Hashtbl.iter (fun path _ ->
-			print_endline ("\n\nclass " ^ path_s path ^ ": ");
-			let cls = convert_class meta path in
-			List.iter (fun t -> printf "%d: <%s> " t.tnumber (if t.tname = None then "_" else Option.get t.tname)) cls.ctypes;
-			printf "\n\tis nested: %s - %s\n" (string_of_bool (cls.cenclosing <> None)) (if cls.cenclosing = None then "None" else path_s (Option.get cls.cenclosing));
-			print_endline "\tfields:";
-			List.iter (fun f -> printf "\t\t%s : %s\n" f.fname (ilsig_s f.fsig.ssig)) cls.cfields;
-			print_endline "\tmethods:";
-			List.iter (fun m -> printf "\t\t%s : %s\n" m.mname (ilsig_s m.msig.ssig)) cls.cmethods;
-			print_endline "\tprops:";
-			List.iter (fun p -> printf "\t\t%s : %s\n" p.pname (ilsig_s p.psig.ssig)) cls.cprops;
-		) meta.il_typedefs
-	end;;
-
-main()

libs/ilib/dune

@@ -1,9 +0,0 @@
-(include_subdirs no)
-
-(library
-	(name ilib)
-	(modules_without_implementation ilData ilMeta)
-	(modules (:standard \ dump))
-	(libraries extlib)
-	(wrapped false)
-)

libs/ilib/ilData.mli

@@ -1,115 +0,0 @@
-(*
- *  This file is part of ilLib
- *  Copyright (c)2004-2013 Haxe Foundation
- *
- *  This program is free software; you can redistribute it and/or modify
- *  it under the terms of the GNU General Public License as published by
- *  the Free Software Foundation; either version 2 of the License, or
- *  (at your option) any later version.
- *
- *  This program is distributed in the hope that it will be useful,
- *  but WITHOUT ANY WARRANTY; without even the implied warranty of
- *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- *  GNU General Public License for more details.
- *
- *  You should have received a copy of the GNU General Public License
- *  along with this program; if not, write to the Free Software
- *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
- *)
-open IlMeta;;
-
-type ilpath = string list * string list * string
-
-type ilsig = IlMeta.ilsig
-
-and ilsig_norm =
-	| LVoid | LBool | LChar
-	| LInt8 | LUInt8 | LInt16
-	| LUInt16 | LInt32 | LUInt32
-	| LInt64 | LUInt64 | LFloat32
-	| LFloat64 | LString | LObject
-	| LPointer of ilsig_norm
-	| LTypedReference | LIntPtr | LUIntPtr
-	| LManagedPointer of ilsig_norm
-	| LValueType of ilpath * ilsig_norm list
-	| LClass of ilpath * ilsig_norm list
-	| LTypeParam of int
-	| LMethodTypeParam of int
-	| LVector of ilsig_norm
-	| LArray of ilsig_norm * (int option * int option) array
-	| LMethod of callconv list * ilsig_norm * (ilsig_norm list)
-	| LSentinel
-
-and ilsig_t = {
-	snorm : ilsig_norm;
-	ssig : ilsig;
-}
-
-type ilversion = int * int (* minor + major *)
-
-type ilclass = {
-	cpath : ilpath;
-	cflags : type_def_flags;
-	csuper : ilsig_t option;
-	cfields : ilfield list;
-	cmethods : ilmethod list;
-	cimplements : ilsig_t list;
-	ctypes : type_param list;
-	cprops : ilprop list;
-	cevents : ilevent list;
-	(* cevents :  *)
-	cenclosing : ilpath option;
-	cnested : ilpath list;
-  cattrs : meta_custom_attribute list;
-}
-
-and type_param = {
-	tnumber : int;
-	tflags : generic_flags;
-	tname : string option;
-	tconstraints : ilsig_t list;
-}
-
-and ilevent = {
-	ename : string;
-	eflags : event_flags;
-	eadd : (string * method_flags) option;
-	eremove : (string * method_flags) option;
-	eraise : (string * method_flags) option;
-	esig : ilsig_t;
-}
-
-and ilfield = {
-	fname : string;
-	fflags : field_flags;
-	fsig : ilsig_t;
-  fconstant : constant option;
-}
-
-and ilmethod = {
-	mname : string;
-	mflags : method_flags;
-	msig : ilsig_t;
-	margs : ilmethod_arg list;
-	mret : ilsig_t;
-	moverride : (ilpath * string) option; (* method_impl *)
-		(* refers to the signature of the declaring class *)
-	mtypes : type_param list;
-  msemantics : semantic_flags;
-}
-
-and ilmethod_arg = string * param_flags * ilsig_t
-
-and ilprop = {
-	pname : string;
-	psig : ilsig_t;
-	pflags : property_flags;
-	pget : (string * method_flags) option;
-	pset : (string * method_flags) option;
-}
-
-type ilctx = {
-	il_tables : (clr_meta DynArray.t) array;
-	il_relations : (meta_pointer, clr_meta) Hashtbl.t;
-	il_typedefs : (ilpath, meta_type_def) Hashtbl.t;
-}

libs/ilib/ilMeta.mli

@@ -1,1204 +0,0 @@
-(*
- *  This file is part of ilLib
- *  Copyright (c)2004-2013 Haxe Foundation
- *
- *  This program is free software; you can redistribute it and/or modify
- *  it under the terms of the GNU General Public License as published by
- *  the Free Software Foundation; either version 2 of the License, or
- *  (at your option) any later version.
- *
- *  This program is distributed in the hope that it will be useful,
- *  but WITHOUT ANY WARRANTY; without even the implied warranty of
- *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- *  GNU General Public License for more details.
- *
- *  You should have received a copy of the GNU General Public License
- *  along with this program; if not, write to the Free Software
- *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
- *)
-
-open PeData;;
-
-(* useful types for describing CLI metadata *)
-type guid = string
-	(* reference from the #GUID stream *)
-type stringref = string
-	(* reference from the #Strings stream *)
-type blobref = string
-	(* reference from the #Blob stream *)
-type id = stringref
-	(* a stringref that references an identifier. *)
-	(* must begin with an alphabetic character, or the following characters: *)
-		(* #, $, @, _ *)
-	(* and continue with alphanumeric characters or one of the following: *)
-		(* ?, $, @, _, ` *)
-
-type ns = id list
-
-type rid = int
-	(* record id on a specified meta table *)
-
-type clr_meta_idx =
-	(* strongly-type each table index *)
-	| IModule | ITypeRef | ITypeDef | IFieldPtr
-	| IField | IMethodPtr | IMethod | IParamPtr
-	| IParam | IInterfaceImpl | IMemberRef | IConstant
-	| ICustomAttribute | IFieldMarshal | IDeclSecurity
-	| IClassLayout | IFieldLayout | IStandAloneSig
-	| IEventMap | IEventPtr | IEvent | IPropertyMap
-	| IPropertyPtr | IProperty | IMethodSemantics
-	| IMethodImpl | IModuleRef | ITypeSpec | IImplMap
-	| IFieldRVA | IENCLog | IENCMap | IAssembly
-	| IAssemblyProcessor | IAssemblyOS | IAssemblyRef
-	| IAssemblyRefProcessor | IAssemblyRefOS
-	| IFile | IExportedType | IManifestResource | INestedClass
-	| IGenericParam | IMethodSpec | IGenericParamConstraint
-	(* reserved metas *)
-	| IR0x2D | IR0x2E | IR0x2F
-	| IR0x30 | IR0x31 | IR0x32 | IR0x33 | IR0x34 | IR0x35 | IR0x36 | IR0x37 
-	| IR0x38 | IR0x39 | IR0x3A | IR0x3B | IR0x3C | IR0x3D | IR0x3E | IR0x3F
-	(* coded tokens *)
-	| ITypeDefOrRef | IHasConstant | IHasCustomAttribute
-	| IHasFieldMarshal | IHasDeclSecurity | IMemberRefParent
-	| IHasSemantics | IMethodDefOrRef | IMemberForwarded | IImplementation
-	| ICustomAttributeType | IResolutionScope | ITypeOrMethodDef
-
-type meta_pointer = clr_meta_idx * rid
-	(* generic reference to the meta table *)
-
-(* starting with all annotations of special coded types *)
-type type_def_or_ref = clr_meta
-and has_const = clr_meta
-and has_custom_attribute = clr_meta
-and has_field_marshal = clr_meta
-and has_decl_security = clr_meta
-and member_ref_parent = clr_meta
-and has_semantics = clr_meta
-and method_def_or_ref = clr_meta
-and member_forwarded = clr_meta
-and implementation = clr_meta
-and custom_attribute_type = clr_meta
-and resolution_scope = clr_meta
-and type_or_method_def = clr_meta
-
-and clr_meta =
-	| Module of meta_module
-		(* the current module descriptor *)
-	| TypeRef of meta_type_ref
-		(* class reference descriptors *)
-	| TypeDef of meta_type_def
-		(* class or interface definition descriptors *)
-	| FieldPtr of meta_field_ptr
-		(* a class-to-fields lookup table - does not exist in optimized metadatas *)
-	| Field of meta_field
-		(* field definition descriptors *)
-	| MethodPtr of meta_method_ptr
-		(* a class-to-methods lookup table - does not exist in optimized metadatas *)
-	| Method of meta_method
-		(* method definition descriptors *)
-	| ParamPtr of meta_param_ptr
-		(* a method-to-parameters lookup table - does not exist in optimized metadatas *)
-	| Param of meta_param
-		(* parameter definition descriptors *)
-	| InterfaceImpl of meta_interface_impl
-		(* interface implementation descriptors *)
-	| MemberRef of meta_member_ref
-		(* member (field or method) reference descriptors *)
-	| Constant of meta_constant
-		(* constant value that map the default values stored in the #Blob stream to *)
-		(* respective fields, parameters and properties *)
-	| CustomAttribute of meta_custom_attribute
-		(* custom attribute descriptors *)
-	| FieldMarshal of meta_field_marshal
-		(* field or parameter marshaling descriptors for managed/unmanaged interop *)
-	| DeclSecurity of meta_decl_security
-		(* security descriptors *)
-	| ClassLayout of meta_class_layout	
-		(* class layout descriptors that hold information about how the loader should lay out respective classes *)
-	| FieldLayout of meta_field_layout
-		(* field layout descriptors that specify the offset or oridnal of individual fields *)
-	| StandAloneSig of meta_stand_alone_sig
-		(* stand-alone signature descriptors. used in two capacities: *)
-		(* as composite signatures of local variables of methods *)
-		(* and as parameters of the call indirect (calli) IL instruction *)
-	| EventMap of meta_event_map
-		(* a class-to-events mapping table. exists also in optimized metadatas *)
-	| EventPtr of meta_event_ptr
-		(* an event map-to-events lookup table - does not exist in optimized metadata *)
-	| Event of meta_event
-		(* event descriptors *)
-	| PropertyMap of meta_property_map
-		(* a class-to-properties mapping table. exists also in optimized metadatas *)
-	| PropertyPtr of meta_property_ptr
-		(* a property map-to-properties lookup table - does not exist in optimized metadata *)
-	| Property of meta_property
-		(* property descriptors *)
-	| MethodSemantics of meta_method_semantics
-		(* method semantics descriptors that hold information about which method is associated *)
-		(* with a specific property or event and in what capacity *)
-	| MethodImpl of meta_method_impl
-		(* method implementation descriptors *)
-	| ModuleRef of meta_module_ref
-		(* module reference descriptors *)
-	| TypeSpec of meta_type_spec
-		(* Type specification descriptors *)
-	| ImplMap of meta_impl_map
-		(* implementation map descriptors used for platform invocation (P/Invoke) *)
-	| FieldRVA of meta_field_rva
-		(* field-to-data mapping descriptors *)
-	| ENCLog of meta_enc_log
-		(* edit-and-continue log descriptors that hold information about what changes *)
-		(* have been made to specific metadata items during in-memory editing *)
-		(* this table does not exist on optimized metadata *)
-	| ENCMap of meta_enc_map
-		(* edit-and-continue mapping descriptors. does not exist on optimized metadata *)
-	| Assembly of meta_assembly
-		(* the current assembly descriptor, which should appear only in the prime module metadata *)
-	| AssemblyProcessor of meta_assembly_processor | AssemblyOS of meta_assembly_os
-		(* unused *)
-	| AssemblyRef of meta_assembly_ref
-		(* assembly reference descriptors *)
-	| AssemblyRefProcessor of meta_assembly_ref_processor | AssemblyRefOS of meta_assembly_ref_os
-		(* unused *)
-	| File of meta_file
-		(* file descriptors that contain information about other files in the current assembly *)
-	| ExportedType of meta_exported_type
-		(* exported type descriptors that contain information about public classes *)
-		(* exported by the current assembly, which are declared in other modules of the assembly *)
-		(* only the prime module of the assembly should carry this table *)
-	| ManifestResource of meta_manifest_resource
-		(* managed resource descriptors *)
-	| NestedClass of meta_nested_class
-		(* nested class descriptors that provide mapping of nested classes to their respective enclosing classes *)
-	| GenericParam of meta_generic_param
-		(* type parameter descriptors for generic classes and methods *)
-	| MethodSpec of meta_method_spec
-		(* generic method instantiation descriptors *)
-	| GenericParamConstraint of meta_generic_param_constraint
-		(* descriptors of constraints specified for type parameters of generic classes and methods *)
-	| UnknownMeta of int
-
-(* all fields here need to be mutable, as they will first be initialized empty *)
-
-and meta_root = {
-	root_id : int;
-}
-
-and meta_root_ptr = {
-	ptr_id : int;
-	ptr_to : meta_root;
-}
-
-and meta_module = {
-	mutable md_id : int;
-	mutable md_generation : int;
-	mutable md_name : id;
-	mutable md_vid : guid;
-	mutable md_encid : guid;
-	mutable md_encbase_id : guid;
-}
-
-and meta_type_ref = {
-	mutable tr_id : int;
-	mutable tr_resolution_scope : resolution_scope;
-	mutable tr_name : id;
-	mutable tr_namespace : ns;
-}
-
-and meta_type_def = {
-	mutable td_id : int;
-	mutable td_flags : type_def_flags;
-	mutable td_name : id;
-	mutable td_namespace : ns;
-	mutable td_extends : type_def_or_ref option;
-	mutable td_field_list : meta_field list;
-	mutable td_method_list : meta_method list;
-
-	(* extra field *)
-	mutable td_extra_enclosing : meta_type_def option;
-}
-
-and meta_field_ptr = {
-	mutable fp_id : int;
-	mutable fp_field : meta_field;
-}
-
-and meta_field = {
-	mutable f_id : int;
-	mutable f_flags : field_flags;
-	mutable f_name : id;
-	mutable f_signature : ilsig;
-}
-
-and meta_method_ptr = {
-	mutable mp_id : int;
-	mutable mp_method : meta_method;
-}
-
-and meta_method = {
-	mutable m_id : int;
-	mutable m_rva : rva;
-	mutable m_flags : method_flags;
-	mutable m_name : id;
-	mutable m_signature : ilsig;
-	mutable m_param_list : meta_param list; (* rid: Param *)
-
-	(* extra field *)
-	mutable m_declaring : meta_type_def option;
-}
-
-and meta_param_ptr = {
-	mutable pp_id : int;
-	mutable pp_param : meta_param;
-}
-
-and meta_param = {
-	mutable p_id : int;
-	mutable p_flags : param_flags;
-	mutable p_sequence : int;
-		(* 0 means return value *)
-	mutable p_name : id;
-}
-
-and meta_interface_impl = {
-	mutable ii_id : int;
-	mutable ii_class : meta_type_def; (* TypeDef rid *)
-	mutable ii_interface : type_def_or_ref;
-}
-
-and meta_member_ref = {
-	mutable memr_id : int;
-	mutable memr_class : member_ref_parent;
-	mutable memr_name : id;
-	mutable memr_signature : ilsig;
-}
-
-and meta_constant = {
-	mutable c_id : int;
-	mutable c_type : constant_type;
-	mutable c_parent : has_const;
-	mutable c_value : constant;
-}
-
-and named_attribute = bool * string * instance (* is_property * name * instance *)
-
-and meta_custom_attribute = {
-	mutable ca_id : int;
-	mutable ca_parent : has_custom_attribute;
-	mutable ca_type : custom_attribute_type;
-	mutable ca_value : (instance list * named_attribute list) option;
-		(* can be 0 *)
-}
-
-and meta_field_marshal = {
-	mutable fm_id : int;
-	mutable fm_parent : has_field_marshal;
-	mutable fm_native_type : nativesig;
-}
-
-and meta_decl_security = {
-	mutable ds_id : int;
-	mutable ds_action : action_security;
-	mutable ds_parent : has_decl_security;
-	mutable ds_permission_set : blobref;
-		(* an xml with the permission set *)
-}
-
-and meta_class_layout = {
-	mutable cl_id : int;
-	mutable cl_packing_size : int;
-		(* power of two; from 1 through 128 *)
-	mutable cl_class_size : int;
-	mutable cl_parent : meta_type_def; (* TypeDef rid *)
-}
-
-and meta_field_layout = {
-	mutable fl_id : int;
-	mutable fl_offset : int;
-		(* offset in bytes or ordinal *)
-	mutable fl_field : meta_field; (* Field rid *)
-}
-
-and meta_stand_alone_sig = {
-	mutable sa_id : int;
-	mutable sa_signature : ilsig;
-}
-
-and meta_event_map = {
-	mutable em_id : int;
-	mutable em_parent : meta_type_def; (* TypeDef rid *)
-	mutable em_event_list : meta_event list; (* Event rid *)
-}
-
-and meta_event_ptr = {
-	mutable ep_id : int;
-	mutable ep_event : meta_event; (* Event rid *)
-}
-
-and meta_event = {
-	mutable e_id : int;
-	mutable e_flags : event_flags;
-	mutable e_name : stringref;
-	mutable e_event_type : type_def_or_ref;
-}
-
-and meta_property_map = {
-	mutable pm_id : int;
-	mutable pm_parent : meta_type_def; (* TypeDef rid *)
-	mutable pm_property_list : meta_property list; (* Property rid *)
-}
-
-and meta_property_ptr = {
-	mutable prp_id : int;
-	mutable prp_property : meta_property; (* Property rid *)
-}
-
-and meta_property = {
-	mutable prop_id : int;
-	mutable prop_flags : property_flags;
-	mutable prop_name : stringref;
-	mutable prop_type : ilsig;
-}
-
-and meta_method_semantics = {
-	mutable ms_id : int;
-	mutable ms_semantic : semantic_flags;
-	mutable ms_method : meta_method; (* Method rid *)
-	mutable ms_association : has_semantics;
-}
-
-and meta_method_impl = {
-	mutable mi_id : int;
-	mutable mi_class : meta_type_def; (* TypeDef rid *)
-	mutable mi_method_body : method_def_or_ref;
-		(* overriding method *)
-	mutable mi_method_declaration : method_def_or_ref;
-		(* overridden method *)
-}
-
-and meta_module_ref = {
-	mutable modr_id : int;
-	mutable modr_name : stringref;
-}
-
-and meta_type_spec = {
-	mutable ts_id : int;
-	mutable ts_signature : ilsig;
-}
-
-(* reserved ? *)
-and meta_enc_log = {
-	mutable el_id : int;
-	mutable el_token : to_det;
-	mutable el_func_code : to_det;
-}
-
-and meta_impl_map = {
-	mutable im_id : int;
-	mutable im_flags : impl_flags; (* mapping_flags *)
-	mutable im_forwarded : member_forwarded; (* method only *)
-	mutable im_import_name : stringref;
-	mutable im_import_scope : meta_module_ref; (* ModuleRef rid *)
-}
-
-(* reserved ? *)
-and meta_enc_map = {
-	mutable encm_id : int;
-	mutable encm_token : to_det;
-}
-
-and meta_field_rva = {
-	mutable fr_id : int;
-	mutable fr_rva : rva;
-	mutable fr_field : meta_field; (* Field rid *)
-}
-
-and meta_assembly = {
-	mutable a_id : int;
-	mutable a_hash_algo : hash_algo;
-	mutable a_major : int;
-	mutable a_minor : int;
-	mutable a_build : int;
-	mutable a_rev : int;
-	mutable a_flags : assembly_flags; (* assembly_flags *)
-	mutable a_public_key : blobref;
-	mutable a_name : stringref;
-	mutable a_locale : stringref;
-}
-
-(* unused *)
-and meta_assembly_processor = {
-	mutable ap_id : int;
-	mutable ap_processor : to_det;
-}
-
-(* unused *)
-and meta_assembly_os = {
-	mutable aos_id : int;
-	mutable aos_platform_id : to_det;
-	mutable aos_major_version : to_det;
-	mutable aos_minor_version : to_det;
-}
-
-and meta_assembly_ref = {
-	mutable ar_id : int;
-	mutable ar_major : int;
-	mutable ar_minor : int;
-	mutable ar_build : int;
-	mutable ar_rev : int;
-	mutable ar_flags : assembly_flags;
-	mutable ar_public_key : blobref;
-	mutable ar_name : stringref; (* no path, no extension *)
-	mutable ar_locale : stringref;
-	mutable ar_hash_value : blobref;
-}
-
-(* unused *)
-and meta_assembly_ref_processor = {
-	mutable arp_id : int;
-	mutable arp_processor : to_det;
-	mutable arp_assembly_ref : meta_assembly_ref; (* AssemblyRef rid *)
-}
-
-(* unused *)
-and meta_assembly_ref_os = {
-	mutable aros_id : int;
-	mutable aros_platform_id : to_det;
-	mutable aros_major : int;
-	mutable aros_minor : int;
-	mutable aros_assembly_ref : meta_assembly_ref; (* AssemblyRef rid *)
-}
-
-and meta_file = {
-	mutable file_id : int;
-	mutable file_flags : file_flag; (* file_flags *)
-	mutable file_name : stringref; (* no path; only file name *)
-	mutable file_hash_value : blobref;
-}
-
-and meta_exported_type = {
-	mutable et_id : int;
-	mutable et_flags : type_def_flags;
-	mutable et_type_def_id : int;
-		(* TypeDef token in another module *)
-	mutable et_type_name : stringref;
-	mutable et_type_namespace : ns;
-	mutable et_implementation : implementation;
-}
-
-and meta_manifest_resource = {
-	mutable mr_id : int;
-	mutable mr_offset : int;
-	mutable mr_flags : manifest_resource_flag; (* manifest_resource_flags *)
-	mutable mr_name : stringref;
-	mutable mr_implementation : implementation option;
-}
-
-and meta_nested_class = {
-	mutable nc_id : int;
-	mutable nc_nested : meta_type_def; (* TypeDef rid *)
-	mutable nc_enclosing : meta_type_def; (* TypeDef rid *)
-}
-
-and meta_generic_param = {
-	mutable gp_id : int;
-	mutable gp_number : int; (* ordinal *)
-	mutable gp_flags : generic_flags;
-	mutable gp_owner : type_or_method_def;
-		(* generic type or method *)
-	mutable gp_name : stringref option;
-}
-
-and meta_method_spec = {
-	mutable mspec_id : int;
-	mutable mspec_method : method_def_or_ref;
-		(* instantiated method *)
-	mutable mspec_instantiation : ilsig;
-		(* instantiated signature *)
-}
-
-and meta_generic_param_constraint = {
-	mutable gc_id : int;
-	mutable gc_owner : meta_generic_param; (* GenericParam rid *)
-		(* constrained parameter *)
-	mutable gc_constraint : type_def_or_ref;
-		(* type the parameter must extend or implement *)
-}
-
-and to_det = int
-
-and not_implemented = int
-
-and constant =
-	| IBool of bool
-	| IChar of int
-	| IByte of int
-	| IShort of int
-	| IInt of int32
-	| IInt64 of int64
-	| IFloat32 of float
-	| IFloat64 of float
-	| IString of string
-	| INull
-
-and instance =
-	| InstConstant of constant
-	| InstBoxed of instance
-	| InstType of string
-	| InstArray of instance list
-	| InstEnum of int
-
-and constant_type =
-	| CBool (* 0x2 *)
-	| CChar (* 0x3 *)
-	| CInt8 (* 0x4 *)
-	| CUInt8 (* 0x5 *)
-	| CInt16 (* 0x6 *)
-	| CUInt16 (* 0x7 *)
-	| CInt32 (* 0x8 *)
-	| CUInt32 (* 0x9 *)
-	| CInt64 (* 0xA *)
-	| CUInt64 (* 0xB *)
-	| CFloat32 (* 0xC *)
-	| CFloat64 (* 0xD *)
-	| CString (* 0xE *)
-	| CNullRef (* 0x12 *)
-		(* null object reference - the value of the constant *)
-		(* of this type must be a 4-byte integer containing 0 *)
-
-and type_def_vis =
-	(* visibility flags - mask 0x7 *)
-	| VPrivate (* 0x0 *)
-		(* type is not visible outside the assembly. default *)
-	| VPublic (* 0x1 *)
-		(* type visible outside the assembly *)
-	| VNestedPublic (* 0x2 *)
-		(* the nested type has public visibility *)
-	| VNestedPrivate (* 0x3 *)
-		(* nested type has private visibility - it's not visible outside the enclosing class *)
-	| VNestedFamily (* 0x4 *)
-		(* nested type has family visibility - it's visible to descendants of the enclosing class only *)
-	| VNestedAssembly (* 0x5 *)
-		(* nested type visible within the assembly only *)
-	| VNestedFamAndAssem (* 0x6 *)
-		(* nested type is visible to the descendants of the enclosing class residing in the same assembly *)
-	| VNestedFamOrAssem (* 0x7 *)
-		(* nested type is visible to the descendants of the enclosing class either within *)
-		(* or outside the assembly and to every type within the assembly *)
-	
-and type_def_layout =
-	(* layout flags - mask 0x18 *)
-	| LAuto (* 0x0 *)
-		(* type fields are laid out automatically *)
-	| LSequential (* 0x8 *)
-		(* loader must preserve the order of the instance fields *)
-	| LExplicit (* 0x10 *)
-		(* type layout is specified explicitly *)
-
-and type_def_semantics =
-	(* semantics flags - mask 0x5A0 *)
-	| SInterface (* 0x20 *)
-		(* type is an interface. If specified, the default parent is set to nil *)
-	| SAbstract (* 0x80 *)
-	| SSealed (* 0x100 *)
-	| SSpecialName (* 0x400 *)
-		(* type has a special name. how special depends on the name itself *)
-		(* e.g. .ctor or .cctor *)
-
-and type_def_impl =
-	(* type implementation flags - mask 0x103000 *)
-	| IImport (* 0x1000 *)
-		(* the type is imported from a COM type library *)
-	| ISerializable (* 0x2000 *)
-		(* the type can be serialized into sequential data *)
-	| IBeforeFieldInit (* 0x00100000 *)
-		(* the type can be initialized any time before the first access *)
-		(* to a static field. *)
-	
-and type_def_string =
-	(* string formatting flags - mask 0x00030000 *)
-	| SAnsi (* 0x0 *)
-		(* managed strings are marshaled to and from ANSI strings *)
-	| SUnicode (* 0x00010000 *)
-		(* managed strings are marshaled to and from UTF-16 *)
-	| SAutoChar (* 0x00020000 *)
-		(* marshaling is defined by the underlying platform *)
-
-and type_def_flags = {
-	tdf_vis : type_def_vis;
-	tdf_layout : type_def_layout;
-	tdf_semantics : type_def_semantics list;
-	tdf_impl : type_def_impl list;
-	tdf_string : type_def_string;
-}
-
-and field_access =
-	(* access flags - mask 0x07 *)
-	| FAPrivateScope (* 0x0 *)
-		(* default - exempt from the requirement of having a unique triad of owner, name and signature *)
-		(* so it must always be referenced by a FieldDef token and never by a MemberRef *)
-		(* privatescope fields are accessible from anywhere within the current module *)
-	| FAPrivate (* 0x1 *)
-		(* field is accessible from its owner and from classes nested in the field's owner. *)
-		(* global private fields are accessible from anywhere within current module *)
-	| FAFamAndAssem (* 0x2 *)
-		(* accessible from types belonging to the owner's family defined in the current assembly *)
-		(* family means the type itself and all its descendants *)
-	| FAAssembly (* 0x3 *)
-		(* accessible from types defined in the current assembly *)
-	| FAFamily (* 0x4 *)
-		(* accessible from the owner's family - defined in this or any other assembly *)
-	| FAFamOrAssem (* 0x5 *)
-		(* accessible from the owner's family and from all types defined in the current assembly *)
-	| FAPublic (* 0x6 *)
-		(* field is accessible from any type *)
-
-and field_contract =
-	(* contract flags - mask 0x02F0 *)
-	| CStatic (* 0x10 *)
-		(* static field. global fields must be static *)
-	| CInitOnly (* 0x20 *)
-		(* field can be initialized only and cannot be written to later. *)
-		(* Initialization takes place in an instance constructor (.ctor) for instance fields *)
-		(* and in a class constructor (.cctor) for static fields. *)
-		(* this flag is not enforced by the CLR *)
-	| CLiteral (* 0x40 *)
-		(* field is a compile-time constant. the loader does not lay out this field *)
-		(* and does not create an internal handle for it *)
-		(* it cannot be directly addressed from IL and can only be used as a Reflection reference *)
-	| CNotSerialized (* 0x80 *)
-		(* field is not serialized when the owner is remoted *)
-	| CSpecialName (* 0x200 *)
-		(* the field is special in some way, as defined by its name *)
-		(* example is the field value__ of an enumeration type *)
-
-and field_reserved = 
-	(* reserved flags - cannot be set explicitly. mask 0x9500 *)
-	| RSpecialName (* 0x400 *)
-		(* has a special name that is reserved for internal use of the CLR *)
-		(* two field names are reserved: value_, for instance fields in enumerations *)
-		(* and _Deleted* for fields marked for deletion but not actually removed from metadata *)
-	| RMarshal (* 0x1000 *)
-		(* The field has an associated FieldMarshal record specifying how the field must be *)
-		(* marshaled when consumed by unmanaged code. *)
-	| RConstant (* 0x8000 *)
-		(* field has an associated Constant record *)
-	| RFieldRVA (* 0x0100 *)
-		(* field is mapped to data and has an associated FieldRVA record *)
-
-and field_flags = {
-	ff_access : field_access;
-	ff_contract : field_contract list;
-	ff_reserved : field_reserved list;
-}
-
-and method_contract =
-	(* contract flags - mask 0xF0 *)
-	| CMStatic (* 0x10 *)
-	| CMFinal (* 0x20 *)
-		(* must be paired with the virtual flag - otherwise it is meaningless *)
-	| CMVirtual (* 0x40 *)
-	| CMHideBySig (* 0x80 *)
-		(* the method hides all methods of the parent classes that have a matching *)
-		(* signature and name (as opposed to having a matching name only). ignored by the CLR *)
-
-and method_vtable =
-	(* vtable flags - mask 0x300 *)
-	| VNewSlot (* 0x100 *)
-		(* a new vtable slot is created, so it doesn't override the old implementation *)
-	| VStrict (* 0x200 *)
-		(* virtual method can be overridden only if it is accessible from the overriding class *)
-
-and method_impl =
-	(* implementation flags - mask 0x2C08 *)
-	| IAbstract (* 0x0400 *)
-	| ISpecialName (* 0x0800 *)
-	| IPInvokeImpl (* 0x2000 *)
-		(* the method has an unmanaged implementation and is called through the platform *)
-		(* invocation mechanism. the rva field must be 0, since the method is implemented externally *)
-	| IUnmanagedExp (* 0x0008 *)
-		(* the managed method is exposed as an unmanaged export. not used by the CLR currently *)
-
-and method_reserved =
-	(* reserved flags - cannot be set explicitly. mask 0xD000 *)
-	| RTSpecialName (* 0x1000 *)
-		(* has a special name: .ctor, .cctor, _VtblGap* and _Deleted* *)
-	| RHasSecurity (* 0x4000 *)
-		(* either has an associated DeclSecurity metadata or the custom attribte *)
-		(* System.Security.SuppressUnmanagedCodeSecurityAttribute *)
-	| RReqSecObj (* 0x8000 *)
-		(* this method calls another method containing security code, so it requires *)
-		(* an additional stack slot for a security object. *)
-
-and method_code_type =
-	(* code type - mask 0x3 *)
-	| CCil (* 0x0 *)
-	| CNative (* 0x1 *)
-		(* implemented in native platform-specific code *)
-	| COptIl (* 0x2 *)
-		(* optimized il - not supported; must not be set *)
-	| CRuntime (* 0x3 *)
-		(* automatically generated by the runtime itself (intrinsic) *)
-
-and method_code_mngmt =
-	(* code management - mask 0x4 *)
-	| MManaged (* 0x0 *)
-	| MUnmanaged (* 0x4 *)
-		(* must be paired with the native flag *)
-
-and method_interop =
-	(* method implementation and interop - mask 0x10D8 *)
-	| OForwardRef (* 0x10 *)
-		(* managed object fiels and edit-and-continue scenarios only *)
-	| OPreserveSig (* 0x80 *)
-		(* method signature must not be mangled during interop with classic COM code *)
-	| OInternalCall (* 0x1000 *)
-		(* reserved for internal use. if set, RVA must be 0 *)
-	| OSynchronized (* 0x20 *)
-		(* automatically insert code to take a lock on entry to the method and release it *)
-		(* on exit from the method. Value types cannot have this flag set *)
-	| ONoInlining (* 0x08 *)
-		(* the runtime is not allowed to inline the method *)
-
-and method_flags = {
-	mf_access : field_access;
-	mf_contract : method_contract list;
-	mf_vtable : method_vtable list;
-	mf_impl : method_impl list;
-	mf_reserved : method_reserved list;
-	mf_code_type : method_code_type;
-	mf_code_mngmt : method_code_mngmt;
-	mf_interop : method_interop list;
-}
-
-and param_io =
-	(* input/output flags - mask 0x13 *)
-	| PIn (* 0x1 *)
-	| POut (* 0x2 *)
-	| POpt (* 0x10 *)
-
-and param_reserved =
-	(* reserved flags - mask 0xF000 *)
-	| PHasConstant (* 0x1000 *)
-		(* the parameter has an associated Constant record *)
-	| PMarshal (* 0x2000 *)
-		(* the parameter has an associated FieldMarshal record specifying how the parameter *)
-		(* must be marshaled when consumed by unmanaged code *)
-
-and param_flags = {
-	pf_io : param_io list;
-	pf_reserved : param_reserved list;
-}
-
-and event_flag =
-	| ESpecialName (* 0x0200 *)
-		(* event is special *)
-	| ERTSpecialName (* 0x0400 *)
-		(* CLI provides special behavior, depending on the name of the event *)
-
-and event_flags = event_flag list
-
-and property_flag =
-	| PSpecialName (* 0x0200 *)
-		(* property is special *)
-	| PRTSpecialName (* 0x0400 *)
-		(* runtime (intrinsic) should check name encoding *)
-	| PHasDefault (* 0x1000 *)
-		(* property has default *)
-	| PUnused (* 0xE9FF *)
-		(* reserved *)
-
-and property_flags = property_flag list
-
-and semantic_flag =
-	| SSetter (* 0x0001 *)
-		(* setter for property *)
-	| SGetter (* 0x0002 *)
-		(* getter for property *)
-	| SOther (* 0x0004 *)
-		(* other method for property or event *)
-	| SAddOn (* 0x0008 *)
-		(* addon method for event - refers to the required add_ method for events *)
-	| SRemoveOn (* 0x0010 *)
-		(* removeon method for event - refers to the required remove_ method for events *)
-	| SFire (* 0x0020 *)
-		(* fire method for event. this refers to the optional raise_ method for events *)
-
-and semantic_flags = semantic_flag list
-
-and action_security =
-	| SecNull
-	| SecRequest (* 0x1 *)
-	| SecDemand (* 0x2 *)
-	| SecAssert (* 0x3 *)
-	| SecDeny (* 0x4 *)
-	| SecPermitOnly (* 0x5 *)
-	| SecLinkCheck (* 0x6 *)
-	| SecInheritCheck (* 0x7 *)
-	| SecReqMin (* 0x8 *)
-	| SecReqOpt (* 0x9 *)
-	| SecReqRefuse (* 0xA *)
-	| SecPreJitGrant (* 0xB *)
-	| SecPreJitDeny (* 0xC *)
-	| SecNonCasDemand (* 0xD *)
-	| SecNonCasLinkDemand (* 0xE *)
-	| SecNonCasInheritance (* 0xF *)
-
-and impl_charset =
-	| IDefault (* 0x0 *)
-	| IAnsi (* 0x2 *)
-		(* method parameters of type string must be marshaled as ANSI zero-terminated *)
-		(* strings unless explicitly specified otherwise *)
-	| IUnicode (* 0x4 *)
-		(* method parameters of type string must be marshaled as Unicode strings *)
-	| IAutoChar (* 0x6 *)
-		(* method parameters of type string must be marshaled as ANSI or Unicode strings *)
-		(* depending on the platform *)
-
-and impl_callconv =
-	| IDefaultCall (* 0x0 *)
-	| IWinApi (* 0x100 *)
-		(* the native method uses the calling convention standard for the underlying platform *)
-	| ICDecl (* 0x200 *)
-		(* the native method uses the C/C++ style calling convention *)
-	| IStdCall (* 0x300 *)
-		(* native method uses the standard Win32 API calling convention *)
-	| IThisCall (* 0x400 *)
-		(* native method uses the C++ member method (non-vararg) calling convention *)
-	| IFastCall (* 0x500 *)
-
-and impl_flag =
-	| INoMangle (* 0x1 *)
-		(* exported method's name must be matched literally *)
-	| IBestFit (* 0x10 *)
-		(* allow "best fit" guessing when converting the strings *)
-	| IBestFitOff (* 0x20 *)
-		(* disallow "best fit" guessing *)
-	| ILastErr (* 0x40 *)
-		(* the native method supports the last error querying by the Win32 API GetLastError *)
-	| ICharMapError (* 0x1000 *)
-		(* throw an exception when an unmappable character is encountered in a string *)
-	| ICharMapErrorOff (* 0x2000 *)
-		(* don't throw an exception when an unmappable character is encountered *)
-	
-and impl_flags = {
-	if_charset : impl_charset;
-	if_callconv : impl_callconv;
-	if_flags : impl_flag list;
-}
-
-and hash_algo =
-	| HNone (* 0x0 *)
-	| HReserved (* 0x8003 *)
-		(* MD5 ? *)
-	| HSha1 (* 0x8004 *)
-		(* SHA1 *)
-
-and assembly_flag =
-	| APublicKey (* 0x1 *)
-		(* assembly reference holds the full (unhashed) public key *)
-	| ARetargetable (* 0x100 *)
-		(* implementation of this assembly used at runtime is not expected to match *)
-		(* the version seen at compile-time *)
-	| ADisableJitCompileOptimizer (* 0x4000 *)
-		(* Reserved *)
-	| AEnableJitCompileTracking (* 0x8000 *)
-		(* Reserved *)
-
-and assembly_flags = assembly_flag list
-
-and file_flag =
-	| ContainsMetadata (* 0x0 *)
-	| ContainsNoMetadata (* 0x1 *)
-
-and manifest_resource_flag =
-	(* mask 0x7 *)
-	| RNone (* 0x0 *)
-	| RPublic (* 0x1 *)
-	| RPrivate (* 0x2 *)
-
-and generic_variance =
-	(* mask 0x3 *)
-	| VNone (* 0x0 *)
-	| VCovariant (* 0x1 *)
-	| VContravariant (* 0x2 *)
-
-and generic_constraint =
-	(* mask 0x1C *)
-	| CInstanceType (* 0x4 *)
-		(* generic parameter has the special class constraint *)
-	| CValueType (* 0x8 *)
-		(* generic parameter has the special valuetype constraint *)
-	| CDefaultCtor (* 0x10 *)
-		(* has the special .ctor constraint *)
-
-and generic_flags = {
-	gf_variance : generic_variance;
-	gf_constraint : generic_constraint list;
-}
-
-and ilsig =
-	(* primitive types *)
-	| SVoid (* 0x1 *)
-	| SBool (* 0x2 *)
-	| SChar (* 0x3 *)
-	| SInt8 (* 0x4 *)
-	| SUInt8 (* 0x5 *)
-	| SInt16 (* 0x6 *)
-	| SUInt16 (* 0x7 *)
-	| SInt32 (* 0x8 *)
-	| SUInt32 (* 0x9 *)
-	| SInt64 (* 0xA *)
-	| SUInt64 (* 0xB *)
-	| SFloat32 (* 0xC *)
-	| SFloat64 (* 0xD *)
-	| SString (* 0xE *)
-	| SPointer of ilsig (* 0xF *)
-		(* unmanaged pointer to type ( * ) *)
-	| SManagedPointer of ilsig (* 0x10 *)
-		(* managed pointer to type ( & ) *)
-	| SValueType of type_def_or_ref (* 0x11 *)
-		(* a value type modifier, followed by TypeDef or TypeRef token *)
-	| SClass of type_def_or_ref (* 0x12 *)
-		(* a class type modifier, followed by TypeDef or TypeRef token *)
-	| STypeParam of int (* 0x13 *)
-		(* generic parameter in a generic type definition. represented by a number *)
-	| SArray of ilsig * (int option * int option) array (* 0x14 *)
-		(* ilsig * ( bound * size ) *)
-		(* a multi-dimensional array type modifier *)
-		(* encoded like: *)
-			(* SArray <underlying type><rank><num_sizes><size1>...<sizeN>
-			          <num_lower_bounds><lower_bound1>...<lower_boundM> *)
-			(* <rank> is the number of dimensions (K>0) *)
-			(* <num_sizes> num of specified sizes for dimensions (N <= K) *)
-			(* <num_lower_bounds> num of lower bounds (M <= K) *)
-			(* all int values are compressed *)
-	| SGenericInst of ilsig * (ilsig list) (* 0x15 *)
-		(* A generic type instantiation. encoded like: *)
-			(* SGenericInst <type> <type-arg-count> <type1>...<typeN> *)
-	| STypedReference (* 0x16 *)
-		(* typed reference, carrying both a reference to a type *)
-		(* and information identifying the referenced type *)
-	| SIntPtr (* 0x18 *)
-		(* pointer-sized managed integer *)
-	| SUIntPtr (* 0x19 *)
-		(* pointer-size managed unsigned integer *)
-	(* | SNativeFloat (* 0x1A *) *)
-		(* refer to http://stackoverflow.com/questions/13961205/native-float-type-usage-in-clr *)
-	| SFunPtr of callconv list * ilsig * (ilsig list) (* 0x1B *)
-		(* a pointer to a function, followed by full method signature *)
-	| SObject (* 0x1C *)
-		(* System.Object *)
-	| SVector of ilsig (* 0x1D *)
-		(* followed by the encoding of the underlying type *)
-	| SMethodTypeParam of int (* 0x1E *)
-		(* generic parameter in a generic method definition *)
-	| SReqModifier of type_def_or_ref * ilsig (* 0x1F *)
-		(* modreq: required custom modifier : indicate that the item to which they are attached *)
-		(* must be treated in a special way *)
-	| SOptModifier of type_def_or_ref * ilsig (* 0x20 *)
-		(* modopt: optional custom modifier *)
-	| SSentinel (* 0x41 *)
-		(* ... - signifies the beginning of optional arguments supplied for a vararg method call *)
-		(* This can only appear at call site, since varargs optional parameters are not specified *)
-		(* when a method is declared *)
-	| SPinned of ilsig (* 0x45 *)
-		(* pinned reference: it's only applicable to local variables only *)
-	(* special undocumented (yay) *)
-	| SType (* 0x50 *)
-	| SBoxed (* 0x51 *)
-	| SEnum of string (* 0x55 *)
-
-and callconv =
-	| CallDefault (* 0x0 *)
-	| CallCDecl (* 0x1 *)
-	| CallStdCall (* 0x2 *)
-	| CallThisCall (* 0x3 *)
-	| CallFastCall (* 0x4 *)
-	| CallVararg (* 0x5 *)
-	| CallField (* 0x6 *)
-		(* field call *)
-	| CallLocal (* 0x7 *)
-		(* local variable call *)
-	| CallProp (* 0x8 *)
-		(* property call *)
-	| CallUnmanaged (* 0x9 *)
-		(* unmanaged calling convention. not used *)
-	| CallGenericInst (* 0xA *)
-		(* generic instantiation - MethodSpec *)
-	| CallGeneric of int (* 0x10 *)
-		(* also contains the number of generic arguments *)
-	| CallHasThis (* 0x20 *)
-		(* instance method that has an instance pointer (this) *)
-		(* as an implicit first argument - ilasm 'instance' *)
-	| CallExplicitThis (* 0x40 *)
-		(* the first explicitly specified parameter is the instance pointer *)
-		(* ilasm 'explicit' *)
-	
-and nativesig =
-	| NVoid (* 0x01 *)
-		(* obsolete *)
-	| NBool (* 0x02 *)
-	| NInt8 (* 0x03 *)
-	| NUInt8 (* 0x4 *)
-	| NInt16 (* 0x5 *)
-	| NUInt16 (* 0x6 *)
-	| NInt32 (* 0x7 *)
-	| NUInt32 (* 0x8 *)
-	| NInt64 (* 0x9 *)
-	| NUInt64 (* 0xA *)
-	| NFloat32 (* 0xB *)
-	| NFloat64 (* 0xC *)
-	| NSysChar (* 0xD *)
-		(* obsolete *)
-	| NVariant (* 0xE *)
-		(* obsolete *)
-	| NCurrency (* 0xF *)
-	| NPointer (* 0x10 *)
-		(* obsolete - use NativeInt *)
-	| NDecimal (* 0x11 *)
-		(* obsolete *)
-	| NDate (* 0x12 *)
-		(* obsolete *)
-	| NBStr (* 0x13 *)
-		(* unicode VB-style: used in COM operations *)
-	| NLPStr (* 0x14 *)
-		(* pointer to a zero-terminated ANSI string *)
-	| NLPWStr (* 0x15 *)
-		(* pointer to a zero-terminated Unicode string *)
-	| NLPTStr (* 0x16 *)
-		(* pointer to a zero-terminated ANSI or Unicode string - depends on platform *)
-	| NFixedString of int (* 0x17 *)
-		(* fixed-size system string of size <size> bytes; applicable to field marshalling only *)
-	| NObjectRef (* 0x18 *)
-		(* obsolete *)
-	| NUnknown (* 0x19 *)
-		(* IUnknown interface pointer *)
-	| NDispatch (* 0x1A *)
-		(* IDispatch interface pointer *)
-	| NStruct (* 0x1B *)
-		(* C-style structure, for marshaling the formatted managed types *)
-	| NInterface (* 0x1C *)
-		(* interface pointer *)
-	| NSafeArray of variantsig (* 0x1D *)
-		(* safe array of type <variant-type> *)
-	| NFixedArray of int * variantsig (* 0x1E *)
-		(* fixed-size array, of size <size> bytes *)
-	| NIntPointer (* 0x1F *)
-		(* signed pointer-size integer *)
-	| NUIntPointer (* 0x20 *)
-		(* unsigned pointer-sized integer *)
-	| NNestedStruct (* 0x21 *)
-		(* obsolete *)
-	| NByValStr (* 0x22 *)
-		(* VB-style string in a fixed-length buffer *)
-	| NAnsiBStr (* 0x23 *)
-		(* ansi bstr - ANSI VB-style string *)
-	| NTBStr (* 0x24 *)
-		(* tbstr - bstr or ansi bstr, depending on the platform *)
-	| NVariantBool (* 0x25 *)
-		(* variant bool - 2-byte Boolean: true = -1; false = 0 *)
-	| NFunctionPtr (* 0x26 *)
-	| NAsAny (* 0x28 *)
-		(* as any - object: type defined at run time (?) *)
-	| NArray of nativesig * int * int * int (* 0x2A *)
-		(* fixed-size array of a native type *)
-		(* if size is empty, the size of the native array is derived from the size  *)
-		(* of the managed type being marshaled *)
-	| NLPStruct (* 0x2B *)
-		(* pointer to a c-style structure *)
-	| NCustomMarshaler of string * string (* 0x2C *)
-		(* custom (<class_str>, <cookie_str>) *)
-	| NError (* 0x2D *)
-		(* maps in32 to VT_HRESULT *)
-  | NCustom of int
-
-and variantsig =
-	| VT_EMPTY (* 0x00 *)
-		(* No <empty> *)
-	| VT_NULL (* 0x01 *)
-		(* No null *)
-	| VT_I2 (* 0x02 *)
-		(* Yes int16 *)
-	| VT_I4 (* 0x03 *)
-		(* Yes int32 *)
-	| VT_R4 (* 0x04 *)
-		(* Yes float32 *)
-	| VT_R8 (* 0x05 *)
-		(* Yes float64 *)
-	| VT_CY (* 0x06 *)
-		(* Yes currency *)
-	| VT_DATE (* 0x07 *)
-		(* Yes date *)
-	| VT_BSTR (* 0x08 *)
-		(* Yes bstr *)
-	| VT_DISPATCH (* 0x09 *)
-		(* Yes idispatch *)
-	| VT_ERROR (* 0x0A *)
-		(* Yes error *)
-	| VT_BOOL (* 0x0B *)
-		(* Yes bool *)
-	| VT_VARIANT (* 0x0C *)
-		(* Yes variant *)
-	| VT_UNKNOWN (* 0x0D *)
-		(* Yes iunknown *)
-	| VT_DECIMAL (* 0x0E *)
-		(* Yes decimal *)
-	| VT_I1 (* 0x10 *)
-		(* Yes int8 *)
-	| VT_UI1 (* 0x11 *)
-		(* Yes unsigned int8, uint8 *)
-	| VT_UI2 (* 0x12 *)
-		(* Yes unsigned int16, uint16 *)
-	| VT_UI4 (* 0x13 *)
-		(* Yes unsigned int32, uint32 *)
-	| VT_I8 (* 0x14 *)
-		(* No int64 *)
-	| VT_UI8 (* 0x15 *)
-		(* No unsigned int64, uint64 *)
-	| VT_INT (* 0x16 *)
-		(* Yes int *)
-	| VT_UINT (* 0x17 *)
-		(* Yes unsigned int, uint *)
-	| VT_VOID (* 0x18 *)
-		(* No void *)
-	| VT_HRESULT (* 0x19 *)
-		(* No hresult *)
-	| VT_PTR (* 0x1A *)
-		(* No * *)
-	| VT_SAFEARRAY (* 0x1B *)
-		(* No safearray *)
-	| VT_CARRAY (* 0x1C *)
-		(* No carray *)
-	| VT_USERDEFINED (* 0x1D *)
-		(* No userdefined *)
-	| VT_LPSTR (* 0x1E *)
-		(* No lpstr *)
-	| VT_LPWSTR (* 0x1F *)
-		(* No lpwstr *)
-	| VT_RECORD (* 0x24 *)
-		(* Yes record *)
-	| VT_FILETIME (* 0x40 *)
-		(* No filetime *)
-	| VT_BLOB (* 0x41 *)
-		(* No blob *)
-	| VT_STREAM (* 0x42 *)
-		(* No stream *)
-	| VT_STORAGE (* 0x43 *)
-		(* No storage *)
-	| VT_STREAMED_OBJECT (* 0x44 *)
-		(* No streamed_object *)
-	| VT_STORED_OBJECT (* 0x45 *)
-		(* No stored_object *)
-	| VT_BLOB_OBJECT (* 0x46 *)
-		(* No blob_object *)
-	| VT_CF (* 0x47 *)
-		(* No cf *)
-	| VT_CLSID (* 0x48 *)
-		(* No clsid *)
-	(* | VT_VECTOR of variantsig (* 0x1000 *) *)
-	(* 	(* Yes <v_type> vector *) *)
-	(* | VT_ARRAY of variantsig (* 0x2000 *) *)
-	(* 	(* Yes <v_type> [ ] *) *)
-	(* | VT_BYREF of variantsig (* 0x4000 *) *)
-	(* 	(* Yes <v_type> & *) *)

libs/ilib/ilMetaDebug.ml

@@ -1,24 +0,0 @@
-(*
- *  This file is part of ilLib
- *  Copyright (c)2004-2013 Haxe Foundation
- *
- *  This program is free software; you can redistribute it and/or modify
- *  it under the terms of the GNU General Public License as published by
- *  the Free Software Foundation; either version 2 of the License, or
- *  (at your option) any later version.
- *
- *  This program is distributed in the hope that it will be useful,
- *  but WITHOUT ANY WARRANTY; without even the implied warranty of
- *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- *  GNU General Public License for more details.
- *
- *  You should have received a copy of the GNU General Public License
- *  along with this program; if not, write to the Free Software
- *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
- *)
-open IlMeta;;
-open IlMetaTools;;
-
-let path_s = IlMetaTools.path_s
-let ilsig_s = IlMetaTools.ilsig_s
-let instance_s = IlMetaTools.instance_s

libs/ilib/ilMetaReader.ml

@@ -1,2406 +0,0 @@
-(*
- *  This file is part of ilLib
- *  Copyright (c)2004-2013 Haxe Foundation
- *
- *  This program is free software; you can redistribute it and/or modify
- *  it under the terms of the GNU General Public License as published by
- *  the Free Software Foundation; either version 2 of the License, or
- *  (at your option) any later version.
- *
- *  This program is distributed in the hope that it will be useful,
- *  but WITHOUT ANY WARRANTY; without even the implied warranty of
- *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- *  GNU General Public License for more details.
- *
- *  You should have received a copy of the GNU General Public License
- *  along with this program; if not, write to the Free Software
- *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
- *)
-
-open PeData;;
-open PeReader;;
-open IlMeta;;
-open IO;;
-open Printf;;
-open IlMetaTools;;
-open ExtString;;
-open IlData;;
-
-(* *)
-let get_field = function
-	| Field f -> f
-	| _ -> assert false
-
-let get_method = function
-	| Method m -> m
-	| _ -> assert false
-
-let get_param = function
-	| Param p -> p
-	| _ -> assert false
-
-let get_type_def = function
-	| TypeDef p -> p
-	| _ -> assert false
-
-let get_event = function
-	| Event e -> e
-	| _ -> assert false
-
-let get_property = function
-	| Property p -> p
-	| _ -> assert false
-
-let get_module_ref = function
-	| ModuleRef r -> r
-	| _ -> assert false
-
-let get_assembly_ref = function
-	| AssemblyRef r -> r
-	| _ -> assert false
-
-let get_generic_param = function
-	| GenericParam p -> p
-	| _ -> assert false
-
-(* decoding helpers *)
-let type_def_vis_of_int i = match i land 0x7 with
-	(* visibility flags - mask 0x7 *)
-	| 0x0 -> VPrivate (* 0x0 *)
-	| 0x1 -> VPublic (* 0x1 *)
-	| 0x2 -> VNestedPublic (* 0x2 *)
-	| 0x3 -> VNestedPrivate (* 0x3 *)
-	| 0x4 -> VNestedFamily (* 0x4 *)
-	| 0x5 -> VNestedAssembly (* 0x5 *)
-	| 0x6 -> VNestedFamAndAssem (* 0x6 *)
-	| 0x7 -> VNestedFamOrAssem (* 0x7 *)
-	| _ -> assert false
-
-let type_def_layout_of_int i = match i land 0x18 with
-	(* layout flags - mask 0x18 *)
-	| 0x0 -> LAuto (* 0x0 *)
-	| 0x8 -> LSequential (* 0x8 *)
-	| 0x10 -> LExplicit (* 0x10 *)
-	| _ -> assert false
-
-let type_def_semantics_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		(* semantics flags - mask 0x5A0 *)
-		| 0x20 -> SInterface (* 0x20 *)
-		| 0x80 -> SAbstract (* 0x80 *)
-		| 0x100 -> SSealed (* 0x100 *)
-		| 0x400 -> SSpecialName (* 0x400 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x20;0x80;0x100;0x400]
-
-let type_def_impl_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		(* type implementation flags - mask 0x103000 *)
-		| 0x1000 -> IImport (* 0x1000 *)
-		| 0x2000 -> ISerializable (* 0x2000 *)
-		| 0x00100000 -> IBeforeFieldInit (* 0x00100000 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x1000;0x2000;0x00100000]
-
-let type_def_string_of_int i = match i land 0x00030000 with
-	(* string formatting flags - mask 0x00030000 *)
-	| 0x0 -> SAnsi (* 0x0 *)
-	| 0x00010000 -> SUnicode (* 0x00010000 *)
-	| 0x00020000 -> SAutoChar (* 0x00020000 *)
-	| _ -> assert false
-
-let type_def_flags_of_int i =
-	{
-		tdf_vis = type_def_vis_of_int i;
-		tdf_layout = type_def_layout_of_int i;
-		tdf_semantics = type_def_semantics_of_int i;
-		tdf_impl = type_def_impl_of_int i;
-		tdf_string = type_def_string_of_int i;
-	}
-
-let null_type_def_flags = type_def_flags_of_int 0
-
-let field_access_of_int i = match i land 0x07 with
-	(* access flags - mask 0x07 *)
-	| 0x0 -> FAPrivateScope (* 0x0 *)
-	| 0x1 -> FAPrivate (* 0x1 *)
-	| 0x2 -> FAFamAndAssem (* 0x2 *)
-	| 0x3 -> FAAssembly (* 0x3 *)
-	| 0x4 -> FAFamily (* 0x4 *)
-	| 0x5 -> FAFamOrAssem (* 0x5 *)
-	| 0x6 -> FAPublic (* 0x6 *)
-	| _ -> assert false
-
-let field_contract_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		(* contract flags - mask 0x02F0 *)
-		| 0x10 -> CStatic (* 0x10 *)
-		| 0x20 -> CInitOnly (* 0x20 *)
-		| 0x40 -> CLiteral (* 0x40 *)
-		| 0x80 -> CNotSerialized (* 0x80 *)
-		| 0x200 -> CSpecialName (* 0x200 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x10;0x20;0x40;0x80;0x200]
-
-let field_reserved_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		(* reserved flags - cannot be set explicitly. mask 0x9500 *)
-		| 0x400 -> RSpecialName (* 0x400 *)
-		| 0x1000 -> RMarshal (* 0x1000 *)
-		| 0x8000 -> RConstant (* 0x8000 *)
-		| 0x0100 -> RFieldRVA (* 0x0100 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x400;0x1000;0x8000;0x100]
-
-let field_flags_of_int i =
-	{
-		ff_access = field_access_of_int i;
-		ff_contract = field_contract_of_int i;
-		ff_reserved = field_reserved_of_int i;
-	}
-
-let null_field_flags = field_flags_of_int 0
-
-let method_contract_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		(* contract flags - mask 0xF0 *)
-		| 0x10 -> CMStatic (* 0x10 *)
-		| 0x20 -> CMFinal (* 0x20 *)
-		| 0x40 -> CMVirtual (* 0x40 *)
-		| 0x80 -> CMHideBySig (* 0x80 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x10;0x20;0x40;0x80]
-
-let method_vtable_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		(* vtable flags - mask 0x300 *)
-		| 0x100 -> VNewSlot (* 0x100 *)
-		| 0x200 -> VStrict (* 0x200 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x100;0x200]
-
-let method_impl_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		(* implementation flags - mask 0x2C08 *)
-		| 0x0400 -> IAbstract (* 0x0400 *)
-		| 0x0800 -> ISpecialName (* 0x0800 *)
-		| 0x2000 -> IPInvokeImpl (* 0x2000 *)
-		| 0x0008 -> IUnmanagedExp (* 0x0008 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x0400;0x0800;0x2000;0x0008]
-
-let method_reserved_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		(* reserved flags - cannot be set explicitly. mask 0xD000 *)
-		| 0x1000 -> RTSpecialName (* 0x1000 *)
-		| 0x4000 -> RHasSecurity (* 0x4000 *)
-		| 0x8000 -> RReqSecObj (* 0x8000 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x1000;0x4000;0x8000]
-
-let method_code_type_of_int i = match i land 0x3 with
-	| 0x0 -> CCil (* 0x0 *)
-	| 0x1 -> CNative (* 0x1 *)
-	| 0x2 -> COptIl (* 0x2 *)
-	| 0x3 -> CRuntime (* 0x3 *)
-	| _ -> assert false
-
-let method_code_mngmt_of_int i = match i land 0x4 with
-	| 0x0 -> MManaged (* 0x0 *)
-	| 0x4 -> MUnmanaged (* 0x4 *)
-	| _ -> assert false
-
-let method_interop_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		| 0x10 -> OForwardRef (* 0x10 *)
-		| 0x80 -> OPreserveSig (* 0x80 *)
-		| 0x1000 -> OInternalCall (* 0x1000 *)
-		| 0x20 -> OSynchronized (* 0x20 *)
-		| 0x08 -> ONoInlining (* 0x08 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x10;0x80;0x1000;0x20;0x08]
-
-let method_flags_of_int iflags flags =
-	{
-		mf_access = field_access_of_int flags;
-		mf_contract = method_contract_of_int flags;
-		mf_vtable = method_vtable_of_int flags;
-		mf_impl = method_impl_of_int flags;
-		mf_reserved = method_reserved_of_int flags;
-		mf_code_type = method_code_type_of_int iflags;
-		mf_code_mngmt = method_code_mngmt_of_int iflags;
-		mf_interop = method_interop_of_int iflags;
-	}
-
-let null_method_flags = method_flags_of_int 0 0
-
-let param_io_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		(* input/output flags - mask 0x13 *)
-		| 0x1 -> PIn (* 0x1 *)
-		| 0x2 -> POut (* 0x2 *)
-		| 0x10 -> POpt (* 0x10 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x1;0x2;0x10]
-
-let param_reserved_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		(* reserved flags - mask 0xF000 *)
-		| 0x1000 -> PHasConstant (* 0x1000 *)
-		| 0x2000 -> PMarshal (* 0x2000 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x1000;0x2000]
-
-let param_flags_of_int i =
-	{
-		pf_io = param_io_of_int i;
-		pf_reserved = param_reserved_of_int i;
-	}
-
-let null_param_flags = param_flags_of_int 0
-
-let callconv_of_int ?match_generic_inst:(match_generic_inst=false) i =
-	let basic = match i land 0xF with
-		| 0x0 -> CallDefault (* 0x0 *)
-		| 0x1 -> CallCDecl
-		| 0x2 -> CallStdCall
-		| 0x3 -> CallThisCall
-		| 0x4 -> CallFastCall
-		| 0x5 -> CallVararg (* 0x5 *)
-		| 0x6 -> CallField (* 0x6 *)
-		| 0x7 -> CallLocal (* 0x7 *)
-		| 0x8 -> CallProp (* 0x8 *)
-		| 0x9 -> CallUnmanaged (* 0x9 *)
-		| 0xa when match_generic_inst -> CallGenericInst (* 0xA *)
-		| i -> printf "error 0x%x\n\n" i; assert false
-	in
-	match i land 0x20 with
-		| 0x20 ->
-			[CallHasThis;basic]
-		| _ when i land 0x40 = 0x40 ->
-			[CallExplicitThis;basic]
-		| _ -> [basic]
-
-let event_flags_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		| 0x0200 -> ESpecialName (* 0x0200 *)
-		| 0x0400 -> ERTSpecialName (* 0x0400 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x0200;0x0400]
-
-let property_flags_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		| 0x0200 -> PSpecialName (* 0x0200 *)
-		| 0x0400 -> PRTSpecialName (* 0x0400 *)
-		| 0x1000 -> PHasDefault (* 0x1000 *)
-		| 0xE9FF -> PUnused (* 0xE9FF *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x0200;0x0400;0x1000;0xE9FF]
-
-let semantic_flags_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		| 0x0001 -> SSetter (* 0x0001 *)
-		| 0x0002 -> SGetter (* 0x0002 *)
-		| 0x0004 -> SOther (* 0x0004 *)
-		| 0x0008 -> SAddOn (* 0x0008 *)
-		| 0x0010 -> SRemoveOn (* 0x0010 *)
-		| 0x0020 -> SFire (* 0x0020 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x0001;0x0002;0x0004;0x0008;0x0010;0x0020]
-
-let impl_charset_of_int = function
-	| 0x0 -> IDefault (* 0x0 *)
-	| 0x2 -> IAnsi (* 0x2 *)
-	| 0x4 -> IUnicode (* 0x4 *)
-	| 0x6 -> IAutoChar (* 0x6 *)
-	| _ -> assert false
-
-let impl_callconv_of_int = function
-	| 0x0 -> IDefaultCall (* 0x0 *)
-	| 0x100 -> IWinApi (* 0x100 *)
-	| 0x200 -> ICDecl (* 0x200 *)
-	| 0x300 -> IStdCall (* 0x300 *)
-	| 0x400 -> IThisCall (* 0x400 *)
-	| 0x500 -> IFastCall (* 0x500 *)
-	| _ -> assert false
-
-let impl_flag_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		| 0x1 -> INoMangle (* 0x1 *)
-		| 0x10 -> IBestFit (* 0x10 *)
-		| 0x20 -> IBestFitOff (* 0x20 *)
-		| 0x40 -> ILastErr (* 0x40 *)
-		| 0x1000 -> ICharMapError (* 0x1000 *)
-		| 0x2000 -> ICharMapErrorOff (* 0x2000 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x1;0x10;0x20;0x40;0x1000;0x2000]
-
-let impl_flags_of_int i =
-	{
-		if_charset = impl_charset_of_int (i land 0x6);
-		if_callconv = impl_callconv_of_int (i land 0x700);
-		if_flags = impl_flag_of_int i;
-	}
-
-let null_impl_flags = impl_flags_of_int 0
-
-let assembly_flags_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		| 0x1 -> APublicKey (* 0x1 *)
-		| 0x100 -> ARetargetable (* 0x100 *)
-		| 0x4000 -> ADisableJitCompileOptimizer (* 0x4000 *)
-		| 0x8000 -> AEnableJitCompileTracking (* 0x8000 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x1;0x100;0x4000;0x8000]
-
-let hash_algo_of_int = function
-	| 0x0 -> HNone (* 0x0 *)
-	| 0x8003 -> HReserved (* 0x8003 *)
-	| 0x8004 -> HSha1 (* 0x8004 *)
-	| _ -> assert false
-
-let file_flag_of_int = function
-	| 0x0 -> ContainsMetadata (* 0x0 *)
-	| 0x1 -> ContainsNoMetadata (* 0x1 *)
-	| _ -> assert false
-
-let manifest_resource_flag_of_int i = match i land 0x7 with
-	| 0x0 -> RNone (* 0x0 *)
-	| 0x1 -> RPublic (* 0x1 *)
-	| 0x2 -> RPrivate (* 0x2 *)
-	| _ -> assert false
-
-let generic_variance_of_int = function
-	(* mask 0x3 *)
-	| 0x0 -> VNone (* 0x0 *)
-	| 0x1 -> VCovariant (* 0x1 *)
-	| 0x2 -> VContravariant (* 0x2 *)
-	| _ -> assert false
-
-let generic_constraint_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		(* mask 0x1C *)
-		| 0x4 -> CInstanceType (* 0x4 *)
-		| 0x8 -> CValueType (* 0x8 *)
-		| 0x10 -> CDefaultCtor (* 0x10 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x4;0x8;0x10]
-
-let generic_flags_of_int i =
-	{
-		gf_variance = generic_variance_of_int (i land 0x3);
-		gf_constraint = generic_constraint_of_int (i land 0x1C);
-	}
-
-let null_generic_flags = generic_flags_of_int 0
-
-(* TODO: convert from string to Bigstring if OCaml 4 is available *)
-type meta_ctx = {
-	compressed : bool;
-		(* is a compressed stream *)
-	strings_stream : string;
-	mutable strings_offset : int;
-		(* #Strings: a string heap containing the names of metadata items *)
-	blob_stream : string;
-	mutable blob_offset : int;
-		(* #Blob: blob heap containing internal metadata binary object, such as default values, signatures, etc *)
-	guid_stream : string;
-	mutable guid_offset : int;
-		(* #GUID: a GUID heap *)
-	us_stream : string;
-		(* #US: user-defined strings *)
-	meta_stream : string;
-		(* may be either: *)
-			(* #~: compressed (optimized) metadata stream *)
-			(* #-: uncompressed (unoptimized) metadata stream *)
-	mutable meta_edit_continue : bool;
-	mutable meta_has_deleted : bool;
-
-  module_cache : meta_cache;
-	tables : (clr_meta DynArray.t) array;
-	table_sizes : ( string -> int -> int * int ) array;
-	extra_streams : clr_stream_header list;
-	relations : (meta_pointer, clr_meta) Hashtbl.t;
-	typedefs : (ilpath, meta_type_def) Hashtbl.t;
-
-	mutable delays : (unit -> unit) list;
-}
-
-and meta_cache = {
-	mutable lookups : (string -> meta_ctx option) list;
-	mutable mcache : (meta_module * meta_ctx) list;
-}
-
-let empty = "<not initialized>"
-
-let create_cache () =
-	{
-		lookups = [];
-		mcache = [];
-	}
-
-let add_lookup cache fn =
-	cache.lookups <- fn :: cache.lookups
-
-(* ******* Reading from Strings ********* *)
-
-let sget s pos = Char.code (String.get s pos)
-
-let read_compressed_i32 s pos =
-	let v = sget s pos in
-	(* Printf.printf "compressed: %x (18 0x%x 19 0x%x)\n" v (sget s (pos+20)) (sget s (pos+21)); *)
-	if v land 0x80 = 0x00 then
-		pos+1, v
-	else if v land 0xC0 = 0x80 then
-		pos+2, ((v land 0x3F) lsl 8) lor (sget s (pos+1))
-	else if v land 0xE0 = 0xC0 then
-		pos+4, ((v land 0x1F) lsl 24) lor ((sget s (pos+1)) lsl 16) lor ((sget s (pos+2)) lsl 8) lor (sget s (pos+3))
-	else
-		error (Printf.sprintf "Error reading compressed data. Invalid first byte: %x" v)
-
-let int_of_table (idx : clr_meta_idx) : int = Obj.magic idx
-let table_of_int (idx : int) : clr_meta_idx = Obj.magic idx
-
-let sread_ui8 s pos =
-	let n1 = sget s pos in
-	pos+1,n1
-
-let sread_i32 s pos =
-	let n1 = sget s pos in
-	let n2 = sget s (pos+1) in
-	let n3 = sget s (pos+2) in
-	let n4 = sget s (pos+3) in
-	pos+4, (n4 lsl 24) lor (n3 lsl 16) lor (n2 lsl 8) lor n1
-
-let sread_real_i32 s pos =
-	let n1 = sget s pos in
-	let n2 = sget s (pos+1) in
-	let n3 = sget s (pos+2) in
-	let n4 = Int32.of_int (sget s (pos+3)) in
-	let n = Int32.of_int ((n3 lsl 16) lor (n2 lsl 8) lor n1) in
-	let n4 = Int32.shift_left n4 24 in
-	pos+4, (Int32.logor n4 n)
-
-let sread_i64 s pos =
-	let pos, v1 = sread_real_i32 s (pos+1) in
-	let v1 = Int64.of_int32 v1 in
-	let pos, v2 = sread_real_i32 s pos in
-	let v2 = Int64.of_int32 v2 in
-	let v2 = Int64.shift_left v2 32 in
-	pos, (Int64.logor v1 v2)
-
-let sread_ui16 s pos =
-	let n1 = sget s pos in
-	let n2 = sget s (pos+1) in
-	pos+2, (n2 lsl 8) lor n1
-
-let read_cstring ctx pos =
-	let s = ctx.strings_stream in
-	let rec loop en =
-		match String.get s en with
-		| '\x00' -> en - pos
-		| _ -> loop (en+1)
-	in
-	(* printf "len 0x%x - pos 0x%x\n" (String.length s) pos; *)
-	let len = loop pos in
-	String.sub s pos len
-
-let read_sstring_idx ctx pos =
-	let s = ctx.meta_stream in
-	let metapos,i = if ctx.strings_offset = 2 then
-		sread_ui16 s pos
-	else
-		sread_i32 s pos
-	in
-	match i with
-	| 0 ->
-		metapos, ""
-	| _ ->
-		metapos, read_cstring ctx i
-
-let read_sblob_idx ctx pos =
-	let s = ctx.meta_stream in
-	let metapos, i = if ctx.blob_offset = 2 then
-		sread_ui16 s pos
-	else
-		sread_i32 s pos
-	in
-	match i with
-	| 0 ->
-		metapos,""
-	| _ ->
-		let bpos, len = read_compressed_i32 ctx.blob_stream i in
-		metapos, String.sub ctx.blob_stream bpos len
-
-let read_sguid_idx ctx pos =
-	let s = ctx.meta_stream in
-	let metapos,i = if ctx.guid_offset = 2 then
-		sread_ui16 s pos
-	else
-		sread_i32 s pos
-	in
-	match i with
-	| 0 ->
-		metapos, ""
-	| _ ->
-		let s = ctx.guid_stream in
-		let i = i - 1 in
-		let pos = i * 16 in
-		metapos, String.sub s pos 16
-
-let read_callconv ctx s pos =
-	let pos, conv = read_compressed_i32 s pos in
-	let callconv = callconv_of_int conv ~match_generic_inst:true in
-	let pos = match conv land 0x10 with
-		| 0x10 -> fst (read_compressed_i32 s pos)
-		| _ -> pos
-	in
-	pos, callconv
-
-let read_constant ctx with_type s pos =
-	match with_type with
-	| CBool ->
-		pos+1, IBool (sget s (pos) <> 0)
-	| CChar ->
-		let pos, v = sread_ui16 s (pos) in
-		pos, IChar v
-	| CInt8 | CUInt8 ->
-		pos+1,IByte (sget s (pos))
-	| CInt16 | CUInt16 ->
-		let pos, v = sread_ui16 s (pos) in
-		pos, IShort v
-	| CInt32 | CUInt32 ->
-		let pos, v = sread_real_i32 s (pos) in
-		pos, IInt v
-	| CInt64 | CUInt64 ->
-		let pos, v = sread_i64 s (pos) in
-		pos, IInt64 v
-	| CFloat32 ->
-		let pos, v1 = sread_real_i32 s (pos) in
-		pos, IFloat32 (Int32.float_of_bits v1)
-	| CFloat64 ->
-		let pos, v1 = sread_i64 s (pos) in
-		pos, IFloat64 (Int64.float_of_bits v1)
-	| CString ->
-		if sget s pos = 0xff then
-			pos+1,IString ""
-		else
-			let pos, len = read_compressed_i32 s pos in
-			pos+len, IString (String.sub s pos len)
-	| CNullRef ->
-		pos+1, INull
-
-let sig_to_const = function
-	| SBool -> CBool
-	| SChar -> CChar
-	| SInt8 -> CInt8
-	| SUInt8 -> CUInt8
-	| SInt16 -> CInt16
-	| SUInt16 -> CUInt16
-	| SInt32 -> CInt32
-	| SUInt32 -> CUInt32
-	| SInt64 -> CInt64
-	| SUInt64 -> CUInt64
-	| SFloat32 -> CFloat32
-	| SFloat64 -> CFloat64
-	| SString -> CString
-	| _ -> CNullRef
-
-let read_constant_type ctx s pos = match sget s pos with
-	| 0x2 -> pos+1, CBool (* 0x2 *)
-	| 0x3 -> pos+1, CChar (* 0x3 *)
-	| 0x4 -> pos+1, CInt8 (* 0x4 *)
-	| 0x5 -> pos+1, CUInt8 (* 0x5 *)
-	| 0x6 -> pos+1, CInt16 (* 0x6 *)
-	| 0x7 -> pos+1, CUInt16 (* 0x7 *)
-	| 0x8 -> pos+1, CInt32 (* 0x8 *)
-	| 0x9 -> pos+1, CUInt32 (* 0x9 *)
-	| 0xA -> pos+1, CInt64 (* 0xA *)
-	| 0xB -> pos+1, CUInt64 (* 0xB *)
-	| 0xC -> pos+1, CFloat32 (* 0xC *)
-	| 0xD -> pos+1, CFloat64 (* 0xD *)
-	| 0xE -> pos+1, CString (* 0xE *)
-	| 0x12 -> pos+1, CNullRef (* 0x12 *)
-	| i -> Printf.printf "0x%x\n" i; assert false
-
-let action_security_of_int = function
-	| 0x1 -> SecRequest (* 0x1 *)
-	| 0x2 -> SecDemand (* 0x2 *)
-	| 0x3 -> SecAssert (* 0x3 *)
-	| 0x4 -> SecDeny (* 0x4 *)
-	| 0x5 -> SecPermitOnly (* 0x5 *)
-	| 0x6 -> SecLinkCheck (* 0x6 *)
-	| 0x7 -> SecInheritCheck (* 0x7 *)
-	| 0x8 -> SecReqMin (* 0x8 *)
-	| 0x9 -> SecReqOpt (* 0x9 *)
-	| 0xA -> SecReqRefuse (* 0xA *)
-	| 0xB -> SecPreJitGrant (* 0xB *)
-	| 0xC -> SecPreJitDeny (* 0xC *)
-	| 0xD -> SecNonCasDemand (* 0xD *)
-	| 0xE -> SecNonCasLinkDemand (* 0xE *)
-	| 0xF -> SecNonCasInheritance (* 0xF *)
-	| _ -> assert false
-
-(* ******* Metadata Tables ********* *)
-let null_meta = UnknownMeta (-1)
-
-let mk_module id =
-	{
-		md_id = id;
-		md_generation = 0;
-		md_name = empty;
-		md_vid = empty;
-		md_encid = empty;
-		md_encbase_id = empty;
-	}
-
-let null_module = mk_module (-1)
-
-let mk_type_ref id =
-	{
-		tr_id = id;
-		tr_resolution_scope = null_meta;
-		tr_name = empty;
-		tr_namespace = [];
-	}
-
-let null_type_ref = mk_type_ref (-1)
-
-let mk_type_def id =
-	{
-		td_id = id;
-		td_flags = null_type_def_flags;
-		td_name = empty;
-		td_namespace = [];
-		td_extends = None;
-		td_field_list = [];
-		td_method_list = [];
-		td_extra_enclosing = None;
-	}
-
-let null_type_def = mk_type_def (-1)
-
-let mk_field id =
-	{
-		f_id = id;
-		f_flags = null_field_flags;
-		f_name = empty;
-		f_signature = SVoid;
-	}
-
-let null_field = mk_field (-1)
-
-let mk_field_ptr id =
-	{
-		fp_id = id;
-		fp_field = null_field;
-	}
-
-let null_field_ptr = mk_field_ptr (-1)
-
-let mk_method id =
-	{
-		m_id = id;
-		m_rva = Int32.of_int (-1);
-		m_flags = null_method_flags;
-		m_name = empty;
-		m_signature = SVoid;
-		m_param_list = [];
-		m_declaring = None;
-	}
-
-let null_method = mk_method (-1)
-
-let mk_method_ptr id =
-	{
-		mp_id = id;
-		mp_method = null_method;
-	}
-
-let null_method_ptr = mk_method_ptr (-1)
-
-let mk_param id =
-	{
-		p_id = id;
-		p_flags = null_param_flags;
-		p_sequence = -1;
-		p_name = empty;
-	}
-
-let null_param = mk_param (-1)
-
-let mk_param_ptr id =
-	{
-		pp_id = id;
-		pp_param = null_param;
-	}
-
-let null_param_ptr = mk_param_ptr (-1)
-
-let mk_interface_impl id =
-	{
-		ii_id = id;
-		ii_class = null_type_def; (* TypeDef rid *)
-		ii_interface = null_meta;
-	}
-
-let null_interface_impl = mk_interface_impl (-1)
-
-let mk_member_ref id =
-	{
-		memr_id = id;
-		memr_class = null_meta;
-		memr_name = empty;
-		memr_signature = SVoid;
-	}
-
-let null_member_ref = mk_member_ref (-1)
-
-let mk_constant id =
-	{
-		c_id = id;
-		c_type = CNullRef;
-		c_parent = null_meta;
-		c_value = INull;
-	}
-
-let null_constant = mk_constant (-1)
-
-let mk_custom_attribute id =
-	{
-		ca_id = id;
-		ca_parent = null_meta;
-		ca_type = null_meta;
-		ca_value = None;
-	}
-
-let null_custom_attribute = mk_custom_attribute (-1)
-
-let mk_field_marshal id =
-	{
-		fm_id = id;
-		fm_parent = null_meta;
-		fm_native_type = NVoid;
-	}
-
-let null_field_marshal = mk_field_marshal (-1)
-
-let mk_decl_security id =
-	{
-		ds_id = id;
-		ds_action = SecNull;
-		ds_parent = null_meta;
-		ds_permission_set = empty;
-	}
-
-let mk_class_layout id =
-	{
-		cl_id = id;
-		cl_packing_size = -1;
-		cl_class_size = -1;
-		cl_parent = null_type_def;
-	}
-
-let mk_field_layout id =
-	{
-		fl_id = id;
-		fl_offset = -1;
-		fl_field = null_field;
-	}
-
-let mk_stand_alone_sig id =
-	{
-		sa_id = id;
-		sa_signature = SVoid;
-	}
-
-let mk_event id =
-	{
-		e_id = id;
-		e_flags = [];
-		e_name = empty;
-		e_event_type = null_meta;
-	}
-
-let null_event = mk_event (-1)
-
-let mk_event_map id =
-	{
-		em_id = id;
-		em_parent = null_type_def;
-		em_event_list = [];
-	}
-
-let mk_event_ptr id =
-	{
-		ep_id = id;
-		ep_event = null_event;
-	}
-
-let mk_property id =
-	{
-		prop_id = id;
-		prop_flags = [];
-		prop_name = empty;
-		prop_type = SVoid;
-	}
-
-let null_property = mk_property (-1)
-
-let mk_property_map id =
-	{
-		pm_id = id;
-		pm_parent = null_type_def;
-		pm_property_list = [];
-	}
-
-let mk_property_ptr id =
-	{
-		prp_id = id;
-		prp_property = null_property;
-	}
-
-let mk_method_semantics id =
-	{
-		ms_id = id;
-		ms_semantic = [];
-		ms_method = null_method;
-		ms_association = null_meta;
-	}
-
-let mk_method_impl id =
-	{
-		mi_id = id;
-		mi_class = null_type_def;
-		mi_method_body = null_meta;
-		mi_method_declaration = null_meta;
-	}
-
-let mk_module_ref id =
-	{
-		modr_id = id;
-		modr_name = empty;
-	}
-
-let null_module_ref = mk_module_ref (-1)
-
-let mk_type_spec id =
-	{
-		ts_id = id;
-		ts_signature = SVoid;
-	}
-
-let mk_enc_log id =
-	{
-		el_id = id;
-		el_token = -1;
-		el_func_code = -1;
-	}
-
-let mk_impl_map id =
-	{
-		im_id = id;
-		im_flags = null_impl_flags;
-		im_forwarded = null_meta;
-		im_import_name = empty;
-		im_import_scope = null_module_ref;
-	}
-
-let mk_enc_map id =
-	{
-		encm_id = id;
-		encm_token = -1;
-	}
-
-let mk_field_rva id =
-	{
-		fr_id = id;
-		fr_rva = Int32.zero;
-		fr_field = null_field;
-	}
-
-let mk_assembly id =
-	{
-		a_id = id;
-		a_hash_algo = HNone;
-		a_major = -1;
-		a_minor = -1;
-		a_build = -1;
-		a_rev = -1;
-		a_flags = [];
-		a_public_key = empty;
-		a_name = empty;
-		a_locale = empty;
-	}
-
-let mk_assembly_processor id =
-	{
-		ap_id = id;
-		ap_processor = -1;
-	}
-
-let mk_assembly_os id =
-	{
-		aos_id = id;
-		aos_platform_id = -1;
-		aos_major_version = -1;
-		aos_minor_version = -1;
-	}
-
-let mk_assembly_ref id =
-	{
-		ar_id = id;
-		ar_major = -1;
-		ar_minor = -1;
-		ar_build = -1;
-		ar_rev = -1;
-		ar_flags = [];
-		ar_public_key = empty;
-		ar_name = empty;
-		ar_locale = empty;
-		ar_hash_value = empty;
-	}
-
-let null_assembly_ref = mk_assembly_ref (-1)
-
-let mk_assembly_ref_processor id =
-	{
-		arp_id = id;
-		arp_processor = -1;
-		arp_assembly_ref = null_assembly_ref;
-	}
-
-let mk_assembly_ref_os id =
-	{
-		aros_id = id;
-		aros_platform_id = -1;
-		aros_major = -1;
-		aros_minor = -1;
-		aros_assembly_ref = null_assembly_ref;
-	}
-
-let mk_file id =
-	{
-		file_id = id;
-		file_flags = ContainsMetadata;
-		file_name = empty;
-		file_hash_value = empty;
-	}
-
-let mk_exported_type id =
-	{
-		et_id = id;
-		et_flags = null_type_def_flags;
-		et_type_def_id = -1;
-		et_type_name = empty;
-		et_type_namespace = [];
-		et_implementation = null_meta;
-	}
-
-let mk_manifest_resource id =
-	{
-		mr_id = id;
-		mr_offset = -1;
-		mr_flags = RNone;
-		mr_name = empty;
-		mr_implementation = None;
-	}
-
-let mk_nested_class id =
-	{
-		nc_id = id;
-		nc_nested = null_type_def;
-		nc_enclosing = null_type_def;
-	}
-
-let mk_generic_param id =
-	{
-		gp_id = id;
-		gp_number = -1;
-		gp_flags = null_generic_flags;
-		gp_owner = null_meta;
-		gp_name = None;
-	}
-
-let null_generic_param = mk_generic_param (-1)
-
-let mk_method_spec id =
-	{
-		mspec_id = id;
-		mspec_method = null_meta;
-		mspec_instantiation = SVoid;
-	}
-
-let mk_generic_param_constraint id =
-	{
-		gc_id = id;
-		gc_owner = null_generic_param;
-		gc_constraint = null_meta;
-	}
-
-let mk_meta tbl id = match tbl with
-	| IModule -> Module (mk_module id)
-	| ITypeRef -> TypeRef (mk_type_ref id)
-	| ITypeDef -> TypeDef (mk_type_def id)
-	| IFieldPtr -> FieldPtr (mk_field_ptr id)
-	| IField -> Field (mk_field id)
-	| IMethodPtr -> MethodPtr (mk_method_ptr id)
-	| IMethod -> Method (mk_method id)
-	| IParamPtr -> ParamPtr (mk_param_ptr id)
-	| IParam -> Param (mk_param id)
-	| IInterfaceImpl -> InterfaceImpl (mk_interface_impl id)
-	| IMemberRef -> MemberRef (mk_member_ref id)
-	| IConstant -> Constant (mk_constant id)
-	| ICustomAttribute -> CustomAttribute (mk_custom_attribute id)
-	| IFieldMarshal -> FieldMarshal(mk_field_marshal id)
-	| IDeclSecurity -> DeclSecurity(mk_decl_security id)
-	| IClassLayout -> ClassLayout(mk_class_layout id)
-	| IFieldLayout -> FieldLayout(mk_field_layout id)
-	| IStandAloneSig -> StandAloneSig(mk_stand_alone_sig id)
-	| IEventMap -> EventMap(mk_event_map id)
-	| IEventPtr -> EventPtr(mk_event_ptr id)
-	| IEvent -> Event(mk_event id)
-	| IPropertyMap -> PropertyMap(mk_property_map id)
-	| IPropertyPtr -> PropertyPtr(mk_property_ptr id)
-	| IProperty -> Property(mk_property id)
-	| IMethodSemantics -> MethodSemantics(mk_method_semantics id)
-	| IMethodImpl -> MethodImpl(mk_method_impl id)
-	| IModuleRef -> ModuleRef(mk_module_ref id)
-	| ITypeSpec -> TypeSpec(mk_type_spec id)
-	| IImplMap -> ImplMap(mk_impl_map id)
-	| IFieldRVA -> FieldRVA(mk_field_rva id)
-	| IENCLog -> ENCLog(mk_enc_log id)
-	| IENCMap -> ENCMap(mk_enc_map id)
-	| IAssembly -> Assembly(mk_assembly id)
-	| IAssemblyProcessor -> AssemblyProcessor(mk_assembly_processor id)
-	| IAssemblyOS -> AssemblyOS(mk_assembly_os id)
-	| IAssemblyRef -> AssemblyRef(mk_assembly_ref id)
-	| IAssemblyRefProcessor -> AssemblyRefProcessor(mk_assembly_ref_processor id)
-	| IAssemblyRefOS -> AssemblyRefOS(mk_assembly_ref_os id)
-	| IFile -> File(mk_file id)
-	| IExportedType -> ExportedType(mk_exported_type id)
-	| IManifestResource -> ManifestResource(mk_manifest_resource id)
-	| INestedClass -> NestedClass(mk_nested_class id)
-	| IGenericParam -> GenericParam(mk_generic_param id)
-	| IMethodSpec -> MethodSpec(mk_method_spec id)
-	| IGenericParamConstraint -> GenericParamConstraint(mk_generic_param_constraint id)
-	| i -> UnknownMeta (int_of_table i)
-
-let get_table ctx idx rid =
-	let cur = ctx.tables.(int_of_table idx) in
-	DynArray.get cur (rid-1)
-
-(* special coded types  *)
-let max_clr_meta_idx = 76
-
-let coded_description = Array.init (max_clr_meta_idx - 63) (fun i ->
-	let i = 64 + i in
-	match table_of_int i with
-		| ITypeDefOrRef ->
-			Array.of_list [ITypeDef;ITypeRef;ITypeSpec], 2
-		| IHasConstant ->
-			Array.of_list [IField;IParam;IProperty], 2
-		| IHasCustomAttribute ->
-			Array.of_list
-			[IMethod;IField;ITypeRef;ITypeDef;IParam;IInterfaceImpl;IMemberRef;
-			 IModule;IDeclSecurity;IProperty;IEvent;IStandAloneSig;IModuleRef;
-			 ITypeSpec;IAssembly;IAssemblyRef;IFile;IExportedType;IManifestResource;
-			 IGenericParam;IGenericParamConstraint;IMethodSpec], 5
-		| IHasFieldMarshal ->
-			Array.of_list [IField;IParam], 1
-		| IHasDeclSecurity ->
-			Array.of_list [ITypeDef;IMethod;IAssembly], 2
-		| IMemberRefParent ->
-			Array.of_list [ITypeDef;ITypeRef;IModuleRef;IMethod;ITypeSpec], 3
-		| IHasSemantics ->
-			Array.of_list [IEvent;IProperty], 1
-		| IMethodDefOrRef ->
-			Array.of_list [IMethod;IMemberRef], 1
-		| IMemberForwarded ->
-			Array.of_list [IField;IMethod], 1
-		| IImplementation ->
-			Array.of_list [IFile;IAssemblyRef;IExportedType], 2
-		| ICustomAttributeType ->
-			Array.of_list [ITypeRef(* unused ? *);ITypeDef (* unused ? *);IMethod;IMemberRef(*;IString FIXME *)], 3
-		| IResolutionScope ->
-			Array.of_list [IModule;IModuleRef;IAssemblyRef;ITypeRef], 2
-		| ITypeOrMethodDef ->
-			Array.of_list [ITypeDef;IMethod], 1
-		| _ ->
-			print_endline ("Unknown coded index: " ^ string_of_int i);
-			assert false)
-
-let set_coded_sizes ctx rows =
-	let check i tbls max =
-		if List.exists (fun t ->
-			let _, nrows = rows.(int_of_table t) in
-			nrows >= max
-		) tbls then
-			ctx.table_sizes.(i) <- sread_i32
-	in
-	for i = 64 to (max_clr_meta_idx) do
-		let tbls, size = coded_description.(i - 64) in
-		let max = 1 lsl (16 - size) in
-		check i (Array.to_list tbls) max
-	done
-
-let sread_from_table_opt ctx in_blob tbl s pos =
-	let i = int_of_table tbl in
-	let sread = if in_blob then
-		read_compressed_i32
-	else
-		ctx.table_sizes.(i)
-	in
-	let pos, rid = sread s pos in
-	if i >= 64 then begin
-		let tbls,size = coded_description.(i-64) in
-		let mask = (1 lsl size) - 1 in
-		let mask = if mask = 0 then 1 else mask in
-		let tidx = rid land mask in
-		let real_rid = rid lsr size in
-		let real_tbl = tbls.(tidx) in
-		(* printf "rid 0x%x - table idx 0x%x - real_rid 0x%x\n\n" rid tidx real_rid; *)
-		if real_rid = 0 then
-			pos, None
-		else
-			pos, Some (get_table ctx real_tbl real_rid)
-	end else if rid = 0 then
-		pos, None
-	else
-		pos, Some (get_table ctx tbl rid)
-
-let sread_from_table ctx in_blob tbl s pos =
-	let pos, opt = sread_from_table_opt ctx in_blob tbl s pos in
-	pos, Option.get opt
-
-(* ******* SIGNATURE READING ********* *)
-let read_inline_str s pos =
-	let pos, len = read_compressed_i32 s pos in
-	let ret = String.sub s pos len in
-	pos+len,ret
-
-let rec read_ilsig ctx s pos =
-	let i = sget s pos in
-	(* printf "0x%x\n" i; *)
-	let pos = pos + 1 in
-	match i with
-		| 0x1 -> pos, SVoid (* 0x1 *)
-		| 0x2 -> pos, SBool (* 0x2 *)
-		| 0x3 -> pos, SChar (* 0x3 *)
-		| 0x4 -> pos, SInt8 (* 0x4 *)
-		| 0x5 -> pos, SUInt8 (* 0x5 *)
-		| 0x6 -> pos, SInt16 (* 0x6 *)
-		| 0x7 -> pos, SUInt16 (* 0x7 *)
-		| 0x8 -> pos, SInt32 (* 0x8 *)
-		| 0x9 -> pos, SUInt32 (* 0x9 *)
-		| 0xA -> pos, SInt64 (* 0xA *)
-		| 0xB -> pos, SUInt64 (* 0xB *)
-		| 0xC -> pos, SFloat32 (* 0xC *)
-		| 0xD -> pos, SFloat64 (* 0xD *)
-		| 0xE -> pos, SString (* 0xE *)
-		| 0xF ->
-			let pos, s = read_ilsig ctx s pos in
-			pos, SPointer s
-		| 0x10 ->
-			let pos, s = read_ilsig ctx s pos in
-			pos, SManagedPointer s
-		| 0x11 ->
-			let pos, vt = sread_from_table ctx true ITypeDefOrRef s pos in
-			pos, SValueType vt
-		| 0x12 ->
-			let pos, c = sread_from_table ctx true ITypeDefOrRef s pos in
-			pos, SClass c
-		| 0x13 ->
-			let n = sget s pos in
-			pos + 1, STypeParam n
-		| 0x14 ->
-			let pos, ssig = read_ilsig ctx s pos in
-			let pos, rank = read_compressed_i32 s pos in
-			let pos, numsizes = read_compressed_i32 s pos in
-			let pos = ref pos in
-			let sizearray = Array.init numsizes (fun _ ->
-				let p, size = read_compressed_i32 s !pos in
-				pos := p;
-				size
-			) in
-			let pos, bounds = read_compressed_i32 s !pos in
-			let pos = ref pos in
-			let boundsarray = Array.init bounds (fun _ ->
-				let p, b = read_compressed_i32 s !pos in
-				pos := p;
-				let signed = b land 0x1 = 0x1 in
-				let b = b lsr 1 in
-				if signed then -b else b
-			) in
-			let ret = Array.init rank (fun i ->
-				(if i >= bounds then None else Some boundsarray.(i))
-				, (if i >= numsizes then None else Some sizearray.(i))
-			) in
-			!pos, SArray(ssig, ret)
-		| 0x15 ->
-			(* let pos, c = sread_from_table ctx ITypeDefOrRef s pos in *)
-			let pos, ssig = read_ilsig ctx s pos in
-			let pos, ntypes = read_compressed_i32 s pos in
-			let rec loop acc pos n =
-				if n > ntypes then
-					pos, List.rev acc
-				else
-					let pos, ssig = read_ilsig ctx s pos in
-					loop (ssig :: acc) pos (n+1)
-			in
-			let pos, args = loop [] pos 1 in
-			pos, SGenericInst (ssig, args)
-		| 0x16 -> pos, STypedReference (* 0x16 *)
-		| 0x18 -> pos, SIntPtr (* 0x18 *)
-		| 0x19 -> pos, SUIntPtr (* 0x19 *)
-		| 0x1B ->
-			let pos, conv = read_compressed_i32 s pos in
-			let callconv = callconv_of_int conv in
-			let pos, ntypes = read_compressed_i32 s pos in
-			let pos, ret = read_ilsig ctx s pos in
-			let rec loop acc pos n =
-				if n >= ntypes then
-					pos, List.rev acc
-				else
-					let pos, ssig = read_ilsig ctx s pos in
-					loop (ssig :: acc) pos (n+1)
-			in
-			let pos, args = loop [] pos 1 in
-			pos, SFunPtr (callconv, ret, args)
-		| 0x1C -> pos, SObject (* 0x1C *)
-		| 0x1D ->
-			let pos, ssig = read_ilsig ctx s pos in
-			pos, SVector ssig
-		| 0x1E ->
-			let pos, conv = read_compressed_i32 s pos in
-			pos, SMethodTypeParam conv
-		| 0x1F ->
-			let pos, tdef = sread_from_table ctx true ITypeDefOrRef s pos in
-			let pos, ilsig = read_ilsig ctx s pos in
-			pos, SReqModifier (tdef, ilsig)
-		| 0x20 ->
-			let pos, tdef = sread_from_table ctx true ITypeDefOrRef s pos in
-			let pos, ilsig = read_ilsig ctx s pos in
-			pos, SOptModifier (tdef, ilsig)
-		| 0x41 -> pos, SSentinel (* 0x41 *)
-		| 0x45 ->
-			let pos, ssig = read_ilsig ctx s pos in
-			pos,SPinned ssig (* 0x45 *)
-		(* special undocumented constants *)
-		| 0x50 -> pos, SType
-		| 0x51 -> pos, SBoxed
-		| 0x55 ->
-			let pos, vt = read_inline_str s pos in
-			pos, SEnum vt
-		| _ ->
-			Printf.printf "unknown ilsig 0x%x\n\n" i;
-			assert false
-
-let rec read_variantsig ctx s pos =
-	let pos, b = sread_ui8 s pos in
-	match b with
-		| 0x00 -> pos, VT_EMPTY (* 0x00 *)
-		| 0x01 -> pos, VT_NULL (* 0x01 *)
-		| 0x02 -> pos, VT_I2 (* 0x02 *)
-		| 0x03 -> pos, VT_I4 (* 0x03 *)
-		| 0x04 -> pos, VT_R4 (* 0x04 *)
-		| 0x05 -> pos, VT_R8 (* 0x05 *)
-		| 0x06 -> pos, VT_CY (* 0x06 *)
-		| 0x07 -> pos, VT_DATE (* 0x07 *)
-		| 0x08 -> pos, VT_BSTR (* 0x08 *)
-		| 0x09 -> pos, VT_DISPATCH (* 0x09 *)
-		| 0x0A -> pos, VT_ERROR (* 0x0A *)
-		| 0x0B -> pos, VT_BOOL (* 0x0B *)
-		| 0x0C -> pos, VT_VARIANT (* 0x0C *)
-		| 0x0D -> pos, VT_UNKNOWN (* 0x0D *)
-		| 0x0E -> pos, VT_DECIMAL (* 0x0E *)
-		| 0x10 -> pos, VT_I1 (* 0x10 *)
-		| 0x11 -> pos, VT_UI1 (* 0x11 *)
-		| 0x12 -> pos, VT_UI2 (* 0x12 *)
-		| 0x13 -> pos, VT_UI4 (* 0x13 *)
-		| 0x14 -> pos, VT_I8 (* 0x14 *)
-		| 0x15 -> pos, VT_UI8 (* 0x15 *)
-		| 0x16 -> pos, VT_INT (* 0x16 *)
-		| 0x17 -> pos, VT_UINT (* 0x17 *)
-		| 0x18 -> pos, VT_VOID (* 0x18 *)
-		| 0x19 -> pos, VT_HRESULT (* 0x19 *)
-		| 0x1A -> pos, VT_PTR (* 0x1A *)
-		| 0x1B -> pos, VT_SAFEARRAY (* 0x1B *)
-		| 0x1C -> pos, VT_CARRAY (* 0x1C *)
-		| 0x1D -> pos, VT_USERDEFINED (* 0x1D *)
-		| 0x1E -> pos, VT_LPSTR (* 0x1E *)
-		| 0x1F -> pos, VT_LPWSTR (* 0x1F *)
-		| 0x24 -> pos, VT_RECORD (* 0x24 *)
-		| 0x40 -> pos, VT_FILETIME (* 0x40 *)
-		| 0x41 -> pos, VT_BLOB (* 0x41 *)
-		| 0x42 -> pos, VT_STREAM (* 0x42 *)
-		| 0x43 -> pos, VT_STORAGE (* 0x43 *)
-		| 0x44 -> pos, VT_STREAMED_OBJECT (* 0x44 *)
-		| 0x45 -> pos, VT_STORED_OBJECT (* 0x45 *)
-		| 0x46 -> pos, VT_BLOB_OBJECT (* 0x46 *)
-		| 0x47 -> pos, VT_CF (* 0x47 *)
-		| 0x48 -> pos, VT_CLSID (* 0x48 *)
-		| _ -> assert false
-
-let rec read_nativesig ctx s pos : int * nativesig =
-	let pos, b = sread_ui8 s pos in
-	match b with
-		| 0x01 -> pos, NVoid (* 0x01 *)
-		| 0x02 -> pos, NBool (* 0x02 *)
-		| 0x03 -> pos, NInt8 (* 0x03 *)
-		| 0x4 -> pos, NUInt8 (* 0x4 *)
-		| 0x5 -> pos, NInt16 (* 0x5 *)
-		| 0x6 -> pos, NUInt16 (* 0x6 *)
-		| 0x7 -> pos, NInt32 (* 0x7 *)
-		| 0x8 -> pos, NUInt32 (* 0x8 *)
-		| 0x9 -> pos, NInt64 (* 0x9 *)
-		| 0xA -> pos, NUInt64 (* 0xA *)
-		| 0xB -> pos, NFloat32 (* 0xB *)
-		| 0xC -> pos, NFloat64 (* 0xC *)
-		| 0xD -> pos, NSysChar (* 0xD *)
-		| 0xE -> pos, NVariant (* 0xE *)
-		| 0xF -> pos, NCurrency (* 0xF *)
-		| 0x10 -> pos, NPointer (* 0x10 *)
-		| 0x11 -> pos, NDecimal (* 0x11 *)
-		| 0x12 -> pos, NDate (* 0x12 *)
-		| 0x13 -> pos, NBStr (* 0x13 *)
-		| 0x14 -> pos, NLPStr (* 0x14 *)
-		| 0x15 -> pos, NLPWStr (* 0x15 *)
-		| 0x16 -> pos, NLPTStr (* 0x16 *)
-		| 0x17 ->
-			let pos, size = read_compressed_i32 s pos in
-			pos, NFixedString size
-		| 0x18 -> pos, NObjectRef (* 0x18 *)
-		| 0x19 -> pos, NUnknown (* 0x19 *)
-		| 0x1A -> pos, NDispatch (* 0x1A *)
-		| 0x1B -> pos, NStruct (* 0x1B *)
-		| 0x1C -> pos, NInterface (* 0x1C *)
-		| 0x1D ->
-			let pos, v = read_variantsig ctx s pos in
-			pos, NSafeArray v
-		| 0x1E ->
-			let pos, size = read_compressed_i32 s pos in
-			let pos, t = read_variantsig ctx s pos in
-			pos, NFixedArray (size,t)
-		| 0x1F -> pos, NIntPointer (* 0x1F *)
-		| 0x20 -> pos, NUIntPointer (* 0x20 *)
-		| 0x21 -> pos, NNestedStruct (* 0x21 *)
-		| 0x22 -> pos, NByValStr (* 0x22 *)
-		| 0x23 -> pos, NAnsiBStr (* 0x23 *)
-		| 0x24 -> pos, NTBStr (* 0x24 *)
-		| 0x25 -> pos, NVariantBool (* 0x25 *)
-		| 0x26 -> pos, NFunctionPtr (* 0x26 *)
-		| 0x28 -> pos, NAsAny (* 0x28 *)
-		| 0x2A ->
-			let pos, elt = read_nativesig ctx s pos in
-			let pos, paramidx = read_compressed_i32 s pos in
-			let pos, size = read_compressed_i32 s pos in
-			let pos, param_mult = read_compressed_i32 s pos in
-			pos, NArray(elt,paramidx,size,param_mult)
-		| 0x2B -> pos, NLPStruct (* 0x2B *)
-		| 0x2C ->
-			let pos, guid_val = read_inline_str s pos in
-			let pos, unmanaged = read_inline_str s pos in
-			(* FIXME: read TypeRef *)
-			pos, NCustomMarshaler (guid_val,unmanaged)
-		| 0x2D -> pos, NError (* 0x2D *)
-		| i -> pos, NCustom i
-
-let read_blob_idx ctx s pos =
-	let metapos,i = if ctx.blob_offset = 2 then
-			sread_ui16 s pos
-		else
-			sread_i32 s pos
-	in
-	metapos, i
-
-
-let read_nativesig_idx ctx s pos =
-	let s = ctx.meta_stream in
-	let metapos,i = if ctx.blob_offset = 2 then
-		sread_ui16 s pos
-	else
-		sread_i32 s pos
-	in
-	let s = ctx.blob_stream in
-	let _, ret = read_nativesig ctx s i in
-	metapos, ret
-
-let read_method_ilsig_idx ctx pos =
-	let s = ctx.meta_stream in
-	let metapos,i = if ctx.blob_offset = 2 then
-		sread_ui16 s pos
-	else
-		sread_i32 s pos
-	in
-	let s = ctx.blob_stream in
-	let pos, len = read_compressed_i32 s i in
-	(* for x = 0 to len do *)
-	(* 	printf "%x " (sget s (i+x)) *)
-	(* done; *)
-	let endpos = pos + len in
-	(* printf "\n"; *)
-	let pos, callconv = read_callconv ctx s pos in
-	let pos, ntypes = read_compressed_i32 s pos in
-	let pos, ret = read_ilsig ctx s pos in
-	let rec loop acc pos n =
-		if n > ntypes || pos >= endpos then
-			pos, List.rev acc
-		else
-			let pos, ssig = read_ilsig ctx s pos in
-			loop (ssig :: acc) pos (n+1)
-	in
-	let pos, args = loop [] pos 1 in
-	metapos, SFunPtr (callconv, ret, args)
-
-let read_ilsig_idx ctx pos =
-	let s = ctx.meta_stream in
-	let metapos,i = if ctx.blob_offset = 2 then
-		sread_ui16 s pos
-	else
-		sread_i32 s pos
-	in
-	let s = ctx.blob_stream in
-	let i, _ = read_compressed_i32 s i in
-	let _, ilsig = read_ilsig ctx s i in
-	metapos, ilsig
-
-let read_field_ilsig_idx ?(force_field=true) ctx pos =
-	let s = ctx.meta_stream in
-	let metapos,i = if ctx.blob_offset = 2 then
-		sread_ui16 s pos
-	else
-		sread_i32 s pos
-	in
-	let s = ctx.blob_stream in
-	let i, _ = read_compressed_i32 s i in
-	if sget s i <> 0x6 then
-		if force_field then
-			error ("Invalid field signature: " ^ string_of_int (sget s i))
-		else
-			read_method_ilsig_idx ctx pos
-	else
-		let _, ilsig = read_ilsig ctx s (i+1) in
-		metapos, ilsig
-
-let get_underlying_enum_type ctx name =
-  (* first try to get a typedef *)
-	let ns, name = match List.rev (String.nsplit name ".") with
-		| name :: ns -> List.rev ns, name
-		| _ -> assert false
-	in
-	try
-		let tdefs = ctx.tables.(int_of_table ITypeDef) in
-		let len = DynArray.length tdefs in
-		let rec loop_find idx =
-			if idx >= len then
-				raise Not_found
-			else
-				let tdef = match DynArray.get tdefs idx with | TypeDef td -> td | _ -> assert false in
-				if tdef.td_name = name && tdef.td_namespace = ns then
-					tdef
-				else
-					loop_find (idx+1)
-		in
-		let tdef = loop_find 1 in
-		(* now find the first static field associated with it *)
-		try
-			let nonstatic = List.find (fun f ->
-				not (List.mem CStatic f.f_flags.ff_contract)
-			) tdef.td_field_list in
-			nonstatic.f_signature
-		with | Not_found -> assert false (* should never happen! *)
-	with | Not_found ->
-		(* FIXME: in order to correctly handle SEnum, we need to look it up *)
-		(* from either this assembly or from any other assembly that we reference *)
-		(* this is tricky - specially since this reader does not intend to handle file system *)
-		(* operations by itself. For now, if an enum is referenced from another module, *)
-		(* we won't handle it. The `cache` structure is laid out to deal with these problems *)
-		(* but isn't implemented yet *)
-		raise Exit
-
-let read_custom_attr ctx attr_type s pos =
-	let pos, prolog = sread_ui16 s pos in
-	if prolog <> 0x0001 then error (sprintf "Error reading custom attribute: Expected prolog 0x0001 ; got 0x%x" prolog);
-	let isig = match attr_type with
-		| Method m -> m.m_signature
-		| MemberRef mr -> mr.memr_signature
-		| _ -> assert false
-	in
-	let args = match follow isig with
-		| SFunPtr (_,ret,args) -> args
-		| _ -> assert false
-	in
-	let rec read_instance ilsig pos =
-		(* print_endline (IlMetaDebug.ilsig_s ilsig); *)
-		match follow ilsig with
-		| SBool | SChar	| SInt8 | SUInt8 | SInt16 | SUInt16
-		| SInt32 | SUInt32 | SInt64 | SUInt64 | SFloat32 | SFloat64 | SString ->
-			let pos, cons = read_constant ctx (sig_to_const ilsig) s pos in
-			pos, InstConstant (cons)
-		| SClass c when is_type (["System"],"Type") c ->
-			if (sget s pos) == 0xff then
-				pos+1, InstConstant INull
-			else
-				let pos, len = read_compressed_i32 s pos in
-				pos+len, InstType (String.sub s pos len)
-		| SType ->
-			let pos, len = read_compressed_i32 s pos in
-			pos+len, InstType (String.sub s pos len)
-		| SObject | SBoxed -> (* boxed *)
-			let pos = if sget s pos = 0x51 then pos+1 else pos in
-			let pos, ilsig = read_ilsig ctx s pos in
-			let pos, ret = read_instance ilsig pos in
-			pos, InstBoxed( ret )
-			(* (match follow ilsig with *)
-			(* | SEnum e -> *)
-			(* 		let ilsig = get_underlying_enum_type ctx e; *)
-			(* 	let pos,e = if is_boxed then sread_i32 s pos else read_compressed_i32 s pos in *)
-			(* 	pos, InstBoxed(InstEnum e) *)
-			(* | _ -> *)
-			(* 	let pos, boxed = read_constant ctx (sig_to_const ilsig) s pos in *)
-			(* 	pos, InstBoxed (InstConstant boxed)) *)
-		| SEnum e ->
-			let ilsig = get_underlying_enum_type ctx e in
-			read_instance ilsig pos
-		| SValueType _ -> (* enum *)
-			let pos, e = sread_i32 s pos in
-			pos, InstEnum e
-		| _ -> assert false
-	in
-	let rec read_fixed acc args pos = match args with
-		| [] ->
-			pos, List.rev acc
-		| SVector isig :: args ->
-			(* print_endline "vec"; *)
-			let pos, nelem = sread_real_i32 s pos in
-			let pos, ret = if nelem = -1l then
-				pos, InstConstant INull
-			else
-				let nelem = Int32.to_int nelem in
-				let rec loop acc pos n =
-					if n = nelem then
-						pos, InstArray (List.rev acc)
-					else
-						let pos, inst = read_instance isig pos in
-						loop (inst :: acc) pos (n+1)
-				in
-				loop [] pos 0
-			in
-			read_fixed (ret :: acc) args pos
-		| isig :: args ->
-			let pos, i = read_instance isig pos in
-			read_fixed (i :: acc) args pos
-	in
-	(* let tpos = pos in *)
-	let pos, fixed = read_fixed [] args pos in
-	(* printf "fixed %d : " (List.length args); *)
-	(* for x = tpos to pos do *)
-	(* 	printf "%x " (sget s x) *)
-	(* done; *)
-	(* printf "\n"; *)
-	(* let len = String.length s - pos - 1 in *)
-	(* let len = if len > 10 then 10 else len in *)
-	(* for x = 0 to len do *)
-	(* 	printf "%x " (sget s (pos + x)) *)
-	(* done; *)
-	(* printf "\n"; *)
-	let pos, nnamed = read_compressed_i32 s pos in
-	let pos = if nnamed > 0 then pos+1 else pos in
-	(* FIXME: this is a hack / quick fix around #3485 . We need to actually read named arguments *)
-	(* let rec read_named acc pos n = *)
-	(* 	if n = nnamed then *)
-	(* 		pos, List.rev acc *)
-	(* 	else *)
-	(* 		let pos, forp = sread_ui8 s pos in *)
-	(* 		let is_prop = if forp = 0x53 then *)
-	(* 				false *)
-	(* 			else if forp = 0x54 then *)
-	(* 				true *)
-	(* 			else *)
-	(* 				error (sprintf "named custom attribute error: expected 0x53 or 0x54 - got 0x%x" forp) *)
-	(* 		in *)
-	(* 		let pos, t = read_ilsig ctx s pos in *)
-	(* 		let pos, len = read_compressed_i32 s pos in *)
-	(* 		let name = String.sub s pos len in *)
-	(* 		let pos = pos+len in *)
-	(* 		let pos, inst = read_instance t pos in *)
-	(* 		read_named ( (is_prop, name, inst) :: acc ) pos (n+1) *)
-	(* in *)
-	(* let pos, named = read_named [] pos 0 in *)
-	pos, (fixed, [])
-	(* pos, (fixed, named) *)
-
-let read_custom_attr_idx ctx ca attr_type pos =
-	let s = ctx.meta_stream in
-	let metapos,i = if ctx.blob_offset = 2 then
-		sread_ui16 s pos
-	else
-		sread_i32 s pos
-	in
-	if i = 0 then
-		metapos
-	else
-		let s = ctx.blob_stream in
-		let i, _ = read_compressed_i32 s i in
-		ctx.delays <- (fun () ->
-			try
-				let _, attr = read_custom_attr ctx attr_type s i in
-				ca.ca_value <- Some attr
-			with | Exit ->
-				()
-		) :: ctx.delays;
-		metapos
-
-let read_next_index ctx offset table last pos =
-	if last then
-		DynArray.length ctx.tables.(int_of_table table) + 1
-	else
-		let s = ctx.meta_stream in
-		let _, idx = ctx.table_sizes.(int_of_table table) s (pos+offset) in
-		idx
-
-let get_rev_list ctx table ptr_table begin_idx end_idx =
-	(* first check if index exists on pointer table *)
-	let ptr_table_t = ctx.tables.(int_of_table ptr_table) in
-	(* printf "table %d begin %d end %d\n" (int_of_table table) begin_idx end_idx; *)
-	match ctx.compressed, DynArray.length ptr_table_t with
-	| true, _ | _, 0 ->
-		(* use direct index *)
-		let rec loop idx acc =
-			if idx >= end_idx then
-				acc
-			else
-				loop (idx+1) (get_table ctx table idx :: acc)
-		in
-		loop begin_idx []
-	| _ ->
-		(* use indirect index *)
-		let rec loop idx acc =
-			if idx > end_idx then
-				acc
-			else
-				loop (idx+1) (get_table ctx ptr_table idx :: acc)
-		in
-		let ret = loop begin_idx [] in
-		List.map (fun meta ->
-			let p = meta_root_ptr meta in
-			get_table ctx table p.ptr_to.root_id
-		) ret
-
-let read_list ctx table ptr_table begin_idx offset last pos =
-	let end_idx = read_next_index ctx offset table last pos in
-	get_rev_list ctx table ptr_table begin_idx end_idx
-
-let parse_ns id = match String.nsplit id "." with
-	| [""] -> []
-	| ns -> ns
-
-let get_meta_pointer = function
-	| Module r -> IModule, r.md_id
-	| TypeRef r -> ITypeRef, r.tr_id
-	| TypeDef r -> ITypeDef, r.td_id
-	| FieldPtr r -> IFieldPtr, r.fp_id
-	| Field r -> IField, r.f_id
-	| MethodPtr r -> IMethodPtr, r.mp_id
-	| Method r -> IMethod, r.m_id
-	| ParamPtr r -> IParamPtr, r.pp_id
-	| Param r -> IParam, r.p_id
-	| InterfaceImpl r -> IInterfaceImpl, r.ii_id
-	| MemberRef r -> IMemberRef, r.memr_id
-	| Constant r -> IConstant, r.c_id
-	| CustomAttribute r -> ICustomAttribute, r.ca_id
-	| FieldMarshal r -> IFieldMarshal, r.fm_id
-	| DeclSecurity r -> IDeclSecurity, r.ds_id
-	| ClassLayout r -> IClassLayout, r.cl_id
-	| FieldLayout r -> IFieldLayout, r.fl_id
-	| StandAloneSig r -> IStandAloneSig, r.sa_id
-	| EventMap r -> IEventMap, r.em_id
-	| EventPtr r -> IEventPtr, r.ep_id
-	| Event r -> IEvent, r.e_id
-	| PropertyMap r -> IPropertyMap, r.pm_id
-	| PropertyPtr r -> IPropertyPtr, r.prp_id
-	| Property r -> IProperty, r.prop_id
-	| MethodSemantics r -> IMethodSemantics, r.ms_id
-	| MethodImpl r -> IMethodImpl, r.mi_id
-	| ModuleRef r -> IModuleRef, r.modr_id
-	| TypeSpec r -> ITypeSpec, r.ts_id
-	| ImplMap r -> IImplMap, r.im_id
-	| FieldRVA r -> IFieldRVA, r.fr_id
-	| ENCLog r -> IENCLog, r.el_id
-	| ENCMap r -> IENCMap, r.encm_id
-	| Assembly r -> IAssembly, r.a_id
-	| AssemblyProcessor r -> IAssemblyProcessor, r.ap_id
-	| AssemblyOS r -> IAssemblyOS, r.aos_id
-	| AssemblyRef r -> IAssemblyRef, r.ar_id
-	| AssemblyRefProcessor r -> IAssemblyRefProcessor, r.arp_id
-	| AssemblyRefOS r -> IAssemblyRefOS, r.aros_id
-	| File r -> IFile, r.file_id
-	| ExportedType r -> IExportedType, r.et_id
-	| ManifestResource r -> IManifestResource, r.mr_id
-	| NestedClass r -> INestedClass, r.nc_id
-	| GenericParam r -> IGenericParam, r.gp_id
-	| MethodSpec r -> IMethodSpec, r.mspec_id
-	| GenericParamConstraint r -> IGenericParamConstraint, r.gc_id
-	| _ -> assert false
-
-let add_relation ctx key v =
-	let ptr = get_meta_pointer key in
-	Hashtbl.add ctx.relations ptr v
-
-let read_table_at ctx tbl n last pos =
-	(* print_endline ("rr " ^ string_of_int (n+1)); *)
-	let s = ctx.meta_stream in
-	match get_table ctx tbl (n+1 (* indices start at 1 *)) with
-	| Module m ->
-		let pos, gen = sread_ui16 s pos in
-		let pos, name = read_sstring_idx ctx pos in
-		let pos, vid = read_sguid_idx ctx pos in
-		let pos, encid = read_sguid_idx ctx pos in
-		let pos, encbase_id = read_sguid_idx ctx pos in
-		m.md_generation <- gen;
-		m.md_name <- name;
-		m.md_vid <- vid;
-		m.md_encid <- encid;
-		m.md_encbase_id <- encbase_id;
-		pos, Module m
-	| TypeRef tr ->
-		let pos, scope = sread_from_table ctx false IResolutionScope s pos in
-		let pos, name = read_sstring_idx ctx pos in
-		let pos, ns = read_sstring_idx ctx pos in
-		tr.tr_resolution_scope <- scope;
-		tr.tr_name <- name;
-		tr.tr_namespace <- parse_ns ns;
-		(* print_endline name; *)
-		(* print_endline ns; *)
-		pos, TypeRef tr
-	| TypeDef td ->
-		let startpos = pos in
-		let pos, flags = sread_i32 s pos in
-		let pos, name = read_sstring_idx ctx pos in
-		let pos, ns = read_sstring_idx ctx pos in
-		let ns = parse_ns ns in
-		let pos, extends = sread_from_table_opt ctx false ITypeDefOrRef s pos in
-		let field_offset = pos - startpos in
-		let pos, flist_begin = ctx.table_sizes.(int_of_table IField) s pos in
-		let method_offset = pos - startpos in
-		let pos, mlist_begin = ctx.table_sizes.(int_of_table IMethod) s pos in
-		td.td_flags <- type_def_flags_of_int flags;
-		td.td_name <- name;
-		td.td_namespace <- ns;
-		td.td_extends <- extends;
-		td.td_field_list <- List.rev_map get_field (read_list ctx IField IFieldPtr flist_begin field_offset last pos);
-		td.td_method_list <- List.rev_map get_method (read_list ctx IMethod IMethodPtr mlist_begin method_offset last pos);
-		List.iter (fun m -> m.m_declaring <- Some td) td.td_method_list;
-		let path = get_path (TypeDef td) in
-		Hashtbl.add ctx.typedefs path td;
-		(* print_endline "Type Def!"; *)
-		(* print_endline name; *)
-		(* print_endline ns; *)
-		pos, TypeDef td
-	| FieldPtr fp ->
-		let pos, field = sread_from_table ctx false IField s pos in
-		let field = get_field field in
-		fp.fp_field <- field;
-		pos, FieldPtr fp
-	| Field f ->
-		let pos, flags = sread_ui16 s pos in
-		let pos, name = read_sstring_idx ctx pos in
-		(* print_endline ("FIELD NAME " ^ name); *)
-		let pos, ilsig = read_field_ilsig_idx ctx pos in
-		(* print_endline (ilsig_s ilsig); *)
-		f.f_flags <- field_flags_of_int flags;
-		f.f_name <- name;
-		f.f_signature <- ilsig;
-		pos, Field f
-	| MethodPtr mp ->
-		let pos, m = sread_from_table ctx false IMethod s pos in
-		let m = get_method m in
-		mp.mp_method <- m;
-		pos, MethodPtr mp
-	| Method m ->
-		let startpos = pos in
-		let pos, rva = sread_i32 s pos in
-		let pos, iflags = sread_ui16 s pos in
-		let pos, flags = sread_ui16 s pos in
-		let pos, name = read_sstring_idx ctx pos in
-		let pos, ilsig = read_method_ilsig_idx ctx pos in
-		let offset = pos - startpos in
-		let pos, paramlist = ctx.table_sizes.(int_of_table IParam) s pos in
-		m.m_rva <- Int32.of_int rva;
-		m.m_flags <- method_flags_of_int iflags flags;
-		m.m_name <- name;
-		m.m_signature <- ilsig;
-		m.m_param_list <- List.rev_map get_param (read_list ctx IParam IParamPtr paramlist offset last pos);
-		pos, Method m
-	| ParamPtr pp ->
-		let pos, p = sread_from_table ctx false IParam s pos in
-		let p = get_param p in
-		pp.pp_param <- p;
-		pos, ParamPtr pp
-	| Param p ->
-		let pos, flags = sread_ui16 s pos in
-		let pos, sequence = sread_ui16 s pos in
-		let pos, name = read_sstring_idx ctx pos in
-		p.p_flags <- param_flags_of_int flags;
-		p.p_sequence <- sequence;
-		p.p_name <- name;
-		pos, Param p
-	| InterfaceImpl ii ->
-		let pos, cls = sread_from_table ctx false ITypeDef s pos in
-		add_relation ctx cls (InterfaceImpl ii);
-		let cls = get_type_def cls in
-		let pos, interface  = sread_from_table ctx false ITypeDefOrRef s pos in
-		ii.ii_class <- cls;
-		ii.ii_interface <- interface;
-		pos, InterfaceImpl ii
-	| MemberRef mr ->
-		let pos, cls = sread_from_table ctx false IMemberRefParent s pos in
-		let pos, name = read_sstring_idx ctx pos in
-		(* print_endline name; *)
-		(* let pos, signature = read_ilsig_idx ctx pos in *)
-		let pos, signature = read_field_ilsig_idx ~force_field:false ctx pos in
-		(* print_endline (ilsig_s signature); *)
-		mr.memr_class <- cls;
-		mr.memr_name <- name;
-		mr.memr_signature <- signature;
-		add_relation ctx cls (MemberRef mr);
-		pos, MemberRef mr
-	| Constant c ->
-		let pos, ctype = read_constant_type ctx s pos in
-		let pos = pos+1 in
-		let pos, parent = sread_from_table ctx false IHasConstant s pos in
-		let pos, blobpos = if ctx.blob_offset = 2 then
-				sread_ui16 s pos
-			else
-				sread_i32 s pos
-		in
-		let blob = ctx.blob_stream in
-		let blobpos, _ = read_compressed_i32 blob blobpos in
-		let _, value = read_constant ctx ctype blob blobpos in
-		c.c_type <- ctype;
-		c.c_parent <- parent;
-		c.c_value <- value;
-		add_relation ctx parent (Constant c);
-		pos, Constant c
-	| CustomAttribute ca ->
-		let pos, parent = sread_from_table ctx false IHasCustomAttribute s pos in
-		let pos, t = sread_from_table ctx false ICustomAttributeType s pos in
-		let pos = read_custom_attr_idx ctx ca t pos in
-		ca.ca_parent <- parent;
-		ca.ca_type <- t;
-		ca.ca_value <- None; (* this will be delayed by read_custom_attr_idx *)
-		add_relation ctx parent (CustomAttribute ca);
-		pos, CustomAttribute ca
-	| FieldMarshal fm ->
-		let pos, parent = sread_from_table ctx false IHasFieldMarshal s pos in
-		let pos, nativesig = read_nativesig_idx ctx s pos in
-		fm.fm_parent <- parent;
-		fm.fm_native_type <- nativesig;
-		add_relation ctx parent (FieldMarshal fm);
-		pos, FieldMarshal fm
-	| DeclSecurity ds ->
-		let pos, action = sread_ui16 s pos in
-		let action = action_security_of_int action in
-		let pos, parent = sread_from_table ctx false IHasDeclSecurity s pos in
-		let pos, permission_set = read_sblob_idx ctx pos in
-		ds.ds_action <- action;
-		ds.ds_parent <- parent;
-		ds.ds_permission_set <- permission_set;
-		add_relation ctx parent (DeclSecurity ds);
-		pos, DeclSecurity ds
-	| ClassLayout cl ->
-		let pos, psize = sread_ui16 s pos in
-		let pos, csize = sread_i32 s pos in
-		let pos, parent = sread_from_table ctx false ITypeDef s pos in
-		add_relation ctx parent (ClassLayout cl);
-		let parent = get_type_def parent in
-		cl.cl_packing_size <- psize;
-		cl.cl_class_size <- csize;
-		cl.cl_parent <- parent;
-		pos, ClassLayout cl
-	| FieldLayout fl ->
-		let pos, offset = sread_i32 s pos in
-		let pos, field = sread_from_table ctx false IField s pos in
-		fl.fl_offset <- offset;
-		fl.fl_field <- get_field field;
-		add_relation ctx field (FieldLayout fl);
-		pos, FieldLayout fl
-	| StandAloneSig sa ->
-		let pos, ilsig = read_field_ilsig_idx ~force_field:false ctx pos in
-		(* print_endline (ilsig_s ilsig); *)
-		sa.sa_signature <- ilsig;
-		pos, StandAloneSig sa
-	| EventMap em ->
-		let startpos = pos in
-		let pos, parent = sread_from_table ctx false ITypeDef s pos in
-		let offset = pos - startpos in
-		let pos, event_list = ctx.table_sizes.(int_of_table IEvent) s pos in
-		em.em_parent <- get_type_def parent;
-		em.em_event_list <- List.rev_map get_event (read_list ctx IEvent IEventPtr event_list offset last pos);
-		add_relation ctx parent (EventMap em);
-		pos, EventMap em
-	| EventPtr ep ->
-		let pos, event = sread_from_table ctx false IEvent s pos in
-		ep.ep_event <- get_event event;
-		pos, EventPtr ep
-	| Event e ->
-		let pos, flags = sread_ui16 s pos in
-		let pos, name = read_sstring_idx ctx pos in
-		let pos, event_type = sread_from_table ctx false ITypeDefOrRef s pos in
-		e.e_flags <- event_flags_of_int flags;
-		e.e_name <- name;
-		(* print_endline name; *)
-		e.e_event_type <- event_type;
-		add_relation ctx event_type (Event e);
-		pos, Event e
-	| PropertyMap pm ->
-		let startpos = pos in
-		let pos, parent = sread_from_table ctx false ITypeDef s pos in
-		let offset = pos - startpos in
-		let pos, property_list = ctx.table_sizes.(int_of_table IProperty) s pos in
-		pm.pm_parent <- get_type_def parent;
-		pm.pm_property_list <- List.rev_map get_property (read_list ctx IProperty IPropertyPtr property_list offset last pos);
-		add_relation ctx parent (PropertyMap pm);
-		pos, PropertyMap pm
-	| PropertyPtr pp ->
-		let pos, property = sread_from_table ctx false IProperty s pos in
-		pp.prp_property <- get_property property;
-		pos, PropertyPtr pp
-	| Property prop ->
-		let pos, flags = sread_ui16 s pos in
-		let pos, name = read_sstring_idx ctx pos in
-		let pos, t = read_field_ilsig_idx ~force_field:false ctx pos in
-		prop.prop_flags <- property_flags_of_int flags;
-		prop.prop_name <- name;
-		(* print_endline name; *)
-		prop.prop_type <- t;
-		(* print_endline (ilsig_s t); *)
-		pos, Property prop
-	| MethodSemantics ms ->
-		let pos, semantic = sread_ui16 s pos in
-		let pos, m = sread_from_table ctx false IMethod s pos in
-		let pos, association = sread_from_table ctx false IHasSemantics s pos in
-		ms.ms_semantic <- semantic_flags_of_int semantic;
-		ms.ms_method <- get_method m;
-		ms.ms_association <- association;
-		add_relation ctx m (MethodSemantics ms);
-		add_relation ctx association (MethodSemantics ms);
-		pos, MethodSemantics ms
-	| MethodImpl mi ->
-		let pos, cls = sread_from_table ctx false ITypeDef s pos in
-		let pos, method_body = sread_from_table ctx false IMethodDefOrRef s pos in
-		let pos, method_declaration = sread_from_table ctx false IMethodDefOrRef s pos in
-		mi.mi_class <- get_type_def cls;
-		mi.mi_method_body <- method_body;
-		mi.mi_method_declaration <- method_declaration;
-		add_relation ctx method_body (MethodImpl mi);
-		pos, MethodImpl mi
-	| ModuleRef modr ->
-		let pos, name = read_sstring_idx ctx pos in
-		modr.modr_name <- name;
-		(* print_endline name; *)
-		pos, ModuleRef modr
-	| TypeSpec ts ->
-		let pos, signature = read_ilsig_idx ctx pos in
-		(* print_endline (ilsig_s signature); *)
-		ts.ts_signature <- signature;
-		pos, TypeSpec ts
-	| ENCLog el ->
-		let pos, token = sread_i32 s pos in
-		let pos, func_code = sread_i32 s pos in
-		el.el_token <- token;
-		el.el_func_code <- func_code;
-		pos, ENCLog el
-	| ImplMap im ->
-		let pos, flags = sread_ui16 s pos in
-		let pos, forwarded = sread_from_table ctx false IMemberForwarded s pos in
-		let pos, import_name = read_sstring_idx ctx pos in
-		let pos, import_scope = sread_from_table ctx false IModuleRef s pos in
-		im.im_flags <- impl_flags_of_int flags;
-		im.im_forwarded <- forwarded;
-		im.im_import_name <- import_name;
-		im.im_import_scope <- get_module_ref import_scope;
-		add_relation ctx forwarded (ImplMap im);
-		pos, ImplMap im
-	| ENCMap em ->
-		let pos, token = sread_i32 s pos in
-		em.encm_token <- token;
-		pos, ENCMap em
-	| FieldRVA f ->
-		let pos, rva = sread_real_i32 s pos in
-		let pos, field = sread_from_table ctx false IField s pos in
-		f.fr_rva <- rva;
-		f.fr_field <- get_field field;
-		add_relation ctx field (FieldRVA f);
-		pos, FieldRVA f
-	| Assembly a ->
-		let pos, hash_algo = sread_i32 s pos in
-		let pos, major = sread_ui16 s pos in
-		let pos, minor = sread_ui16 s pos in
-		let pos, build = sread_ui16 s pos in
-		let pos, rev = sread_ui16 s pos in
-		let pos, flags = sread_i32 s pos in
-		let pos, public_key = read_sblob_idx ctx pos in
-		let pos, name = read_sstring_idx ctx pos in
-		let pos, locale = read_sstring_idx ctx pos in
-		a.a_hash_algo <- hash_algo_of_int hash_algo;
-		a.a_major <- major;
-		a.a_minor <- minor;
-		a.a_build <- build;
-		a.a_rev <- rev;
-		a.a_flags <- assembly_flags_of_int flags;
-		a.a_public_key <- public_key;
-		a.a_name <- name;
-		a.a_locale <- locale;
-		pos, Assembly a
-	| AssemblyProcessor ap ->
-		let pos, processor = sread_i32 s pos in
-		ap.ap_processor <- processor;
-		pos, AssemblyProcessor ap
-	| AssemblyOS aos ->
-		let pos, platform_id = sread_i32 s pos in
-		let pos, major = sread_i32 s pos in
-		let pos, minor = sread_i32 s pos in
-		aos.aos_platform_id <- platform_id;
-		aos.aos_major_version <- major;
-		aos.aos_minor_version <- minor;
-		pos, AssemblyOS aos
-	| AssemblyRef ar ->
-		let pos, major = sread_ui16 s pos in
-		let pos, minor = sread_ui16 s pos in
-		let pos, build = sread_ui16 s pos in
-		let pos, rev = sread_ui16 s pos in
-		let pos, flags = sread_i32 s pos in
-		let pos, public_key = read_sblob_idx ctx pos in
-		let pos, name = read_sstring_idx ctx pos in
-		let pos, locale = read_sstring_idx ctx pos in
-		let pos, hash_value = read_sblob_idx ctx pos in
-		ar.ar_major <- major;
-		ar.ar_minor <- minor;
-		ar.ar_build <- build;
-		ar.ar_rev <- rev;
-		ar.ar_flags <- assembly_flags_of_int flags;
-		ar.ar_public_key <- public_key;
-		ar.ar_name <- name;
-		(* print_endline name; *)
-		ar.ar_locale <- locale;
-		(* print_endline locale; *)
-		ar.ar_hash_value <- hash_value;
-		pos, AssemblyRef ar
-	| AssemblyRefProcessor arp ->
-		let pos, processor = sread_i32 s pos in
-		let pos, assembly_ref = sread_from_table ctx false IAssemblyRef s pos in
-		arp.arp_processor <- processor;
-		arp.arp_assembly_ref <- get_assembly_ref assembly_ref;
-		pos, AssemblyRefProcessor arp
-	| AssemblyRefOS aros ->
-		let pos, platform_id = sread_i32 s pos in
-		let pos, major = sread_i32 s pos in
-		let pos, minor = sread_i32 s pos in
-		let pos, assembly_ref = sread_from_table ctx false IAssemblyRef s pos in
-		aros.aros_platform_id <- platform_id;
-		aros.aros_major <- major;
-		aros.aros_minor <- minor;
-		aros.aros_assembly_ref <- get_assembly_ref assembly_ref;
-		pos, AssemblyRefOS aros
-	| File file ->
-		let pos, flags = sread_i32 s pos in
-		let pos, name = read_sstring_idx ctx pos in
-		let pos, hash_value = read_sblob_idx ctx pos in
-		file.file_flags <- file_flag_of_int flags;
-		file.file_name <- name;
-		(* print_endline ("file " ^ name); *)
-		file.file_hash_value <- hash_value;
-		pos, File file
-	| ExportedType et ->
-		let pos, flags = sread_i32 s pos in
-		let pos, type_def_id = sread_i32 s pos in
-		let pos, type_name = read_sstring_idx ctx pos in
-		let pos, type_namespace = read_sstring_idx ctx pos in
-		let pos, impl = sread_from_table ctx false IImplementation s pos in
-		et.et_flags <- type_def_flags_of_int flags;
-		et.et_type_def_id <- type_def_id;
-		et.et_type_name <- type_name;
-		et.et_type_namespace <- parse_ns type_namespace;
-		et.et_implementation <- impl;
-		add_relation ctx impl (ExportedType et);
-		pos, ExportedType et
-	| ManifestResource mr ->
-		let pos, offset = sread_i32 s pos in
-		let pos, flags = sread_i32 s pos in
-		(* printf "offset 0x%x flags 0x%x\n" offset flags; *)
-		let pos, name = read_sstring_idx ctx pos in
-		let rpos, i = ctx.table_sizes.(int_of_table IImplementation) s pos in
-		let pos, impl =
-			if i = 0 then
-				rpos, None
-			else
-				let pos, ret = sread_from_table ctx false IImplementation s pos in
-				add_relation ctx ret (ManifestResource mr);
-				pos, Some ret
-		in
-		mr.mr_offset <- offset;
-		mr.mr_flags <- manifest_resource_flag_of_int flags;
-		mr.mr_name <- name;
-		mr.mr_implementation <- impl;
-		pos, ManifestResource mr
-	| NestedClass nc ->
-		let pos, nested = sread_from_table ctx false ITypeDef s pos in
-		let pos, enclosing = sread_from_table ctx false ITypeDef s pos in
-		nc.nc_nested <- get_type_def nested;
-		nc.nc_enclosing <- get_type_def enclosing;
-
-		assert (nc.nc_nested.td_extra_enclosing = None);
-		nc.nc_nested.td_extra_enclosing <- Some nc.nc_enclosing;
-		add_relation ctx enclosing (NestedClass nc);
-		pos, NestedClass nc
-	| GenericParam gp ->
-		let pos, number = sread_ui16 s pos in
-		let pos, flags = sread_ui16 s pos in
-		let pos, owner = sread_from_table ctx false ITypeOrMethodDef s pos in
-		let spos, nidx =
-			if ctx.strings_offset = 2 then
-				sread_ui16 s pos
-			else
-				sread_i32 s pos
-		in
-		let pos, name =
-			if nidx = 0 then
-				spos, None
-			else
-				let pos, ret = read_sstring_idx ctx pos in
-				(* print_endline ret; *)
-				pos, Some ret
-		in
-		gp.gp_number <- number;
-		gp.gp_flags <- generic_flags_of_int flags;
-		gp.gp_owner <- owner;
-		gp.gp_name <- name;
-		add_relation ctx owner (GenericParam gp);
-		pos, GenericParam gp
-	| MethodSpec mspec ->
-		let pos, meth = sread_from_table ctx false IMethodDefOrRef s pos in
-		let pos, instantiation = read_method_ilsig_idx ctx pos in
-		(* print_endline (ilsig_s instantiation); *)
-		mspec.mspec_method <- meth;
-		mspec.mspec_instantiation <- instantiation;
-		add_relation ctx meth (MethodSpec mspec);
-		pos, MethodSpec mspec
-	| GenericParamConstraint gc ->
-		let pos, owner = sread_from_table ctx false IGenericParam s pos in
-		let pos, c = sread_from_table ctx false ITypeDefOrRef s pos in
-		gc.gc_owner <- get_generic_param owner;
-		gc.gc_constraint <- c;
-		add_relation ctx owner (GenericParamConstraint gc);
-		pos, GenericParamConstraint gc
-	| _ -> assert false
-
-(* ******* META READING ********* *)
-
-let preset_sizes ctx rows =
-	Array.iteri (fun n r -> match r with
-		| false,_ -> ()
-		| true,nrows ->
-			(* printf "table %d nrows %d\n" n nrows; *)
-			let tbl = table_of_int n in
-			ctx.tables.(n) <- DynArray.init (nrows) (fun id -> mk_meta tbl (id+1))
-	) rows
-
-(* let read_ *)
-let read_meta ctx =
-	(* read header *)
-	let s = ctx.meta_stream in
-	let pos = 4 + 1 + 1 in
-	let flags = sget s pos in
-	List.iter (fun i -> if flags land i = i then match i with
-		| 0x01 ->
-			ctx.strings_offset <- 4
-		| 0x02 ->
-			ctx.guid_offset <- 4
-		| 0x04 ->
-			ctx.blob_offset <- 4
-		| 0x20 ->
-			assert (not ctx.compressed);
-			ctx.meta_edit_continue <- true
-		| 0x80 ->
-			assert (not ctx.compressed);
-			ctx.meta_has_deleted <- true
-		| _ -> assert false
-	) [0x01;0x02;0x04;0x20;0x80];
-	let rid = sget s (pos+1) in
-	ignore rid;
-	let pos = pos + 2 in
-	let mask = Array.init 8 ( fun n -> sget s (pos + n) ) in
-	(* loop over masks and check which table is set *)
-	let set_table = Array.init 64 (fun n ->
-		let idx = n / 8 in
-		let bit = n mod 8 in
-		(mask.(idx) lsr bit) land 0x1 = 0x1
-	) in
-	let pos = ref (pos + 8 + 8) in (* there is an extra 'sorted' field, which we do not use *)
-	let rows = Array.mapi (fun i b -> match b with
-		| false -> false,0
-		| true ->
-			let nidx, nrows = sread_i32 s !pos in
-			if nrows > 0xFFFF then ctx.table_sizes.(i) <- sread_i32;
-			pos := nidx;
-			true,nrows
-	) set_table in
-	set_coded_sizes ctx rows;
-	(* pre-set all sizes *)
-	preset_sizes ctx rows;
-	Array.iteri (fun n r -> match r with
-		| false,_ -> ()
-		| true,nrows ->
-			(* print_endline (string_of_int n); *)
-			let fn = read_table_at ctx (table_of_int n) in
-			let rec loop_fn n =
-				if n = nrows then
-					()
-				else begin
-					let p, _ = fn n (n = (nrows-1)) !pos in
-					pos := p;
-					loop_fn (n+1)
-				end
-			in
-			loop_fn 0
-	) rows;
-	()
-
-let read_padded i npad =
-	let buf = Buffer.create 10 in
-	let rec loop n =
-		let chr = read i in
-		if chr = '\x00' then begin
-			let npad = n land 0x3 in
-			if npad <> 0 then ignore (nread i (4 - npad));
-			Buffer.contents buf
-		end else begin
-			Buffer.add_char buf chr;
-			if n = npad then
-				Buffer.contents buf
-			else
-				loop (n+1)
-		end
-	in
-	loop 1
-
-let read_meta_tables pctx header module_cache =
-	let i = pctx.r.i in
-	seek_rva pctx (fst header.clr_meta);
-	let magic = nread_string i 4 in
-	if magic <> "BSJB" then error ("Error reading metadata table: Expected magic 'BSJB'. Got " ^ magic);
-	let major = read_ui16 i in
-	let minor = read_ui16 i in
-	ignore major; ignore minor; (* no use for them *)
-	ignore (read_i32 i); (* reserved *)
-	let vlen = read_i32 i in
-	let ver = nread i vlen in
-	ignore ver;
-
-	(* meta storage header *)
-	ignore (read_ui16 i); (* reserved *)
-	let nstreams = read_ui16 i in
-	let rec streams n acc =
-		let offset = read_i32 i in
-		let size = read_real_i32 i in
-		let name = read_padded i 32 in
-		let acc = {
-			str_offset = offset;
-			str_size = size;
-			str_name = name;
-		} :: acc in
-		if (n+1) = nstreams then
-			acc
-		else
-			streams (n+1) acc
-	in
-	let streams = streams 0 [] in
-
-	(* streams *)
-	let compressed = ref None in
-	let sstrings = ref "" in
-	let sblob = ref "" in
-	let sguid = ref "" in
-	let sus = ref "" in
-	let smeta = ref "" in
-	let extra = ref [] in
-	List.iter (fun s ->
-		let rva = Int32.add (fst header.clr_meta) (Int32.of_int s.str_offset) in
-		seek_rva pctx rva;
-		match String.lowercase s.str_name with
-		| "#guid" ->
-			sguid := nread_string i (Int32.to_int s.str_size)
-		| "#strings" ->
-			sstrings := nread_string i (Int32.to_int s.str_size)
-		| "#us" ->
-			sus := nread_string i (Int32.to_int s.str_size)
-		| "#blob" ->
-			sblob := nread_string i (Int32.to_int s.str_size)
-		| "#~" ->
-			assert (Option.is_none !compressed);
-			compressed := Some true;
-			smeta := nread_string i (Int32.to_int s.str_size)
-		| "#-" ->
-			assert (Option.is_none !compressed);
-			compressed := Some false;
-			smeta := nread_string i (Int32.to_int s.str_size)
-		| _ ->
-			extra := s :: !extra
-	) streams;
-	let compressed = match !compressed with
-		| None -> error "No compressed or uncompressed metadata streams was found!"
-		| Some c -> c
-	in
-	let tables = Array.init 64 (fun _ -> DynArray.create ()) in
-	let ctx = {
-		compressed = compressed;
-		strings_stream = !sstrings;
-		strings_offset = 2;
-		blob_stream = !sblob;
-		blob_offset = 2;
-		guid_stream = !sguid;
-		guid_offset = 2;
-		us_stream = !sus;
-		meta_stream = !smeta;
-		meta_edit_continue = false;
-		meta_has_deleted = false;
-
-    module_cache = module_cache;
-		extra_streams = !extra;
-		relations = Hashtbl.create 64;
-		typedefs = Hashtbl.create 64;
-		tables = tables;
-		table_sizes = Array.make (max_clr_meta_idx+1) sread_ui16;
-
-		delays = [];
-	} in
-	read_meta ctx;
-	let delays = ctx.delays in
-	ctx.delays <- [];
-	List.iter (fun fn -> fn()) delays;
-	assert (ctx.delays = []);
-	{
-		il_tables = ctx.tables;
-		il_relations = ctx.relations;
-		il_typedefs = ctx.typedefs;
-	}
-

libs/ilib/ilMetaTools.ml

@@ -1,472 +0,0 @@
-(*
- *  This file is part of ilLib
- *  Copyright (c)2004-2013 Haxe Foundation
- *
- *  This program is free software; you can redistribute it and/or modify
- *  it under the terms of the GNU General Public License as published by
- *  the Free Software Foundation; either version 2 of the License, or
- *  (at your option) any later version.
- *
- *  This program is distributed in the hope that it will be useful,
- *  but WITHOUT ANY WARRANTY; without even the implied warranty of
- *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- *  GNU General Public License for more details.
- *
- *  You should have received a copy of the GNU General Public License
- *  along with this program; if not, write to the Free Software
- *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
- *)
-open IlMeta;;
-open IlData;;
-open PeReader;;
-open ExtString;;
-
-let rec follow s = match s with
-	| SReqModifier (_,s)
-	| SOptModifier (_,s) ->
-		follow s
-	| SPinned s ->
-		follow s
-	| s -> s
-
-(* tells if a type_def_or_ref is of type `path` *)
-let rec is_type path = function
-	| TypeDef td ->
-		td.td_namespace = fst path && td.td_name = snd path
-	| TypeRef tr ->
-		tr.tr_namespace = fst path && tr.tr_name = snd path
-	| TypeSpec ts -> (match follow ts.ts_signature with
-	| SClass c | SValueType c ->
-		is_type path c
-	| SGenericInst(s,_) -> (match follow s with
-		| SClass c | SValueType c ->
-			is_type path c
-		| _ -> false)
-	| _ -> false)
-	| _ -> assert false
-
-let rec get_path type_def_or_ref = match type_def_or_ref with
-	| TypeDef td -> (match td.td_extra_enclosing with
-		| None ->
-			td.td_namespace,[], td.td_name
-		| Some t2 ->
-			let ns, nested = match get_path (TypeDef t2) with
-				| ns,nested, name ->
-					ns, nested @ [name]
-			in
-			ns,nested, td.td_name)
-	| TypeRef tr -> (match tr.tr_resolution_scope with
-		| TypeRef tr2 ->
-			let ns, nested = match get_path (TypeRef tr2) with
-				| ns,nested, name ->
-					ns, nested @ [name]
-			in
-			ns,nested, tr.tr_name
-		| _ ->
-			tr.tr_namespace,[],tr.tr_name)
-	| TypeSpec ts -> (match follow ts.ts_signature with
-	| SClass c | SValueType c ->
-		get_path c
-	| SGenericInst(s,_) -> (match follow s with
-		| SClass c | SValueType c ->
-			get_path c
-		| _ -> [],[],"")
-	| _ -> [],[],"")
-	| _ -> assert false
-
-let constant_s = function
-	| IBool true -> "true"
-	| IBool false -> "false"
-	| IChar chr -> "'" ^ Char.escaped (Char.chr chr) ^ "'"
-	| IByte i ->
-		Printf.sprintf "(byte) 0x%x" i
-	| IShort i ->
-		Printf.sprintf "(short) 0x%x" i
-	| IInt i ->
-		Printf.sprintf "0x%lx" i
-	| IInt64 i ->
-		Printf.sprintf "0x%Lx" i
-	| IFloat32 f ->
-		Printf.sprintf "%ff" f
-	| IFloat64 f ->
-		Printf.sprintf "%fd" f
-	| IString s -> "\"" ^ s ^ "\""
-	| INull -> "null"
-
-let path_s = function
-	| [],[], s -> s
-	| ns,[], s -> String.concat "." ns ^ "." ^ s
-	| [],enc, s -> String.concat "@" enc ^ "." ^ s
-	| ns,enc,s -> String.concat "." ns ^ "." ^ String.concat "@" enc ^ "." ^ s
-
-let rec ilsig_s = function
-	| SBoxed -> "boxed"
-	| SEnum e -> "enum " ^ e
-	| SType -> "System.Type"
-	| SVoid -> "void"
-	| SBool -> "bool"
-	| SChar -> "char"
-	| SInt8 -> "int8"
-	| SUInt8 -> "uint8"
-	| SInt16 -> "int16"
-	| SUInt16 -> "uint16"
-	| SInt32 -> "int32"
-	| SUInt32 -> "uint32"
-	| SInt64 -> "int64"
-	| SUInt64 -> "uint64"
-	| SFloat32 -> "float"
-	| SFloat64 -> "double"
-	| SString -> "string"
-	| SPointer s -> ilsig_s s ^ "*"
-	| SManagedPointer s -> ilsig_s s ^ "&"
-	| SValueType td -> "valuetype " ^ path_s (get_path td)
-	| SClass cl -> "classtype " ^ path_s (get_path cl)
-	| STypeParam t | SMethodTypeParam t -> "!" ^ string_of_int t
-	| SArray (s,opts) ->
-		ilsig_s s ^ "[" ^ String.concat "," (List.map (function
-			| Some i,None when i <> 0 ->
-				string_of_int i ^ "..."
-			| None, Some i when i <> 0 ->
-				string_of_int i
-			| Some s, Some b when b = 0 && s <> 0 ->
-				string_of_int s ^ "..."
-			| Some s, Some b when s <> 0 || b <> 0 ->
-				let b = if b > 0 then b - 1 else b in
-				string_of_int s ^ "..." ^ string_of_int (s + b)
-			| _ ->
-				""
-		) (Array.to_list opts)) ^ "]"
-	| SGenericInst (t,tl) ->
-		"generic " ^ (ilsig_s t) ^ "<" ^ String.concat ", " (List.map ilsig_s tl) ^ ">"
-	| STypedReference -> "typedreference"
-	| SIntPtr -> "native int"
-	| SUIntPtr -> "native unsigned int"
-	| SFunPtr (callconv,ret,args) ->
-		"function " ^ ilsig_s ret ^ "(" ^ String.concat ", " (List.map ilsig_s args) ^ ")"
-	| SObject -> "object"
-	| SVector s -> ilsig_s s ^ "[]"
-	| SReqModifier (_,s) -> "modreq() " ^ ilsig_s s
-	| SOptModifier (_,s) -> "modopt() " ^ ilsig_s s
-	| SSentinel -> "..."
-	| SPinned s -> "pinned " ^ ilsig_s s
-
-let rec instance_s = function
-	| InstConstant c -> constant_s c
-	| InstBoxed b -> "boxed " ^ instance_s b
-	| InstType t -> "Type " ^ t
-	| InstArray il -> "[" ^ String.concat ", " (List.map instance_s il) ^ "]"
-	| InstEnum e -> "Enum " ^ string_of_int e
-
-let named_attribute_s (is_prop,name,inst) =
-	(if is_prop then
-		"/*prop*/ "
-	else
-		"")
-	^ name ^ " = " ^ instance_s inst
-
-let attributes_s (il,nal) =
-	"(" ^ (String.concat ", " (List.map instance_s il)) ^ (if nal <> [] then ", " ^ (String.concat ", " (List.map named_attribute_s nal)) else "") ^")"
-
-let meta_root m : meta_root = match m with
-	| Module r -> Obj.magic r
-	| TypeRef r -> Obj.magic r
-	| TypeDef r -> Obj.magic r
-	| FieldPtr r -> Obj.magic r
-	| Field r -> Obj.magic r
-	| MethodPtr r -> Obj.magic r
-	| Method r -> Obj.magic r
-	| ParamPtr r -> Obj.magic r
-	| Param r -> Obj.magic r
-	| InterfaceImpl r -> Obj.magic r
-	| MemberRef r -> Obj.magic r
-	| Constant r -> Obj.magic r
-	| CustomAttribute r -> Obj.magic r
-	| FieldMarshal r -> Obj.magic r
-	| DeclSecurity r -> Obj.magic r
-	| ClassLayout r -> Obj.magic r
-	| FieldLayout r -> Obj.magic r
-	| StandAloneSig r -> Obj.magic r
-	| EventMap r -> Obj.magic r
-	| EventPtr r -> Obj.magic r
-	| Event r -> Obj.magic r
-	| PropertyMap r -> Obj.magic r
-	| PropertyPtr r -> Obj.magic r
-	| Property r -> Obj.magic r
-	| MethodSemantics r -> Obj.magic r
-	| MethodImpl r -> Obj.magic r
-	| ModuleRef r -> Obj.magic r
-	| TypeSpec r -> Obj.magic r
-	| ImplMap r -> Obj.magic r
-	| FieldRVA r -> Obj.magic r
-	| ENCLog r -> Obj.magic r
-	| ENCMap r -> Obj.magic r
-	| Assembly r -> Obj.magic r
-	| AssemblyProcessor r -> Obj.magic r
-	| AssemblyOS r -> Obj.magic r
-	| AssemblyRef r -> Obj.magic r
-	| AssemblyRefProcessor r -> Obj.magic r
-	| AssemblyRefOS r -> Obj.magic r
-	| File r -> Obj.magic r
-	| ExportedType r -> Obj.magic r
-	| ManifestResource r -> Obj.magic r
-	| NestedClass r -> Obj.magic r
-	| GenericParam r -> Obj.magic r
-	| MethodSpec r -> Obj.magic r
-	| GenericParamConstraint r -> Obj.magic r
-	| _ -> assert false
-
-let meta_root_ptr p : meta_root_ptr = match p with
-	| FieldPtr r -> Obj.magic r
-	| MethodPtr r -> Obj.magic r
-	| ParamPtr r -> Obj.magic r
-	| EventPtr r -> Obj.magic r
-	| _ -> assert false
-
-let rec ilsig_norm = function
-	| SVoid -> LVoid
-	| SBool -> LBool
-	| SChar -> LChar
-	| SInt8 -> LInt8
-	| SUInt8 -> LUInt8
-	| SInt16 -> LInt16
-	| SUInt16 -> LUInt16
-	| SInt32 -> LInt32
-	| SUInt32 -> LUInt32
-	| SInt64 -> LInt64
-	| SUInt64 -> LUInt64
-	| SFloat32 -> LFloat32
-	| SFloat64 -> LFloat64
-	| SString -> LString
-	| SPointer p -> LPointer (ilsig_norm p)
-	| SManagedPointer p -> LManagedPointer (ilsig_norm p)
-	| SValueType v -> LValueType (get_path v, [])
-	| SClass v -> LClass (get_path v, [])
-	| STypeParam i -> LTypeParam i
-	| SArray (t, opts) -> LArray(ilsig_norm t, opts)
-	| SGenericInst (p,args) -> (match follow p with
-		| SClass v ->
-			LClass(get_path v, List.map ilsig_norm args)
-		| SValueType v ->
-			LValueType(get_path v, List.map ilsig_norm args)
-		| _ -> assert false)
-	| STypedReference -> LTypedReference
-	| SIntPtr -> LIntPtr
-	| SUIntPtr -> LUIntPtr
-	| SFunPtr(conv,ret,args) -> LMethod(conv,ilsig_norm ret,List.map ilsig_norm args)
-	| SObject -> LObject
-	| SVector s -> LVector (ilsig_norm s)
-	| SMethodTypeParam i -> LMethodTypeParam i
-	| SReqModifier (_,s) -> ilsig_norm s
-	| SOptModifier (_,s) -> ilsig_norm s
-	| SSentinel -> LSentinel
-	| SPinned s -> ilsig_norm s
-	| SType -> LClass( (["System"],[],"Type"), [])
-	| SBoxed -> LObject
-	| SEnum e ->
-		let lst = String.nsplit e "." in
-		let rev = List.rev lst in
-		match rev with
-		| hd :: tl -> LValueType( (List.rev tl,[],hd), [] )
-		| _ -> assert false
-
-let ilsig_t s =
-	{
-		snorm = ilsig_norm s;
-		ssig = s;
-	}
-
-let ilsig_of_tdef_ref = function
-	| TypeDef td ->
-		SClass (TypeDef td)
-	| TypeRef tr ->
-		SClass (TypeRef tr)
-	| TypeSpec ts ->
-		ts.ts_signature
-	| s ->
-		(* error ("Invalid tdef_or_ref: " ^ ilsig_s s) *)
-		error "Invalid tdef_or_ref"
-
-let convert_field ctx f =
-	let constant = List.fold_left (fun c -> function
-		| Constant c ->
-			Some c.c_value
-		| _ ->
-			c
-	) None (Hashtbl.find_all ctx.il_relations (IField, f.f_id))
-	in
-	{
-		fname = f.f_name;
-		fflags = f.f_flags;
-		fsig = ilsig_t f.f_signature;
-		fconstant = constant;
-	}
-
-let convert_generic ctx gp =
-	let constraints = List.fold_left (fun c -> function
-		| GenericParamConstraint gc ->
-			ilsig_t (ilsig_of_tdef_ref gc.gc_constraint) :: c
-		| _ ->
-			c
-	) [] (Hashtbl.find_all ctx.il_relations (IGenericParam, gp.gp_id))
-	in
-	{
-		tnumber = gp.gp_number;
-		tflags = gp.gp_flags;
-		tname = gp.gp_name;
-		tconstraints = constraints;
-	}
-
-let convert_method ctx m =
-	let msig = ilsig_t m.m_signature in
-	let ret, margs = match follow msig.ssig with
-	| SFunPtr (_,ret,args) ->
-		(* print_endline m.m_name; *)
-		(* print_endline (Printf.sprintf "%d vs %d" (List.length args) (List.length m.m_param_list)); *)
-		(* print_endline (String.concat ", " (List.map (fun p ->string_of_int p.p_sequence ^ ":" ^ p.p_name) m.m_param_list)); *)
-		(* print_endline (String.concat ", " (List.map (ilsig_s) args)); *)
-		(* print_endline "\n"; *)
-		(* TODO: find out WHY this happens *)
-		let param_list = List.filter (fun p -> p.p_sequence > 0) m.m_param_list in
-		if List.length param_list <> List.length args then
-			let i = ref 0 in
-			ilsig_t ret, List.map (fun s ->
-				incr i; "arg" ^ (string_of_int !i), { pf_io = []; pf_reserved = [] }, ilsig_t s) args
-		else
-			ilsig_t ret, List.map2 (fun p s ->
-				p.p_name, p.p_flags, ilsig_t s
-			) param_list args
-	| _ -> assert false
-	in
-
-	let override, types, semantics =
-		List.fold_left (fun (override,types,semantics) -> function
-		| MethodImpl mi ->
-			let declaring = match mi.mi_method_declaration with
-				| MemberRef mr ->
-					Some (get_path mr.memr_class, mr.memr_name)
-				| Method m -> (match m.m_declaring with
-					| Some td ->
-						Some (get_path (TypeDef td), m.m_name)
-					| None -> override)
-				| _ -> override
-			in
-			declaring, types, semantics
-		| GenericParam gp ->
-			override, (convert_generic ctx gp) :: types, semantics
-		| MethodSemantics ms ->
-			override, types, ms.ms_semantic @ semantics
-		| _ ->
-			override,types, semantics
-		) (None,[],[]) (Hashtbl.find_all ctx.il_relations (IMethod, m.m_id))
-	in
-	{
-		mname = m.m_name;
-		mflags = m.m_flags;
-		msig = msig;
-		margs = margs;
-		mret = ret;
-		moverride = override;
-		mtypes = types;
-		msemantics = semantics;
-	}
-
-let convert_prop ctx prop =
-	let name = prop.prop_name in
-	let flags = prop.prop_flags in
-	let psig = ilsig_t prop.prop_type in
-	let pget, pset =
-		List.fold_left (fun (get,set) -> function
-			| MethodSemantics ms when List.mem SGetter ms.ms_semantic ->
-				assert (get = None);
-				Some (ms.ms_method.m_name, ms.ms_method.m_flags), set
-			| MethodSemantics ms when List.mem SSetter ms.ms_semantic ->
-				assert (set = None);
-				get, Some (ms.ms_method.m_name,ms.ms_method.m_flags)
-			| _ -> get,set
-		)
-		(None,None)
-		(Hashtbl.find_all ctx.il_relations (IProperty, prop.prop_id))
-	in
-	{
-		pname = name;
-		psig = psig;
-		pflags = flags;
-		pget = pget;
-		pset = pset;
-	}
-
-let convert_event ctx event =
-	let name = event.e_name in
-	let flags = event.e_flags in
-	let esig = ilsig_of_tdef_ref event.e_event_type in
-	let esig = ilsig_t esig in
-	let add, remove, eraise =
-		List.fold_left (fun (add, remove, eraise) -> function
-			| MethodSemantics ms when List.mem SAddOn ms.ms_semantic ->
-				assert (add = None);
-				Some (ms.ms_method.m_name, ms.ms_method.m_flags), remove, eraise
-			| MethodSemantics ms when List.mem SRemoveOn ms.ms_semantic ->
-				assert (remove = None);
-				add, Some (ms.ms_method.m_name,ms.ms_method.m_flags), eraise
-			| MethodSemantics ms when List.mem SFire ms.ms_semantic ->
-				assert (eraise = None);
-				add, remove, Some (ms.ms_method.m_name, ms.ms_method.m_flags)
-			| _ -> add, remove, eraise
-		)
-		(None,None,None)
-		(Hashtbl.find_all ctx.il_relations (IEvent, event.e_id))
-	in
-	{
-		ename = name;
-		eflags = flags;
-		esig = esig;
-		eadd = add;
-		eremove = remove;
-		eraise = eraise;
-	}
-
-let convert_class ctx path =
-	let td = Hashtbl.find ctx.il_typedefs path in
-	let cpath = get_path (TypeDef td) in
-	let cflags = td.td_flags in
-	let csuper = Option.map (fun e -> ilsig_t (ilsig_of_tdef_ref e)) td.td_extends in
-	let cfields = List.map (convert_field ctx) td.td_field_list in
-	let cmethods = List.map (convert_method ctx) td.td_method_list in
-	let enclosing = Option.map (fun t -> get_path (TypeDef t)) td.td_extra_enclosing in
-	let impl, types, nested, props, events, attrs =
-		List.fold_left (fun (impl,types,nested,props,events,attrs) -> function
-			| InterfaceImpl ii ->
-				(ilsig_t (ilsig_of_tdef_ref ii.ii_interface)) :: impl,types,nested, props, events, attrs
-			| GenericParam gp ->
-				(impl, (convert_generic ctx gp) :: types, nested, props,events, attrs)
-			| NestedClass nc ->
-				assert (nc.nc_enclosing.td_id = td.td_id);
-				(impl,types,(get_path (TypeDef nc.nc_nested)) :: nested, props, events, attrs)
-			| PropertyMap pm ->
-				assert (props = []);
-				impl,types,nested,List.map (convert_prop ctx) pm.pm_property_list, events, attrs
-			| EventMap em ->
-				assert (events = []);
-				(impl,types,nested,props,List.map (convert_event ctx) em.em_event_list, attrs)
-			| CustomAttribute a ->
-				impl,types,nested,props,events,(a :: attrs)
-			| _ ->
-				(impl,types,nested,props,events,attrs)
-		)
-		([],[],[],[],[],[])
-		(Hashtbl.find_all ctx.il_relations (ITypeDef, td.td_id))
-	in
-	{
-		cpath = cpath;
-		cflags = cflags;
-		csuper = csuper;
-		cfields = cfields;
-		cmethods = cmethods;
-		cevents = events;
-		cprops = props;
-		cimplements = impl;
-		ctypes = types;
-		cenclosing = enclosing;
-		cnested = nested;
-		cattrs = attrs;
-	}

libs/ilib/ilMetaWriter.ml

@@ -1,78 +0,0 @@
-(*
- *  This file is part of ilLib
- *  Copyright (c)2004-2013 Haxe Foundation
- *
- *  This program is free software; you can redistribute it and/or modify
- *  it under the terms of the GNU General Public License as published by
- *  the Free Software Foundation; either version 2 of the License, or
- *  (at your option) any later version.
- *
- *  This program is distributed in the hope that it will be useful,
- *  but WITHOUT ANY WARRANTY; without even the implied warranty of
- *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- *  GNU General Public License for more details.
- *
- *  You should have received a copy of the GNU General Public License
- *  along with this program; if not, write to the Free Software
- *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
- *)
-
-open PeData;;
-open PeReader;;
-open IlMeta;;
-open IO;;
-
-(* encoding helpers *)
-
-let int_of_type_def_vis = function
-	(* visibility flags - mask 0x7 *)
-	| VPrivate -> 0x0 (* 0x0 *)
-	| VPublic -> 0x1 (* 0x1 *)
-	| VNestedPublic -> 0x2 (* 0x2 *)
-	| VNestedPrivate -> 0x3 (* 0x3 *)
-	| VNestedFamily -> 0x4 (* 0x4 *)
-	| VNestedAssembly -> 0x5 (* 0x5 *)
-	| VNestedFamAndAssem -> 0x6 (* 0x6 *)
-	| VNestedFamOrAssem -> 0x7 (* 0x7 *)
-
-let int_of_type_def_layout = function
-	(* layout flags - mask 0x18 *)
-	| LAuto -> 0x0 (* 0x0 *)
-	| LSequential -> 0x8 (* 0x8 *)
-	| LExplicit -> 0x10 (* 0x10 *)
-
-let int_of_type_def_semantics props = List.fold_left (fun acc prop ->
-		(match prop with
-		(* semantics flags - mask 0x5A0 *)
-		| SInterface -> 0x20 (* 0x20 *)
-		| SAbstract -> 0x80 (* 0x80 *)
-		| SSealed -> 0x100 (* 0x100 *)
-		| SSpecialName -> 0x400 (* 0x400 *)
-		) lor acc
-	) 0 props
-
-let int_of_type_def_impl props = List.fold_left (fun acc prop ->
-		(match prop with
-		(* type implementation flags - mask 0x103000 *)
-		| IImport -> 0x1000 (* 0x1000 *)
-		| ISerializable -> 0x2000 (* 0x2000 *)
-		| IBeforeFieldInit -> 0x00100000 (* 0x00100000 *)
-		) lor acc
-	) 0 props
-
-let int_of_type_def_string = function
-	(* string formatting flags - mask 0x00030000 *)
-	| SAnsi -> 0x0 (* 0x0 *)
-	| SUnicode -> 0x00010000 (* 0x00010000 *)
-	| SAutoChar -> 0x00020000 (* 0x00020000 *)
-
-let int_of_type_def_flags f =
-	int_of_type_def_vis f.tdf_vis
-		lor
-	int_of_type_def_layout f.tdf_layout
-		lor
-	int_of_type_def_semantics f.tdf_semantics
-		lor
-	int_of_type_def_impl f.tdf_impl
-		lor
-	int_of_type_def_string f.tdf_string

libs/ilib/peData.ml

@@ -1,548 +0,0 @@
-(*
- *  This file is part of ilLib
- *  Copyright (c)2004-2013 Haxe Foundation
- *
- *  This program is free software; you can redistribute it and/or modify
- *  it under the terms of the GNU General Public License as published by
- *  the Free Software Foundation; either version 2 of the License, or
- *  (at your option) any later version.
- *
- *  This program is distributed in the hope that it will be useful,
- *  but WITHOUT ANY WARRANTY; without even the implied warranty of
- *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- *  GNU General Public License for more details.
- *
- *  You should have received a copy of the GNU General Public License
- *  along with this program; if not, write to the Free Software
- *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
- *)
-
-(*
-	This data is based on the
-		Microsoft Portable Executable and Common Object File Format Specification
-	Revision 8.3
-*)
-
-type machine_type =
-	| TUnknown (* 0 - unmanaged PE files only *)
-	| Ti386 (* 0x014c - i386 *)
-	| TR3000 (* 0x0162 - R3000 MIPS Little Endian *)
-	| TR4000 (* 0x0166 - R4000 MIPS Little Endian *)
-	| TR10000 (* 0x0168 - R10000 MIPS Little Endian *)
-	| TWCeMipsV2 (* 0x0169 - MIPS Little Endian running MS Windows CE 2 *)
-	| TAlpha (* 0x0184 - Alpha AXP *)
-	| TSh3 (* 0x01a2 - SH3 Little Endian *)
-	| TSh3Dsp (* 0x01a3 SH3DSP Little Endian *)
-	| TSh3e (* 0x01a4 SH3E Little Endian *)
-	| TSh4 (* 0x01a6 SH4 Little Endian *)
-	| TSh5 (* 0x01a8 SH5 *)
-	| TArm (* 0x1c0 ARM Little Endian *)
-	| TArmN (* 0x1c4 ARMv7 (or higher) Thumb mode only Little Endian *)
-	| TArm64 (* 0xaa64 - ARMv8 in 64-bit mode *)
-	| TEbc (* 0xebc - EFI byte code *)
-	| TThumb (* 0x1c2 ARM processor with Thumb decompressor *)
-	| TAm33 (* 0x1d3 AM33 processor *)
-	| TPowerPC (* 0x01f0 IBM PowerPC Little Endian *)
-	| TPowerPCFP (* 0x01f1 IBM PowerPC with FPU *)
-	| TItanium64 (* 0x0200 Intel IA64 (Itanium) *)
-	| TMips16 (* 0x0266 MIPS *)
-	| TAlpha64 (* 0x0284 Alpha AXP64 *)
-	| TMipsFpu (* 0x0366 MIPS with FPU *)
-	| TMipsFpu16 (* 0x0466 MIPS16 with FPU *)
-	| TTriCore (* 0x0520 Infineon *)
-	| TAmd64 (* 0x8664 AMD x64 and Intel E64T *)
-	| TM32R (* 0x9041 M32R *)
-	| TOSXAmd64 (* 0xC020 = 0x8664 xor 0x4644 OSX AMD x64 *)
-	| TLinuxAmd64 (* 0xFD1D = 0x8664 xor 0x7B79 Linux AMD x64 *)
-
-type coff_prop =
-	| RelocsStripped (* 0x1 *)
-		(* image file only. Indicates the file contains no base relocations and *)
-		(* must be loaded at its preferred base address. Should not be set for MPE files *)
-	| ExecutableImage (* 0x2 *)
-		(* Indicates that the file is an image file (EXE or DLL). Should be set for MPE files *)
-	| LineNumsStripped (* 0x4 *)
-		(* COFF line numbers have been removed. This flag should not be set for MPE files *)
-		(* because they do not use the debug info embedded in the PE file itself. They are saved on PDB files *)
-	| LocalSymsStripped (* 0x8 *)
-		(* COFF symbol table entries for local symbols have been removed. It should be set for MPE files *)
-	| AgressiveWsTrim (* 0x10 *)
-		(* Agressively trim the working set. This flag should not be set for pure-IL MPE files *)
-	| LargeAddressAware (* 0x20 *)
-		(* Application can handle addresses beyond the 2GB range. This flag should not be set for *)
-		(* pure-IL MPE files of versions 1 and 1.1, but can be set for v2.0 files *)
-	| BytesReversedLO (* 0x80 *)
-		(* Little endian. This flag should not be set for pure-IL MPE files *)
-	| Machine32Bit (* 0x100 *)
-		(* Machine is based on 32-bit architecture. This flag is usually set by the current *)
-		(* versions of code generators producing PE files. V2.0+ can produce 64-bit specific images *)
-		(* which don't have this flag set *)
-	| DebugStripped (* 0x200 *)
-		(* Debug information has been removed from the image file *)
-	| RemovableRunFromSwap (* 0x400 *)
-		(* If the image file is on removable media, copy and run it from swap file. *)
-		(* This flag should no be set for pure-IL MPE files *)
-	| NetRunFromSwap (* 0x800 *)
-		(* If the image file is on a network, copy and run it from the swap file. *)
-		(* This flag should no be set for pure-IL MPE files *)
-	| FileSystem (* 0x1000 *)
-		(* The image file is a system file (for example, a device driver) *)
-		(* This flag should not be set for pure-IL MPE files *)
-	| FileDll (* 0x2000 *)
-		(* This image file is a DLL rather than an EXE. It cannot be directly run. *)
-	| UpSystemOnly (* 0x4000 *)
-		(* The image file should be run on an uniprocessor machine only. *)
-		(* This flag should not be set for pure-IL MPE files *)
-	| BytesReversedHI (* 0x8000 *)
-		(* Big endian *)
-		(* This flag should not be set for pure-IL MPE files *)
-
-(* represents a virtual address pointer. It's 64-bit on 64-bit executables, and 32-bit otherwise *)
-type pointer = int64
-
-(* represents a memory index address on the target architecture. It's 64-bit on 64-bit executables, and 32-bit otherwise *)
-type size_t = pointer
-
-(* relative virtual address. *)
-(* it's always 32-bit - which means that PE/COFF files are still limited to the 4GB size *)
-type rva = int32
-
-(* represents a PE file-bound memory index *)
-type size_t_file = int32
-
-(* represents a file offset *)
-(* there's no point in defining it as int32, as file seek operations need an int *)
-type pointer_file = int
-
-type coff_header = {
-	coff_machine : machine_type; (* offset 0 - size 2 . *)
-		(* If the managed PE file is intended for various machine types (AnyCPU), it should be Ti386 *)
-	coff_nsections : int; (* O2S2 *)
-	coff_timestamp : int32; (* O4S4 *)
-	coff_symbol_table_pointer : rva; (* O8S4 *)
-		(* File pointer of the COFF symbol table. In managed PE files, it is 0 *)
-	coff_nsymbols : int; (* O12S4 *)
-		(* Number of entries in the COFF symbol table. Should be 0 in managed PE files *)
-	coff_optheader_size: int; (* O16S2 *)
-		(* Size of the PE header *)
-	coff_props : coff_prop list;
-}
-
-let coff_default_exe_props = [ ExecutableImage; LineNumsStripped; LocalSymsStripped; (* Machine32Bit; *) ]
-
-let coff_default_dll_props = [ ExecutableImage; LineNumsStripped; LocalSymsStripped; (* Machine32Bit; *) FileDll ]
-
-type pe_magic =
-	| P32 (* 0x10b *)
-	| PRom (* 0x107 *)
-	| P64 (* 0x20b - called PE32+ on the docs *)
-		(* allows 64-bit address space while limiting the image size to 2 gb *)
-
-type subsystem =
-	| SUnknown (* 0 *)
-	| SNative (* 1 *)
-		(* Device drivers and native windows processes *)
-	| SWGui (* 2 *)
-		(* Windows GUI subsystem *)
-	| SWCui (* 3 *)
-		(* Windows character subsystem *)
-	| SPCui (* 7 *)
-		(* Posix character subsystem *)
-	| SWCeGui (* 9 *)
-		(* Windows CE subsystem *)
-	| SEfi (* 10 *)
-		(* EFI application *)
-	| SEfiBoot (* 11 *)
-		(* EFI driver with boot services *)
-	| SEfiRuntime (* 12 *)
-		(* EFI driver with run-time services *)
-	| SEfiRom (* 13 *)
-		(* EFI ROM Image *)
-	| SXbox (* 14 *)
-
-type dll_prop =
-	| DDynamicBase (* 0x0040 *)
-		(* DLL can be relocated at load time *)
-	| DForceIntegrity (* 0x0080 *)
-		(* Code integrity checks are enforced *)
-	| DNxCompat (* 0x0100 *)
-		(* Image is NX compatible *)
-	| DNoIsolation (* 0x0200 *)
-		(* Isolation-aware, but do not isolate the image *)
-	| DNoSeh (* 0x0400 *)
-		(* No structured exception handling *)
-	| DNoBind (* 0x0800 *)
-		(* Do not bind the image *)
-	| DWdmDriver (* 0x2000 *)
-		(* A WDM driver *)
-	| DTerminalServer (* 0x8000 *)
-		(* Terminal server aware *)
-
-type directory_type =
-	| ExportTable (* .edata *)
-		(* contains information about four other tables, which hold data describing *)
-		(* unmanaged exports of the PE file. ILAsm and VC++ linker are capable of exposing *)
-		(* the managed PE file as unmanaged exports *)
-	| ImportTable (* .idata *)
-		(* data on unmanaged imports consumed by the PE file. Only the VC++ linker makes *)
-		(* use of this table, by marking the imported unmanaged external functions used by *)
-		(* the unmanaged native code embedded in the same assembly. Other compilers only *)
-		(* contain a single entry - that of the CLR entry function *)
-	| ResourceTable (* .rsrc *)
-		(* unmanaged resources embedded in the PE file. Managed resources don't use this *)
-	| ExceptionTable (* .pdata *)
-		(* unmanaged exceptions only *)
-	| CertificateTable
-		(* points to a table of attribute certificates, used for file authentication *)
-		(* the first field of this entry is a file pointer rather than an RVA *)
-	| RelocTable (* .reloc *)
-		(* relocation table. We need to be aware of it if we use native TLS. *)
-		(* only the VC++ linker uses native TLS' *)
-	| DebugTable
-		(* unmanaged debug data starting address and size. A managed PE file doesn't carry *)
-		(* embedded debug data, so this data is either all zero or points to a 30-byte debug dir entry *)
-		(* of type 2 (IMAGE_DEBUG_TYPE_CODEVIEW), which in turn points to a CodeView-style header, containing *)
-		(* the path to the PDB debug file. *)
-	| ArchitectureTable
-		(* for i386, Itanium64 or AMD64, this data is set to all zeros *)
-	| GlobalPointer
-		(* the RVA of the value to be stored in the global pointer register. Size must be 0. *)
-		(* if the target architecture (e.g. i386 or AMD64) don't use the concept of a global pointer, *)
-		(* it is set to all zeros *)
-	| TlsTable (* .tls *)
-		(* The thread-local storage data. Only the VC++ linker and IL assembler produce code that use it *)
-	| LoadConfigTable
-		(* data specific to Windows NT OS *)
-	| BoundImportTable
-		(* array of bound import descriptors, each of which describes a DLL this image was bound *)
-		(* at link-time, along with time stamps of the bindings. Iff they are up-to-date, the OS loader *)
-		(* uses these bindings as a "shortcut" for API import *)
-	| ImportAddressTable
-		(* referenced from the Import Directory table (data directory 1) *)
-	| DelayImport
-		(* delay-load imports are DLLs described as implicit imports but loaded as explicit imports *)
-		(* (via calls to the LoadLibrary API) *)
-	| ClrRuntimeHeader (* .cormeta *)
-		(* pointer to the clr_runtime_header *)
-	| Reserved
-		(* must be zero *)
-	| Custom of int
-
-let directory_type_info = function
-	| ExportTable -> 0, "ExportTable"
-	| ImportTable -> 1, "ImportTable"
-	| ResourceTable -> 2, "ResourceTable"
-	| ExceptionTable -> 3, "ExceptionTable"
-	| CertificateTable -> 4, "CertificateTable"
-	| RelocTable -> 5, "RelocTable"
-	| DebugTable -> 6, "DebugTable"
-	| ArchitectureTable -> 7, "ArchTable"
-	| GlobalPointer -> 8, "GlobalPointer"
-	| TlsTable -> 9, "TlsTable"
-	| LoadConfigTable -> 10, "LoadConfigTable"
-	| BoundImportTable -> 11, "BuildImportTable"
-	| ImportAddressTable -> 12, "ImportAddressTable"
-	| DelayImport -> 13, "DelayImport"
-	| ClrRuntimeHeader -> 14, "ClrRuntimeHeader"
-	| Reserved -> 15, "Reserved"
-	| Custom i -> i, "Custom" ^ (string_of_int i)
-
-let directory_type_of_int = function
-	| 0 -> ExportTable
-	| 1 -> ImportTable
-	| 2 -> ResourceTable
-	| 3 -> ExceptionTable
-	| 4 -> CertificateTable
-	| 5 -> RelocTable
-	| 6 -> DebugTable
-	| 7 -> ArchitectureTable
-	| 8 -> GlobalPointer
-	| 9 -> TlsTable
-	| 10 -> LoadConfigTable
-	| 11 -> BoundImportTable
-	| 12 -> ImportAddressTable
-	| 13 -> DelayImport
-	| 14 -> ClrRuntimeHeader
-	| 15 -> Reserved
-	| i -> Custom i
-
-type section_prop =
-	| SNoPad (* 0x8 *)
-		(* the section should not be padded to the next boundary. *)
-		(* OBSOLETE - replaced by SAlign1Bytes *)
-	| SHasCode (* 0x20 *)
-		(* the section contains executable code *)
-	| SHasIData (* 0x40 *)
-		(* contains initialized data *)
-	| SHasData (* 0x80 *)
-		(* contains uninitialized data *)
-	| SHasLinkInfo (* 0x200 *)
-		(* contains comments or other information. only valid for object files *)
-	| SLinkRemove (* 0x1000 *)
-		(* this will not become part of the image. only valid for object files *)
-	| SGlobalRel (* 0x8000 *)
-		(* contains data referenced through the global pointer (GP) *)
-	| SHas16BitMem (* 0x20000 *)
-		(* for ARM architecture. The section contains Thumb code *)
-	| SAlign1Bytes (* 0x100000 *)
-		(* align data on a 1-byte boundary. valid only for object files *)
-	| SAlign2Bytes (* 0x200000 *)
-	| SAlign4Bytes (* 0x300000 *)
-	| SAlign8Bytes (* 0x400000 *)
-	| SAlign16Bytes (* 0x500000 *)
-	| SAlign32Bytes (* 0x600000 *)
-	| SAlign64Bytes (* 0x700000 *)
-	| SAlign128Bytes (* 0x800000 *)
-	| SAlign256Bytes (* 0x900000 *)
-	| SAlign512Bytes (* 0xA00000 *)
-	| SAlign1024Bytes (* 0xB00000 *)
-	| SAlign2048Bytes (* 0xC00000 *)
-	| SAlign4096Bytes (* 0xD00000 *)
-	| SAlign8192Bytes (* 0xE00000 *)
-	| SHasExtRelocs (* 0x1000000 *)
-		(* section contains extended relocations *)
-	| SCanDiscard (* 0x02000000 *)
-		(* section can be discarded as needed *)
-	| SNotCached (* 0x04000000 *)
-		(* section cannot be cached *)
-	| SNotPaged (* 0x08000000 *)
-		(* section is not pageable *)
-	| SShared (* 0x10000000 *)
-		(* section can be shared in memory *)
-	| SExec (* 0x20000000 *)
-		(* section can be executed as code *)
-	| SRead (* 0x40000000 *)
-		(* section can be read *)
-	| SWrite (* 0x80000000 *)
-		(* section can be written to *)
-
-type pe_section = {
-	s_name : string;
-		(* an 8-byte, null-padded UTF-8 encoded string *)
-	s_vsize : size_t_file;
-		(* the total size of the section when loaded into memory. *)
-		(* if less than s_rawsize, the section is zero-padded *)
-		(* should be set to 0 on object files *)
-	s_vaddr : rva;
-		(* the RVA of the beginning of the section *)
-	s_raw_size : size_t_file;
-		(* the size of the initialized data on disk, rounded up to a multiple *)
-		(* of the file alignment value. If it's less than s_vsize, it should be *)
-		(* zero filled. It may happen that rawsize is greater than vsize. *)
-	s_raw_pointer : pointer_file;
-		(* the file pointer to the first page of the section within the COFF file *)
-		(* on executable images, this must be a multiple of file aignment value. *)
-		(* for object files, it should be aligned on a 4byte boundary *)
-	s_reloc_pointer : pointer_file;
-		(* the file pointer to the beginning of relocation entries for this section *)
-		(* this is set to zero for executable images or if there are no relocations *)
-	s_line_num_pointer : pointer_file;
-		(* the file pointer to the beginning of line-number entries for this section *)
-		(* must be 0 : COFF debugging image is deprecated *)
-	s_nrelocs : int;
-		(* number of relocation entries *)
-	s_nline_nums : int;
-		(* number of line number entries *)
-	s_props : section_prop list;
-		(* properties of the section *)
-}
-
-(* The size of the PE header is not fixed. It depends on the number of data directories defined in the header *)
-(* and is specified in the optheader_size in the COFF header *)
-(* object files don't have this; but it's required for image files *)
-type pe_header = {
-	pe_coff_header : coff_header;
-	(* Standard fields *)
-	pe_magic : pe_magic;
-	pe_major : int;
-	pe_minor : int;
-	pe_code_size : int;
-		(* size of the code section (.text) or the sum of all code sections, *)
-		(* if multiple sections exist. The IL assembler always emits a single code section *)
-	pe_init_size : int;
-	pe_uinit_size : int;
-	pe_entry_addr : rva;
-		(* RVA of the beginning of the entry point function. For unmanaged DLLs, this can be 0 *)
-		(* For managed PE files, this always points to the CLR invocation stub *)
-	pe_base_code : rva;
-		(* The address that is relative to the image base of the beginning-of-code section *)
-		(* when it's loaded into memory *)
-	pe_base_data : rva;
-		(* The address that is relative to the image base of the beginning-of-data section *)
-		(* when it's loaded into memory *)
-
-	(* COFF Windows extension *)
-	pe_image_base : pointer;
-		(* The preferred address of the first byte of image when loaded into memory. *)
-		(* Should be a multiple of 64K *)
-	pe_section_alignment : int;
-		(* The alignment in bytes of sections when they are loaded into memory *)
-		(* It must be greater than or equal to FileAlignment. The default is the page size *)
-		(* for the architecture *)
-		(* x86 MPE files should have an alignment of 8KB, even though only 4KB would be needed *)
-		(* for compatibility with 64-bits *)
-	pe_file_alignment : int;
-		(* The alignment factor in bytes that is used to align the raw data of sections *)
-		(* in the image file. The value should be a POT between 512 and 64K. *)
-		(* If secion_alignment is less than architecture's page size, file_alignment must match *)
-		(* secion_alignment *)
-	pe_major_osver : int;
-	pe_minor_osver : int;
-	pe_major_imgver : int;
-	pe_minor_imgver : int;
-	pe_major_subsysver : int;
-	pe_minor_subsysver : int;
-	pe_image_size : int;
-		(* the size of the image in bytes, as the image is loaded into memory *)
-		(* must be a multiple of section_alignment *)
-	pe_headers_size : int;
-		(* the combined size of an MSDOS stub, PE header, and section headers *)
-		(* rounded up to a multiple of FileAlignment *)
-	pe_checksum : int32;
-	pe_subsystem : subsystem;
-	pe_dll_props : dll_prop list;
-		(* in MPE files of v1.0, always set to 0; In MPE of v1.1 and later, *)
-		(* always set to 0x400 (DNoSeh) *)
-	pe_stack_reserve : size_t;
-		(* the size of the stack to reserve. Only pe_stack_commit is committed *)
-	pe_stack_commit : size_t;
-		(* the size of the stack to commit *)
-	pe_heap_reserve : size_t;
-		(* the size of the local heap space to reserve. Only pe_heap_commit is committed *)
-	pe_heap_commit : size_t;
-		(* the size of the heap to commit *)
-	pe_ndata_dir : int;
-		(* the number of data-directory entries in the remainder of the optional header *)
-		(* should be at least 16. Although is possible to emit more than 16 data directories, *)
-		(* all existing managed compilers emit exactly 16 data directories, with the last never *)
-		(* used (reserved) *)
-	pe_data_dirs : (rva * size_t_file) array;
-		(* data directories are RVA's that point to sections on the PE that have special significance *)
-		(* see directory_type docs *)
-
-	(* sections *)
-	pe_sections : pe_section array;
-}
-
-(* raw .idata table *)
-(* not used : only here for documentation purposes *)
-type idata_table_raw = {
-	impr_lookup_table : rva;
-		(* the RVA of the lookup table *)
-	impr_timestamp : int32;
-		(* on bound images, it's set to the timestamp of the DLL *)
-	impr_fchain : int32;
-		(* the index of the first forwarder reference - which are references *)
-		(* that are both imported and exported *)
-	impr_name : rva;
-		(* the RVA to an ASCII string that contains the name of the DLL *)
-	impr_address_table : rva;
-		(* RVA of the import address table. The contents are identical to the imp_lookup_table *)
-		(* until the image is bound *)
-}
-
-(* a symbol lookup can happen either by name, or by ordinal. *)
-(* lookup by name happens to be an extra indirection, as the loader *)
-(* uses the name to look up the export ordinal anyway. *)
-(* Most (if not all) MPE will do a lookup by name, though *)
-type symbol_lookup =
-	| SName of int * string
-	| SOrdinal of int
-
-type idata_table = {
-	imp_name : string;
-		(* ASCII string that contains the name of the DLL *)
-	imp_imports : symbol_lookup list;
-}
-
-type clr_flag =
-	| FIlOnly (* 0x1 *)
-		(* the image file contains IL code only, with no embedded native unmanaged code *)
-		(* this can cause some problems on WXP+, because the .reloc section is ignored when this flag is set *)
-		(* e.g. if native TLS support is used. In this case the VC++ compiler unsets this flag *)
-	| F32BitRequired (* 0x2 *)
-		(* the file can be only loaded into a 32-bit process *)
-	| FIlLibrary (* 0x4 *)
-		(* obsolete *)
-	| FSigned (* 0x8 *)
-		(* the image file is protected with a strong name signature *)
-	| FNativeEntry (* 0x10 *)
-		(* the executable's entry point is an unmanaged method. *)
-		(* the EntryPointToken / EntryPointRVA field of the CLR header *)
-		(* contains the RVA of this native method *)
-	| FTrackDebug (* 0x10000 *)
-		(* the CLR loader is required to track debug information about the methods. This flag is not used *)
-
-type clr_header = {
-	clr_cb : int;
-		(* size of header *)
-	clr_major : int;
-	clr_minor : int;
-
-	(* symbol table and startup information *)
-	clr_meta : rva * size_t_file;
-	clr_flags : clr_flag list;
-	clr_entry_point : rva;
-		(* metadata identifier (token) of the entry point for the image file *)
-		(* can be 0 for DLL images. This field identifies a method belonging to this module *)
-		(* or a module containing the entry point method. This field may contain RVA of the *)
-		(* embedded native entry point method, if FNativeEntry flag is set *)
-
-	(* binding information *)
-	clr_res : rva * size_t_file;
-		(* RVA of managed resources *)
-	clr_sig : rva * size_t_file;
-		(* RVA of the hash data for this PE file, used by the loader for binding and versioning *)
-
-	(* regular fixup and binding information *)
-	clr_codeman : rva * size_t_file;
-		(* code manager table - RESERVED and should be 0 *)
-	clr_vtable_fix : rva * size_t_file;
-		(* RVA of an array of vtable fixups. Only VC++ linker and IL assembler produce data in this array *)
-	clr_export_address : rva * size_t_file;
-		(* rva of addresses of jump thunks. obsolete and should be set to 0 *)
-}
-
-(* unused structure: documentation purposes only *)
-type clr_stream_header = {
-	str_offset : pointer_file;
-		(* the (relative to the start of metadata) offset in the file for this stream *)
-	str_size : size_t_file;
-		(* the size of the stream in bytes *)
-	str_name : string;
-		(* name of the stream - a zero-terminated ASCII string no longer than 31 characters (plus 0 terminator) *)
-		(* if the stream name is smaller, it can be reduced - but must be padded to the 4-byte boundary *)
-}
-
-(* unused structure: documentation purposes only *)
-type clr_meta_table = {
-	(* storage signature *)
-	meta_magic : string;
-		(* always BSJB *)
-	meta_major : int;
-	meta_minor : int;
-	(* meta_extra : int; *)
-		(* reserved; always 0 *)
-	meta_ver : string;
-		(* encoded by first passing its length *)
-
-	(* storage header *)
-	(* meta_flags : int; *)
-		(* reserved; always 0 *)
-	meta_nstreams : int;
-		(* number of streams *)
-	meta_strings_stream : clr_stream_header;
-		(* #Strings: a string heap containing the names of metadata items *)
-	meta_blob_stream : clr_stream_header;
-		(* #Blob: blob heap containing internal metadata binary object, such as default values, signatures, etc *)
-	meta_guid_stream : clr_stream_header;
-		(* #GUID: a GUID heap *)
-	meta_us_stream : clr_stream_header;
-		(* #US: user-defined strings *)
-	meta_meta_stream : clr_stream_header;
-		(* may be either: *)
-			(* #~: compressed (optimized) metadata stream *)
-			(* #-: uncompressed (unoptimized) metadata stream *)
-	meta_streams : clr_stream_header list;
-		(* custom streams *)
-}

libs/ilib/peDataDebug.ml

@@ -1,186 +0,0 @@
-(*
- *  This file is part of ilLib
- *  Copyright (c)2004-2013 Haxe Foundation
- *
- *  This program is free software; you can redistribute it and/or modify
- *  it under the terms of the GNU General Public License as published by
- *  the Free Software Foundation; either version 2 of the License, or
- *  (at your option) any later version.
- *
- *  This program is distributed in the hope that it will be useful,
- *  but WITHOUT ANY WARRANTY; without even the implied warranty of
- *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- *  GNU General Public License for more details.
- *
- *  You should have received a copy of the GNU General Public License
- *  along with this program; if not, write to the Free Software
- *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
- *)
-open PeData;;
-open Printf;;
-
-let machine_type_s m = match m with
-	| TUnknown -> "TUnknown"
-	| Ti386 -> "Ti386"
-	| TR3000 -> "TR3000"
-	| TR4000 -> "TR4000"
-	| TR10000 -> "TR10000"
-	| TWCeMipsV2 -> "TWCeMipsV2"
-	| TAlpha -> "TAlpha"
-	| TSh3 -> "TSh3"
-	| TSh3Dsp -> "TSh3Dsp"
-	| TSh3e -> "TSh3e"
-	| TSh4 -> "TSh4"
-	| TSh5 -> "TSh5"
-	| TArm -> "TArm"
-	| TArmN -> "TArmN"
-	| TArm64 -> "TArm64"
-	| TEbc -> "TEbc"
-	| TThumb -> "TThumb"
-	| TAm33 -> "TAm33"
-	| TPowerPC -> "TPowerPC"
-	| TPowerPCFP -> "TPowerPCFP"
-	| TItanium64 -> "TItanium64"
-	| TMips16 -> "TMips16"
-	| TAlpha64 -> "TAlpha64"
-	| TMipsFpu -> "TMipsFpu"
-	| TMipsFpu16 -> "TMipsFpu16"
-	| TTriCore -> "TTriCore"
-	| TAmd64 -> "TAmd64"
-	| TM32R -> "TM32R"
-	| TOSXAmd64 -> "TOSXAmd64"
-	| TLinuxAmd64 -> "TLinuxAmd64"
-
-let coff_prop_s p = match p with
-	| RelocsStripped -> "RelocsStripped"
-	| ExecutableImage -> "ExecutableImage"
-	| LineNumsStripped -> "LineNumsStripped"
-	| LocalSymsStripped -> "LocalSymsStripped"
-	| AgressiveWsTrim -> "AgressiveWsTrim"
-	| LargeAddressAware -> "LargeAddressAware"
-	| BytesReversedLO -> "BytesReversedLO"
-	| Machine32Bit -> "Machine32Bit"
-	| DebugStripped -> "DebugStripped"
-	| RemovableRunFromSwap -> "RemovableRunFromSwap"
-	| NetRunFromSwap -> "NetRunFromSwap"
-	| FileSystem -> "FileSystem"
-	| FileDll -> "FileDll"
-	| UpSystemOnly -> "UpSystemOnly"
-	| BytesReversedHI -> "BytesReversedHI"
-
-let coff_header_s h =
-	sprintf "#COFF_HEADER\n\tmachine: %s\n\tnsections: %d\n\ttimestamp: %ld\n\tsymbol_tbl_pointer: %ld\n\tnsymbols: %d\n\toptheader_size: %x\n\tprops: [%s]\n"
-		(machine_type_s h.coff_machine)
-		h.coff_nsections
-		h.coff_timestamp
-		h.coff_symbol_table_pointer
-		h.coff_nsymbols
-		h.coff_optheader_size
-		(String.concat ", " (List.map coff_prop_s h.coff_props))
-
-let pe_magic_s = function
-	| P32 -> "P32"
-	| PRom -> "PRom"
-	| P64 -> "P64"
-
-let subsystem_s = function
-	| SUnknown -> "SUnknown" (* 0 *)
-	| SNative -> "SNative" (* 1 *)
-	| SWGui -> "SWGui" (* 2 *)
-	| SWCui -> "SWCui" (* 3 *)
-	| SPCui -> "SPCui" (* 7 *)
-	| SWCeGui -> "SWCeGui" (* 9 *)
-	| SEfi -> "SEfi" (* 10 *)
-	| SEfiBoot -> "SEfiBoot" (* 11 *)
-	| SEfiRuntime -> "SEfiRuntime" (* 12 *)
-	| SEfiRom -> "SEfiRom" (* 13 *)
-	| SXbox -> "SXbox" (* 14 *)
-
-let dll_prop_s = function
-	| DDynamicBase -> "DDynamicBase" (* 0x0040 *)
-	| DForceIntegrity -> "DForceIntegrity" (* 0x0080 *)
-	| DNxCompat -> "DNxCompat" (* 0x0100 *)
-	| DNoIsolation -> "DNoIsolation" (* 0x0200 *)
-	| DNoSeh -> "DNoSeh" (* 0x0400 *)
-	| DNoBind -> "DNoBind" (* 0x0800 *)
-	| DWdmDriver -> "DWdmDriver" (* 0x2000 *)
-	| DTerminalServer -> "DTerminalServer" (* 0x8000 *)
-
-let section_prop_s = function
-	| SNoPad -> "SNoPad"
-	| SHasCode -> "SHasCode"
-	| SHasIData -> "SHasIData"
-	| SHasData -> "SHasData"
-	| SHasLinkInfo -> "SHasLinkInfo"
-	| SLinkRemove -> "SLinkRemove"
-	| SGlobalRel -> "SGlobalRel"
-	| SHas16BitMem -> "SHas16BitMem"
-	| SAlign1Bytes -> "SAlign1Bytes"
-	| SAlign2Bytes -> "SAlign2Bytes"
-	| SAlign4Bytes -> "SAlign4Bytes"
-	| SAlign8Bytes -> "SAlign8Bytes"
-	| SAlign16Bytes -> "SAlign16Bytes"
-	| SAlign32Bytes -> "SAlign32Bytes"
-	| SAlign64Bytes -> "SAlign64Bytes"
-	| SAlign128Bytes -> "SAlign128Bytes"
-	| SAlign256Bytes -> "SAlign256Bytes"
-	| SAlign512Bytes -> "SAlign512Bytes"
-	| SAlign1024Bytes -> "SAlign1024Bytes"
-	| SAlign2048Bytes -> "SAlign2048Bytes"
-	| SAlign4096Bytes -> "SAlign4096Bytes"
-	| SAlign8192Bytes -> "SAlign8192Bytes"
-	| SHasExtRelocs -> "SHasExtRelocs"
-	| SCanDiscard -> "SCanDiscard"
-	| SNotCached -> "SNotCached"
-	| SNotPaged -> "SNotPaged"
-	| SShared -> "SShared"
-	| SExec -> "SExec"
-	| SRead -> "SRead"
-	| SWrite -> "SWrite"
-
-let pe_section_s s =
-	Printf.sprintf "\t%s :\n\t\trva: %lx\n\t\traw size: %lx\n\t\tprops: [%s]"
-		s.s_name
-		s.s_vaddr
-		s.s_raw_size
-		(String.concat ", " (List.map section_prop_s s.s_props))
-
-let data_dirs_s a =
-	let lst = Array.to_list (Array.mapi (fun i (r,l) ->
-		let _,s = directory_type_info (directory_type_of_int i) in
-		Printf.sprintf "%s: %lx (%lx)" s r l
-	) a) in
-	String.concat "\n\t\t" lst
-
-let pe_header_s h =
-	sprintf "#PE_HEADER\n\tmagic: %s\n\tmajor.minor %d.%d\n\tsubsystem: %s\n\tdll props: [%s]\n\tndata_dir: %i\n\t\t%s\n#SECTIONS\n%s"
-		(pe_magic_s h.pe_magic)
-		h.pe_major h.pe_minor
-		(subsystem_s h.pe_subsystem)
-		(String.concat ", " (List.map dll_prop_s h.pe_dll_props))
-		h.pe_ndata_dir
-		(data_dirs_s h.pe_data_dirs)
-		(String.concat "\n" (List.map pe_section_s (Array.to_list h.pe_sections)))
-
-let symbol_lookup_s = function
-	| SName (hint,s) -> "SName(" ^ string_of_int hint ^ ", " ^ s ^ ")"
-	| SOrdinal i -> "SOrdinal(" ^ string_of_int i ^ ")"
-
-let idata_table_s t =
-	sprintf "#IMPORT %s:\n\t%s"
-		t.imp_name
-		(String.concat "\n\t" (List.map symbol_lookup_s t.imp_imports))
-
-let clr_flag_s = function
-	| FIlOnly -> "FIlOnly" (* 0x1 *)
-	| F32BitRequired -> "F32BitRequired" (* 0x2 *)
-	| FIlLibrary -> "FIlLibrary" (* 0x4 *)
-	| FSigned -> "FSigned" (* 0x8 *)
-	| FNativeEntry -> "FNativeEntry" (* 0x10 *)
-	| FTrackDebug -> "FTrackDebug" (* 0x10000 *)
-
-let clr_header_s h =
-	sprintf "#CLR v%d.%d\n\tflags: %s"
-		h.clr_major
-		h.clr_minor
-		(String.concat ", " (List.map clr_flag_s h.clr_flags))

libs/ilib/peReader.ml

@@ -1,495 +0,0 @@
-(*
- *  This file is part of ilLib
- *  Copyright (c)2004-2013 Haxe Foundation
- *
- *  This program is free software; you can redistribute it and/or modify
- *  it under the terms of the GNU General Public License as published by
- *  the Free Software Foundation; either version 2 of the License, or
- *  (at your option) any later version.
- *
- *  This program is distributed in the hope that it will be useful,
- *  but WITHOUT ANY WARRANTY; without even the implied warranty of
- *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- *  GNU General Public License for more details.
- *
- *  You should have received a copy of the GNU General Public License
- *  along with this program; if not, write to the Free Software
- *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
- *)
-
-open PeData;;
-open IO;;
-open ExtString;;
-open ExtList;;
-
-exception Error_message of string
-
-type reader_ctx = {
-	ch : Pervasives.in_channel;
-	i : IO.input;
-	verbose : bool;
-}
-
-type ctx = {
-	r : reader_ctx;
-	pe_header : pe_header;
-	read_word : IO.input -> pointer;
-}
-
-let error msg = raise (Error_message msg)
-
-let seek r pos =
-	seek_in r.ch pos
-
-let pos r =
-	Pervasives.pos_in r.ch
-
-let info r msg =
-	if r.verbose then
-		print_endline (msg())
-
-let machine_type_of_int i = match i with
-	| 0x0 -> TUnknown (* 0 - unmanaged PE files only *)
-	| 0x014c -> Ti386 (* 0x014c - i386 *)
-	| 0x0162 -> TR3000 (* 0x0162 - R3000 MIPS Little Endian *)
-	| 0x0166 -> TR4000 (* 0x0166 - R4000 MIPS Little Endian *)
-	| 0x0168 -> TR10000 (* 0x0168 - R10000 MIPS Little Endian *)
-	| 0x0169 -> TWCeMipsV2 (* 0x0169 - MIPS Litlte Endian running MS Windows CE 2 *)
-	| 0x0184 -> TAlpha (* 0x0184 - Alpha AXP *)
-	| 0x01a2 -> TSh3 (* 0x01a2 - SH3 Little Endian *)
-	| 0x01a3 -> TSh3Dsp (* 0x01a3 SH3DSP Little Endian *)
-	| 0x01a4 -> TSh3e (* 0x01a4 SH3E Little Endian *)
-	| 0x01a6 -> TSh4 (* 0x01a6 SH4 Little Endian *)
-	| 0x01a8 -> TSh5
-	| 0x01c0 -> TArm (* 0x1c0 ARM Little Endian *)
-	| 0x01c2 -> TThumb (* 0x1c2 ARM processor with Thumb decompressor *)
-	| 0x01c4 -> TArmN (* 0x1c0 ARM Little Endian *)
-	| 0xaa64 -> TArm64
-	| 0xebc -> TEbc
-	| 0x01d3 -> TAm33 (* 0x1d3 AM33 processor *)
-	| 0x01f0 -> TPowerPC (* 0x01f0 IBM PowerPC Little Endian *)
-	| 0x01f1 -> TPowerPCFP (* 0x01f1 IBM PowerPC with FPU *)
-	| 0x0200 -> TItanium64 (* 0x0200 Intel IA64 (Itanium( *)
-	| 0x0266 -> TMips16 (* 0x0266 MIPS *)
-	| 0x0284 -> TAlpha64 (* 0x0284 Alpha AXP64 *)
-	| 0x0366 -> TMipsFpu (* 0x0366 MIPS with FPU *)
-	| 0x0466 -> TMipsFpu16 (* 0x0466 MIPS16 with FPU *)
-	| 0x0520 -> TTriCore (* 0x0520 Infineon *)
-	| 0x8664 -> TAmd64 (* 0x8664 AMD x64 and Intel E64T *)
-	| 0x9041 -> TM32R (* 0x9041 M32R *)
-	| 0xC020 -> TOSXAmd64 (* 0xC020 OSX AMD x64 *)
-	| 0xFD1D -> TLinuxAmd64 (* 0xFD1D Linux AMD x64 *)
-	| _ -> assert false
-
-let coff_props_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		| 0x1 -> RelocsStripped (* 0x1 *)
-		| 0x2 -> ExecutableImage (* 0x2 *)
-		| 0x4 -> LineNumsStripped (* 0x4 *)
-		| 0x8 -> LocalSymsStripped (* 0x8 *)
-		| 0x10 -> AgressiveWsTrim (* 0x10 *)
-		| 0x20 -> LargeAddressAware (* 0x20 *)
-		| 0x80 -> BytesReversedLO (* 0x80 *)
-		| 0x100 -> Machine32Bit (* 0x100 *)
-		| 0x200 -> DebugStripped (* 0x200 *)
-		| 0x400 -> RemovableRunFromSwap (* 0x400 *)
-		| 0x800 -> NetRunFromSwap (* 0x800 *)
-		| 0x1000 -> FileSystem (* 0x1000 *)
-		| 0x2000 -> FileDll (* 0x2000 *)
-		| 0x4000 -> UpSystemOnly (* 0x4000 *)
-		| 0x8000 -> BytesReversedHI (* 0x8000 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x1;0x2;0x4;0x8;0x10;0x20;0x80;0x100;0x200;0x400;0x800;0x1000;0x2000;0x4000;0x8000]
-
-let section_props_of_int32 props = List.fold_left (fun acc i ->
-	if (Int32.logand props i) = i then (match i with
-		| 0x8l -> SNoPad
-		| 0x20l -> SHasCode
-		| 0x40l -> SHasIData
-		| 0x80l -> SHasData
-		| 0x200l -> SHasLinkInfo
-		| 0x1000l -> SLinkRemove
-		| 0x8000l -> SGlobalRel
-		| 0x20000l -> SHas16BitMem
-		| 0x100000l -> SAlign1Bytes
-		| 0x200000l -> SAlign2Bytes
-		| 0x300000l -> SAlign4Bytes
-		| 0x400000l -> SAlign8Bytes
-		| 0x500000l -> SAlign16Bytes
-		| 0x600000l -> SAlign32Bytes
-		| 0x700000l -> SAlign64Bytes
-		| 0x800000l -> SAlign128Bytes
-		| 0x900000l -> SAlign256Bytes
-		| 0xA00000l -> SAlign512Bytes
-		| 0xB00000l -> SAlign1024Bytes
-		| 0xC00000l -> SAlign2048Bytes
-		| 0xD00000l -> SAlign4096Bytes
-		| 0xE00000l -> SAlign8192Bytes
-		| 0x1000000l -> SHasExtRelocs
-		| 0x02000000l -> SCanDiscard
-		| 0x04000000l -> SNotCached
-		| 0x08000000l -> SNotPaged
-		| 0x10000000l -> SShared
-		| 0x20000000l -> SExec
-		| 0x40000000l -> SRead
-		| 0x80000000l -> SWrite
-		| _ -> assert false) :: acc
-	else
-		acc) [] [ 0x8l;  0x20l;  0x40l;  0x80l;  0x200l;  0x1000l;  0x8000l;  0x20000l;  0x100000l;  0x200000l;  0x300000l;  0x400000l;  0x500000l;  0x600000l;  0x700000l;  0x800000l;  0x900000l;  0xA00000l;  0xB00000l;  0xC00000l;  0xD00000l;  0xE00000l;  0x1000000l;  0x02000000l;  0x04000000l;  0x08000000l;  0x10000000l;  0x20000000l;  0x40000000l;  0x80000000l; ]
-
-let subsystem_of_int i = match i with
-	|  0 -> SUnknown (* 0 *)
-	|  1 -> SNative (* 1 *)
-	|  2 -> SWGui (* 2 *)
-	|  3 -> SWCui (* 3 *)
-	|  7 -> SPCui (* 7 *)
-	|  9 -> SWCeGui (* 9 *)
-	|  10 -> SEfi (* 10 *)
-	|  11 -> SEfiBoot (* 11 *)
-	|  12 -> SEfiRuntime (* 12 *)
-	|  13 -> SEfiRom (* 13 *)
-	|  14 -> SXbox (* 14 *)
-	| _ -> error ("Unknown subsystem " ^ string_of_int i)
-
-let dll_props_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		| 0x0040  -> DDynamicBase (* 0x0040 *)
-		| 0x0080  -> DForceIntegrity (* 0x0080 *)
-		| 0x0100  -> DNxCompat (* 0x0100 *)
-		| 0x0200  -> DNoIsolation (* 0x0200 *)
-		| 0x0400  -> DNoSeh (* 0x0400 *)
-		| 0x0800  -> DNoBind (* 0x0800 *)
-		| 0x2000  -> DWdmDriver (* 0x2000 *)
-		| 0x8000  -> DTerminalServer (* 0x8000 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x40;0x80;0x100;0x200;0x400;0x800;0x2000;0x8000]
-
-let pe_magic_of_int i = match i with
-	| 0x10b -> P32
-	| 0x107 -> PRom
-	| 0x20b -> P64
-	| _ -> error ("Unknown PE magic number: " ^ string_of_int i)
-
-let clr_flags_of_int iprops = List.fold_left (fun acc i ->
-	if (iprops land i) = i then (match i with
-		| 0x1 -> FIlOnly (* 0x1 *)
-		| 0x2 -> F32BitRequired (* 0x2 *)
-		| 0x4 -> FIlLibrary (* 0x4 *)
-		| 0x8 -> FSigned (* 0x8 *)
-		| 0x10 -> FNativeEntry (* 0x10 *)
-		| 0x10000 -> FTrackDebug (* 0x10000 *)
-		| _ -> assert false) :: acc
-	else
-		acc) [] [0x1;0x2;0x4;0x8;0x10;0x10000]
-
-let get_dir dir ctx =
-	let idx,name = directory_type_info dir in
-	try
-		ctx.pe_header.pe_data_dirs.(idx)
-	with
-		| Invalid_argument _ ->
-			error (Printf.sprintf "The directory '%s' of index '%i' is required but is missing on this file" name idx)
-
-let read_rva = read_real_i32
-
-let read_word is64 i =
-	if is64 then read_i64 i else Int64.logand (Int64.of_int32 (read_real_i32 i)) 0xFFFFFFFFL
-
-let read_coff_header i =
-	let machine = machine_type_of_int (read_ui16 i) in
-	let nsections = read_ui16 i in
-	let stamp = read_real_i32 i in
-	let symbol_table_pointer = read_rva i in
-	let nsymbols = read_i32 i in
-	let optheader_size = read_ui16 i in
-	let props = read_ui16 i in
-	let props = coff_props_of_int (props) in
-	{
-		coff_machine = machine;
-		coff_nsections = nsections;
-		coff_timestamp = stamp;
-		coff_symbol_table_pointer = symbol_table_pointer;
-		coff_nsymbols = nsymbols;
-		coff_optheader_size = optheader_size;
-		coff_props = props;
-	}
-
-let read_pe_header r header =
-	let i = r.i in
-	let sections_offset = (pos r) + header.coff_optheader_size in
-	let magic = pe_magic_of_int (read_ui16 i) in
-	let major = read_byte i in
-	let minor = read_byte i in
-	let code_size = read_i32 i in
-	let init_size = read_i32 i in
-	let uinit_size = read_i32 i in
-	let entry_addr = read_rva i in
-	let base_code = read_rva i in
-	let base_data, read_word = match magic with
-	| P32 | PRom ->
-		read_rva i, read_word false
-	| P64 ->
-		Int32.zero, read_word true
-	in
-
-	(* COFF Windows extension *)
-	let image_base = read_word i in
-	let section_alignment = read_i32 i in
-	let file_alignment = read_i32 i in
-	let major_osver = read_ui16 i in
-	let minor_osver = read_ui16 i in
-	let major_imgver = read_ui16 i in
-	let minor_imgver = read_ui16 i in
-	let major_subsysver = read_ui16 i in
-	let minor_subsysver = read_ui16 i in
-	ignore (read_i32 i); (* reserved *)
-	let image_size = read_i32 i in
-	let headers_size = read_i32 i in
-	let checksum = read_real_i32 i in
-	let subsystem = subsystem_of_int (read_ui16 i) in
-	let dll_props = dll_props_of_int (read_ui16 i) in
-	let stack_reserve = read_word i in
-	let stack_commit = read_word i in
-	let heap_reserve = read_word i in
-	let heap_commit = read_word i in
-	ignore (read_i32 i); (* reserved *)
-	let ndata_dir = read_i32 i in
-	let data_dirs = Array.init ndata_dir (fun n ->
-		let addr = read_rva i in
-		let size = read_rva i in
-		addr,size)
-	in
-	(* sections *)
-	let nsections = header.coff_nsections in
-	seek r sections_offset;
-	let sections = Array.init nsections (fun n ->
-		let name = nread_string i 8 in
-		let name = try
-			let index = String.index name '\x00' in
-			String.sub name 0 index
-		with | Not_found ->
-				name
-		in
-		(*TODO check for slash names *)
-		let vsize = read_rva i in
-		let vaddr = read_rva i in
-		let raw_size = read_rva i in
-		let raw_pointer = read_i32 i in
-		let reloc_pointer = read_i32 i in
-		let line_num_pointer = read_i32 i in
-		let nrelocs = read_ui16 i in
-		let nline_nums = read_ui16 i in
-		let props = section_props_of_int32 (read_rva i) in
-		{
-			s_name = name;
-			s_vsize =vsize;
-			s_vaddr =vaddr;
-			s_raw_size =raw_size;
-			s_raw_pointer =raw_pointer;
-			s_reloc_pointer =reloc_pointer;
-			s_line_num_pointer =line_num_pointer;
-			s_nrelocs =nrelocs;
-			s_nline_nums =nline_nums;
-			s_props =props;
-		}
-	) in
-	{
-		pe_coff_header = header;
-		pe_magic = magic;
-		pe_major = major;
-		pe_minor = minor;
-		pe_code_size = code_size;
-		pe_init_size = init_size;
-		pe_uinit_size = uinit_size;
-		pe_entry_addr = entry_addr;
-		pe_base_code = base_code;
-		pe_base_data = base_data;
-		pe_image_base = image_base;
-		pe_section_alignment = section_alignment;
-		pe_file_alignment = file_alignment;
-		pe_major_osver = major_osver;
-		pe_minor_osver = minor_osver;
-		pe_major_imgver = major_imgver;
-		pe_minor_imgver = minor_imgver;
-		pe_major_subsysver = major_subsysver;
-		pe_minor_subsysver = minor_subsysver;
-		pe_image_size = image_size;
-		pe_headers_size = headers_size;
-		pe_checksum = checksum;
-		pe_subsystem = subsystem;
-		pe_dll_props = dll_props;
-		pe_stack_reserve = stack_reserve;
-		pe_stack_commit = stack_commit;
-		pe_heap_reserve = heap_reserve;
-		pe_heap_commit = heap_commit;
-		pe_ndata_dir = ndata_dir;
-		pe_data_dirs = data_dirs;
-		pe_sections = sections;
-	}
-
-let create_r ch props =
-	let verbose = PMap.mem "IL_VERBOSE" props in
-	let i = IO.input_channel ch in
-	{
-		ch = ch;
-		i = i;
-		verbose = verbose;
-	}
-
-(* converts an RVA into a file offset. *)
-let convert_rva ctx rva =
-	let sections = ctx.pe_header.pe_sections in
-	let nsections = Array.length sections in
-	let sec =
-		(* linear search. TODO maybe binary search for many sections? *)
-		let rec loop n =
-			if n >= nsections then error (Printf.sprintf "The RVA %lx is outside sections bounds!" rva);
-			let sec = sections.(n) in
-			if rva >= sec.s_vaddr && (rva < (Int32.add sec.s_vaddr sec.s_raw_size)) then
-				sec
-			else
-				loop (n+1)
-		in
-		loop 0
-	in
-	let diff = Int32.to_int (Int32.sub rva sec.s_vaddr) in
-	sec.s_raw_pointer + diff
-
-let seek_rva ctx rva = seek ctx.r (convert_rva ctx rva)
-
-let read_cstring i =
-	let ret = Buffer.create 8 in
-	let rec loop () =
-		let chr = read i in
-		if chr = '\x00' then
-			Buffer.contents ret
-		else begin
-			Buffer.add_char ret chr;
-			loop()
-		end
-	in
-	loop()
-
-(* reads import data *)
-let read_idata ctx = match get_dir ImportTable ctx with
-	| 0l,_ | _,0l ->
-		[]
-	| rva,size ->
-		seek_rva ctx rva;
-		let i = ctx.r.i in
-		let rec loop acc =
-			let lookup_table = read_rva i in
-			if lookup_table = Int32.zero then
-				acc
-			else begin
-				let timestamp = read_real_i32 i in
-				let fchain = read_real_i32 i in
-				let name_rva = read_rva i in
-				let addr_table = read_rva i in
-				ignore addr_table; ignore fchain; ignore timestamp;
-				loop ((lookup_table,name_rva) :: acc)
-			end
-		in
-		let tables = loop [] in
-		List.rev_map (function (lookup_table,name_rva) ->
-			seek_rva ctx lookup_table;
-			let is_64 = ctx.pe_header.pe_magic = P64 in
-			let imports_data = if not is_64 then
-				let rec loop acc =
-					let flags = read_real_i32 i in
-					if flags = Int32.zero then
-						acc
-					else begin
-						let is_ordinal = Int32.logand flags 0x80000000l = 0x80000000l in
-						loop ( (is_ordinal, if is_ordinal then Int32.logand flags 0xFFFFl else Int32.logand flags 0x7FFFFFFFl) :: acc )
-					end
-				in
-				loop []
-			else
-				let rec loop acc =
-					let flags = read_i64 i in
-					if flags = Int64.zero then
-						acc
-					else begin
-						let is_ordinal = Int64.logand flags 0x8000000000000000L = 0x8000000000000000L in
-						loop ( (is_ordinal, Int64.to_int32 (if is_ordinal then Int64.logand flags 0xFFFFL else Int64.logand flags 0x7FFFFFFFL)) :: acc )
-					end
-				in
-				loop []
-			in
-			let imports = List.rev_map (function
-				| true, ord ->
-					SOrdinal (Int32.to_int ord)
-				| false, rva ->
-					seek_rva ctx rva;
-					let hint = read_ui16 i in
-					SName (hint, read_cstring i)
-			) imports_data in
-			seek_rva ctx name_rva;
-			let name = read_cstring i in
-			{
-				imp_name = name;
-				imp_imports = imports;
-			}
-		) tables
-
-let has_clr_header ctx = match get_dir ClrRuntimeHeader ctx with
-	| 0l,_ | _,0l ->
-		false
-	| _ ->
-		true
-
-let read_clr_header ctx = match get_dir ClrRuntimeHeader ctx with
-	| 0l,_ | _,0l ->
-		error "This PE file does not have managed content"
-	| rva,size ->
-		seek_rva ctx rva;
-		let i = ctx.r.i in
-		let cb = read_i32 i in
-		let major = read_ui16 i in
-		let minor = read_ui16 i in
-		let read_tbl i =
-			let rva = read_rva i in
-			let size = read_real_i32 i in
-			rva,size
-		in
-		let meta = read_tbl i in
-		let corflags = clr_flags_of_int (read_i32 i) in
-		let entry_point = read_rva i in
-		let res = read_tbl i in
-		let clrsig = read_tbl i in
-		let codeman = read_tbl i in
-		let vtable_fix = read_tbl i in
-		let export_addr = read_tbl i in
-		{
-			clr_cb = cb;
-			clr_major = major;
-			clr_minor = minor;
-			clr_meta = meta;
-			clr_flags = corflags;
-			clr_entry_point = entry_point;
-			clr_res = res;
-			clr_sig = clrsig;
-			clr_codeman = codeman;
-			clr_vtable_fix = vtable_fix;
-			clr_export_address = export_addr;
-		}
-
-let read r =
-	let i = r.i in
-	if read i <> 'M' || read i <> 'Z' then
-		error "MZ magic header not found: Is the target file really a PE?";
-	seek r 0x3c;
-	let pe_sig_offset = read_i32 i in
-	seek r pe_sig_offset;
-	if really_nread_string i 4 <> "PE\x00\x00" then
-		error "Invalid PE header signature: PE expected";
-	let header = read_coff_header i in
-	let pe_header = read_pe_header r header in
-	{
-		r = r;
-		pe_header = pe_header;
-		read_word = read_word (pe_header.pe_magic = P64);
-	}

libs/ilib/peWriter.ml

@@ -1,160 +0,0 @@
-(*
- *  This file is part of ilLib
- *  Copyright (c)2004-2013 Haxe Foundation
- *
- *  This program is free software; you can redistribute it and/or modify
- *  it under the terms of the GNU General Public License as published by
- *  the Free Software Foundation; either version 2 of the License, or
- *  (at your option) any later version.
- *
- *  This program is distributed in the hope that it will be useful,
- *  but WITHOUT ANY WARRANTY; without even the implied warranty of
- *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- *  GNU General Public License for more details.
- *
- *  You should have received a copy of the GNU General Public License
- *  along with this program; if not, write to the Free Software
- *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
- *)
-
-open PeData;;
-open IO;;
-open ExtString;;
-open ExtList;;
-
-exception Error_message of string
-
-let error msg = raise (Error_message msg)
-
-type 'a writer_ctx = {
-	out : 'a IO.output;
-}
-
-let int_of_machine_type t = match t with
-	| TUnknown -> 0x0 (* 0 - unmanaged PE files only *)
-	| Ti386 -> 0x014c (* 0x014c - i386 *)
-	| TR3000 -> 0x0162 (* 0x0162 - R3000 MIPS Little Endian *)
-	| TR4000 -> 0x0166 (* 0x0166 - R4000 MIPS Little Endian *)
-	| TR10000 -> 0x0168 (* 0x0168 - R10000 MIPS Little Endian *)
-	| TWCeMipsV2 -> 0x0169 (* 0x0169 - MIPS Litlte Endian running MS Windows CE 2 *)
-	| TAlpha -> 0x0184 (* 0x0184 - Alpha AXP *)
-	| TSh3 -> 0x01a2 (* 0x01a2 - SH3 Little Endian *)
-	| TSh3Dsp -> 0x01a3 (* 0x01a3 SH3DSP Little Endian *)
-	| TSh3e -> 0x01a4 (* 0x01a4 SH3E Little Endian *)
-	| TSh4 -> 0x01a6 (* 0x01a6 SH4 Little Endian *)
-	| TSh5 -> 0x01a8
-	| TArm -> 0x01c0 (* 0x1c0 ARM Little Endian *)
-	| TArmN -> 0x01c4 (* 0x1c0 ARM Little Endian *)
-	| TArm64 -> 0xaa64 (* 0x1c0 ARM Little Endian *)
-	| TEbc -> 0xebc
-	| TThumb -> 0x01c2 (* 0x1c2 ARM processor with Thumb decompressor *)
-	| TAm33 -> 0x01d3 (* 0x1d3 AM33 processor *)
-	| TPowerPC -> 0x01f0 (* 0x01f0 IBM PowerPC Little Endian *)
-	| TPowerPCFP -> 0x01f1 (* 0x01f1 IBM PowerPC with FPU *)
-	| TItanium64 -> 0x0200 (* 0x0200 Intel IA64 (Itanium( *)
-	| TMips16 -> 0x0266 (* 0x0266 MIPS *)
-	| TAlpha64 -> 0x0284 (* 0x0284 Alpha AXP64 *)
-	| TMipsFpu -> 0x0366 (* 0x0366 MIPS with FPU *)
-	| TMipsFpu16 -> 0x0466 (* 0x0466 MIPS16 with FPU *)
-	| TTriCore -> 0x0520 (* 0x0520 Infineon *)
-	| TAmd64 -> 0x8664 (* 0x8664 AMD x64 and Intel E64T *)
-	| TM32R -> 0x9041 (* 0x9041 M32R *)
-	| TOSXAmd64 -> 0xC020 (* 0xC020 = 0x8664 xor 0x4644 OSX AMD x64 *)
-	| TLinuxAmd64 -> 0xFD1D (* 0xFD1D = 0x8664 xor 0x7B79 Linux AMD x64 *)
-
-let int_of_coff_props props = List.fold_left (fun acc prop ->
-		(match prop with
-			| RelocsStripped -> 0x1 (* 0x1 *)
-			| ExecutableImage -> 0x2 (* 0x2 *)
-			| LineNumsStripped -> 0x4 (* 0x4 *)
-			| LocalSymsStripped -> 0x8 (* 0x8 *)
-			| AgressiveWsTrim -> 0x10 (* 0x10 *)
-			| LargeAddressAware -> 0x20 (* 0x20 *)
-			| BytesReversedLO -> 0x80 (* 0x80 *)
-			| Machine32Bit -> 0x100 (* 0x100 *)
-			| DebugStripped -> 0x200 (* 0x200 *)
-			| RemovableRunFromSwap -> 0x400 (* 0x400 *)
-			| NetRunFromSwap -> 0x800 (* 0x800 *)
-			| FileSystem -> 0x1000 (* 0x1000 *)
-			| FileDll -> 0x2000 (* 0x2000 *)
-			| UpSystemOnly -> 0x4000 (* 0x4000 *)
-			| BytesReversedHI -> 0x8000 (* 0x8000 *)
-		) lor acc
-	) 0 props
-
-let int32_of_section_prop props = List.fold_left (fun acc prop ->
-		Int32.logor (match prop with
-			| SNoPad ->  0x8l (* 0x8 *)
-			| SHasCode ->  0x20l (* 0x20 *)
-			| SHasIData ->  0x40l (* 0x40 *)
-			| SHasData ->  0x80l (* 0x80 *)
-			| SHasLinkInfo ->  0x200l (* 0x200 *)
-			| SLinkRemove ->  0x1000l (* 0x1000 *)
-			| SGlobalRel ->  0x8000l (* 0x8000 *)
-			| SHas16BitMem ->  0x20000l (* 0x20000 *)
-			| SAlign1Bytes ->  0x100000l (* 0x100000 *)
-			| SAlign2Bytes ->  0x200000l (* 0x200000 *)
-			| SAlign4Bytes ->  0x300000l (* 0x300000 *)
-			| SAlign8Bytes ->  0x400000l (* 0x400000 *)
-			| SAlign16Bytes ->  0x500000l (* 0x500000 *)
-			| SAlign32Bytes ->  0x600000l (* 0x600000 *)
-			| SAlign64Bytes ->  0x700000l (* 0x700000 *)
-			| SAlign128Bytes ->  0x800000l (* 0x800000 *)
-			| SAlign256Bytes ->  0x900000l (* 0x900000 *)
-			| SAlign512Bytes ->  0xA00000l (* 0xA00000 *)
-			| SAlign1024Bytes ->  0xB00000l (* 0xB00000 *)
-			| SAlign2048Bytes ->  0xC00000l (* 0xC00000 *)
-			| SAlign4096Bytes ->  0xD00000l (* 0xD00000 *)
-			| SAlign8192Bytes ->  0xE00000l (* 0xE00000 *)
-			| SHasExtRelocs ->  0x1000000l (* 0x1000000 *)
-			| SCanDiscard ->  0x02000000l (* 0x02000000 *)
-			| SNotCached ->  0x04000000l (* 0x04000000 *)
-			| SNotPaged ->  0x08000000l (* 0x08000000 *)
-			| SShared ->  0x10000000l (* 0x10000000 *)
-			| SExec ->  0x20000000l (* 0x20000000 *)
-			| SRead ->  0x40000000l (* 0x40000000 *)
-			| SWrite ->  0x80000000l (* 0x80000000 *)
-		) acc
-	) 0l props
-
-let int_of_pe_magic m = match m with
-	| P32 -> 0x10b
-	| PRom -> 0x107
-	| P64 -> 0x20b
-
-let int_of_subsystem s = match s with
-	|  SUnknown -> 0 (* 0 *)
-	|  SNative -> 1 (* 1 *)
-	|  SWGui -> 2 (* 2 *)
-	|  SWCui -> 3 (* 3 *)
-	|  SPCui -> 7 (* 7 *)
-	|  SWCeGui -> 9 (* 9 *)
-	|  SEfi -> 10 (* 10 *)
-	|  SEfiBoot -> 11 (* 11 *)
-	|  SEfiRuntime -> 12 (* 12 *)
-	|  SEfiRom -> 13 (* 13 *)
-	|  SXbox -> 14 (* 14 *)
-
-let int_of_dll_props props = List.fold_left (fun acc prop ->
-		(match prop with
-		| DDynamicBase -> 0x0040 (* 0x0040 *)
-		| DForceIntegrity -> 0x0080 (* 0x0080 *)
-		| DNxCompat -> 0x0100 (* 0x0100 *)
-		| DNoIsolation -> 0x0200 (* 0x0200 *)
-		| DNoSeh -> 0x0400 (* 0x0400 *)
-		| DNoBind -> 0x0800 (* 0x0800 *)
-		| DWdmDriver -> 0x2000 (* 0x2000 *)
-		| DTerminalServer -> 0x8000 (* 0x8000 *)
-		) lor acc
-	) 0 props
-
-let int_of_clr_flags props = List.fold_left (fun acc prop ->
-		(match prop with
-		| FIlOnly ->  0x1  (* 0x1 *)
-		| F32BitRequired ->  0x2  (* 0x2 *)
-		| FIlLibrary ->  0x4  (* 0x4 *)
-		| FSigned ->  0x8  (* 0x8 *)
-		| FNativeEntry ->  0x10  (* 0x10 *)
-		| FTrackDebug ->  0x10000  (* 0x10000 *)
-		) lor acc
-	) 0 props

libs/javalib/Makefile

@@ -1,22 +0,0 @@
-OCAMLOPT=ocamlopt
-OCAMLC=ocamlc
-SRC=jData.ml jReader.ml jWriter.ml
-
-all: bytecode native
-
-native: javalib.cmxa
-bytecode: javalib.cma
-
-javalib.cmxa: $(SRC)
-	ocamlfind $(OCAMLOPT) -g -package extlib -safe-string -a -o javalib.cmxa $(SRC)
-
-javalib.cma: $(SRC)
-	ocamlfind $(OCAMLC) -g -package extlib -safe-string -a -o javalib.cma $(SRC)
-
-clean:
-	rm -rf javalib.cmxa javalib.cma javalib.lib javalib.a $(wildcard *.cmx) $(wildcard *.obj) $(wildcard *.o) $(wildcard *.cmi) $(wildcard *.cmo)
-
-.PHONY: all bytecode native clean
-
-Makefile: ;
-$(SRC): ;

libs/javalib/dune

@@ -1,7 +0,0 @@
-(include_subdirs no)
-
-(library
-	(name javalib)
-	(libraries extlib)
-	(wrapped false)
-)

libs/javalib/jData.ml

@@ -1,267 +0,0 @@
-(*
- *  This file is part of JavaLib
- *  Copyright (c)2004-2012 Nicolas Cannasse and Caue Waneck
- *
- *  This program is free software; you can redistribute it and/or modify
- *  it under the terms of the GNU General Public License as published by
- *  the Free Software Foundation; either version 2 of the License, or
- *  (at your option) any later version.
- *
- *  This program is distributed in the hope that it will be useful,
- *  but WITHOUT ANY WARRANTY; without even the implied warranty of
- *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- *  GNU General Public License for more details.
- *
- *  You should have received a copy of the GNU General Public License
- *  along with this program; if not, write to the Free Software
- *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
- *)
-
-type jpath = (string list) * string
-
-type jversion = int * int (* minor + major *)
-
-(** unqualified names cannot have the characters '.', ';', '[' or '/' *)
-type unqualified_name = string
-
-type jwildcard =
-  | WExtends (* + *)
-  | WSuper (* -  *)
-  | WNone
-
-type jtype_argument =
-  | TType of jwildcard * jsignature
-  | TAny (* * *)
-
-and jsignature =
-  | TByte (* B *)
-  | TChar (* C *)
-  | TDouble (* D *)
-  | TFloat (* F *)
-  | TInt (* I *)
-  | TLong (* J *)
-  | TShort (* S *)
-  | TBool (* Z *)
-  | TObject of jpath * jtype_argument list (* L Classname *)
-  | TObjectInner of (string list) * (string * jtype_argument list) list (* L Classname ClassTypeSignatureSuffix *)
-  | TArray of jsignature * int option (* [ *)
-  | TMethod of jmethod_signature (* ( *)
-  | TTypeParameter of string (* T *)
-
-(* ( jsignature list ) ReturnDescriptor (| V | jsignature) *)
-and jmethod_signature = jsignature list * jsignature option
-
-(* InvokeDynamic-specific: Method handle *)
-type reference_type =
-  | RGetField (* constant must be ConstField *)
-  | RGetStatic (* constant must be ConstField *)
-  | RPutField (* constant must be ConstField *)
-  | RPutStatic (* constant must be ConstField *)
-  | RInvokeVirtual (* constant must be Method *)
-  | RInvokeStatic (* constant must be Method *)
-  | RInvokeSpecial (* constant must be Method *)
-  | RNewInvokeSpecial (* constant must be Method with name <init> *)
-  | RInvokeInterface (* constant must be InterfaceMethod *)
-
-(* TODO *)
-type bootstrap_method = int
-
-type jconstant =
-  (** references a class or an interface - jpath must be encoded as StringUtf8 *)
-  | ConstClass of jpath (* tag = 7 *)
-  (** field reference *)
-  | ConstField of (jpath * unqualified_name * jsignature) (* tag = 9 *)
-  (** method reference; string can be special "<init>" and "<clinit>" values *)
-  | ConstMethod of (jpath * unqualified_name * jmethod_signature) (* tag = 10 *)
-  (** interface method reference *)
-  | ConstInterfaceMethod of (jpath * unqualified_name * jmethod_signature) (* tag = 11 *)
-  (** constant values *)
-  | ConstString of string  (* tag = 8 *)
-  | ConstInt of int32 (* tag = 3 *)
-  | ConstFloat of float (* tag = 4 *)
-  | ConstLong of int64 (* tag = 5 *)
-  | ConstDouble of float (* tag = 6 *)
-  (** name and type: used to represent a field or method, without indicating which class it belongs to *)
-  | ConstNameAndType of unqualified_name * jsignature
-  (** UTF8 encoded strings. Note that when reading/writing, take into account Utf8 modifications of java *)
-  (* (http://docs.oracle.com/javase/specs/jvms/se7/html/jvms-4.html#jvms-4.4.7) *)
-  | ConstUtf8 of string
-  (** invokeDynamic-specific *)
-  | ConstMethodHandle of (reference_type * jconstant) (* tag = 15 *)
-  | ConstMethodType of jmethod_signature (* tag = 16 *)
-  | ConstDynamic of (bootstrap_method * unqualified_name * jsignature) (* tag = 17 *)
-  | ConstInvokeDynamic of (bootstrap_method * unqualified_name * jsignature) (* tag = 18 *)
-  | ConstModule of unqualified_name (* tag = 19 *)
-  | ConstPackage of unqualified_name (* tag = 20 *)
-  | ConstUnusable
-
-type jaccess_flag =
-  | JPublic (* 0x0001 *)
-  | JPrivate (* 0x0002 *)
-  | JProtected (* 0x0004 *)
-  | JStatic (* 0x0008 *)
-  | JFinal (* 0x0010 *)
-  | JSynchronized (* 0x0020 *)
-  | JVolatile (* 0x0040 *)
-  | JTransient (* 0x0080 *)
-  (** added if created by the compiler *)
-  | JSynthetic (* 0x1000 *)
-  | JEnum (* 0x4000 *)
-  | JUnusable (* should not be present *)
-  (** class flags *)
-  | JSuper (* 0x0020 *)
-  | JInterface (* 0x0200 *)
-  | JAbstract (* 0x0400 *)
-  | JAnnotation (* 0x2000 *)
-  | JModule (* 0x8000 *)
-  (** method flags *)
-  | JBridge (* 0x0040 *)
-  | JVarArgs (* 0x0080 *)
-  | JNative (* 0x0100 *)
-  | JStrict (* 0x0800 *)
-
-type jaccess = jaccess_flag list
-
-(* type parameter name, extends signature, implements signatures *)
-type jtypes = (string * jsignature option * jsignature list) list
-
-type jannotation = {
-  ann_type : jsignature;
-  ann_elements : (string * jannotation_value) list;
-}
-
-and jannotation_value =
-  | ValConst of jsignature * jconstant (* B, C, D, E, F, I, J, S, Z, s *)
-  | ValEnum of jsignature * string (* e *)
-  | ValClass of jsignature (* c *) (* V -> Void *)
-  | ValAnnotation of jannotation (* @ *)
-  | ValArray of jannotation_value list (* [ *)
-
-type jlocal = {
-	ld_start_pc : int;
-	ld_length : int;
-	ld_name : string;
-	ld_descriptor : string;
-	ld_index : int;
-}
-
-type jattribute =
-  | AttrDeprecated
-  | AttrVisibleAnnotations of jannotation list
-  | AttrInvisibleAnnotations of jannotation list
-  | AttrLocalVariableTable of jlocal list
-  | AttrMethodParameters of (string * int) list
-  | AttrUnknown of string * string
-
-type jcode = jattribute list (* TODO *)
-
-type jfield_kind =
-  | JKField
-  | JKMethod
-
-type jfield = {
-  jf_name : string;
-  jf_kind : jfield_kind;
-  (* signature, as used by the vm *)
-  jf_vmsignature : jsignature;
-  (* actual signature, as used in java code *)
-  jf_signature : jsignature;
-  jf_throws : jsignature list;
-  jf_types : jtypes;
-  jf_flags : jaccess;
-  jf_attributes : jattribute list;
-  jf_constant : jconstant option;
-  jf_code : jcode option;
-}
-
-type jclass = {
-  cversion : jversion;
-  cpath : jpath;
-  csuper : jsignature;
-  cflags : jaccess;
-  cinterfaces : jsignature list;
-  cfields : jfield list;
-  cmethods : jfield list;
-  cattributes : jattribute list;
-
-  cinner_types : (jpath * jpath option * string option * jaccess) list;
-  ctypes : jtypes;
-}
-
-(* reading/writing *)
-type utf8ref = int
-type classref = int
-type nametyperef = int
-type dynref = int
-type bootstrapref = int
-
-type jconstant_raw =
-  | KClass of utf8ref (* 7 *)
-  | KFieldRef of (classref * nametyperef) (* 9 *)
-  | KMethodRef of (classref * nametyperef) (* 10 *)
-  | KInterfaceMethodRef of (classref * nametyperef) (* 11 *)
-  | KString of utf8ref (* 8 *)
-  | KInt of int32 (* 3 *)
-  | KFloat of float (* 4 *)
-  | KLong of int64 (* 5 *)
-  | KDouble of float (* 6 *)
-  | KNameAndType of (utf8ref * utf8ref) (* 12 *)
-  | KUtf8String of string (* 1 *)
-  | KMethodHandle of (reference_type * dynref) (* 15 *)
-  | KMethodType of utf8ref (* 16 *)
-  | KDynamic of (bootstrapref * nametyperef) (* 17 *)
-  | KInvokeDynamic of (bootstrapref * nametyperef) (* 18 *)
-  | KModule of utf8ref (* 19 *)
-  | KPackage of utf8ref (* 20 *)
-  | KUnusable
-
-(* jData debugging *)
-let is_override_attrib = (function
-    (* TODO: pass anotations as @:meta *)
-    | AttrVisibleAnnotations ann ->
-      List.exists (function
-        | { ann_type = TObject( (["java";"lang"], "Override"), [] ) } ->
-            true
-        | _ -> false
-      ) ann
-    | _ -> false
-  )
-
-let is_override field =
-  List.exists is_override_attrib field.jf_attributes
-
-let path_s = function
-  | (pack,name) -> String.concat "." (pack @ [name])
-
-let rec s_sig = function
-  | TByte (* B *) -> "byte"
-  | TChar (* C *) -> "char"
-  | TDouble (* D *) -> "double"
-  | TFloat (* F *) -> "float"
-  | TInt (* I *) -> "int"
-  | TLong (* J *) -> "long"
-  | TShort (* S *) -> "short"
-  | TBool (* Z *) -> "bool"
-  | TObject(path,args) -> path_s  path ^ s_args args
-  | TObjectInner (sl, sjargl) -> String.concat "." sl ^ "." ^ (String.concat "." (List.map (fun (s,arg) -> s ^ s_args arg) sjargl))
-  | TArray (s,i) -> s_sig s ^ "[" ^ (match i with | None -> "" | Some i -> string_of_int i) ^ "]"
-  | TMethod (sigs, sopt) -> (match sopt with | None -> "" | Some s -> s_sig s ^ " ") ^ "(" ^ String.concat ", " (List.map s_sig sigs) ^ ")"
-  | TTypeParameter s -> s
-
-and s_args = function
-  | [] -> ""
-  | args -> "<" ^ String.concat ", " (List.map (fun t ->
-      match t with
-      | TAny -> "*"
-      | TType (wc, s) ->
-        (match wc with
-          | WNone -> ""
-          | WExtends -> "+"
-          | WSuper -> "-") ^
-        (s_sig s))
-    args) ^ ">"
-
-let s_field f = (if is_override f then "override " else "") ^ s_sig f.jf_signature ^ " " ^ f.jf_name
-
-let s_fields fs = "{ \n\t" ^ String.concat "\n\t" (List.map s_field fs) ^ "\n}"
-

libs/javalib/jReader.ml

@@ -1,646 +0,0 @@
-(*
- *  This file is part of JavaLib
- *  Copyright (c)2004-2012 Nicolas Cannasse and Caue Waneck
- *
- *  This program is free software; you can redistribute it and/or modify
- *  it under the terms of the GNU General Public License as published by
- *  the Free Software Foundation; either version 2 of the License, or
- *  (at your option) any later version.
- *
- *  This program is distributed in the hope that it will be useful,
- *  but WITHOUT ANY WARRANTY; without even the implied warranty of
- *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- *  GNU General Public License for more details.
- *
- *  You should have received a copy of the GNU General Public License
- *  along with this program; if not, write to the Free Software
- *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
- *)
-open JData;;
-open IO.BigEndian;;
-open ExtString;;
-open ExtList;;
-
-exception Error_message of string
-
-let error msg = raise (Error_message msg)
-
-let get_reference_type i constid =
-  match i with
-  | 1 -> RGetField
-  | 2 -> RGetStatic
-  | 3 -> RPutField
-  | 4 -> RPutStatic
-  | 5 -> RInvokeVirtual
-  | 6 -> RInvokeStatic
-  | 7 -> RInvokeSpecial
-  | 8 -> RNewInvokeSpecial
-  | 9 -> RInvokeInterface
-  | _ -> error (string_of_int constid ^ ": Invalid reference type " ^ string_of_int i)
-
-let parse_constant max idx ch =
-  let cid = IO.read_byte ch in
-  let error() = error (string_of_int idx ^ ": Invalid constant " ^ string_of_int cid) in
-  let index() =
-    let n = read_ui16 ch in
-    if n = 0 || n >= max then error();
-    n
-  in
-  match cid with
-  | 7 ->
-    KClass (index())
-  | 9 ->
-    let n1 = index() in
-    let n2 = index() in
-    KFieldRef (n1,n2)
-  | 10 ->
-    let n1 = index() in
-    let n2 = index() in
-    KMethodRef (n1,n2)
-  | 11 ->
-    let n1 = index() in
-    let n2 = index() in
-    KInterfaceMethodRef (n1,n2)
-  | 8 ->
-    KString (index())
-  | 3 ->
-    KInt (read_real_i32 ch)
-  | 4 ->
-    let f = Int32.float_of_bits (read_real_i32 ch) in
-    KFloat f
-  | 5 ->
-    KLong (read_i64 ch)
-  | 6 ->
-    KDouble (read_double ch)
-  | 12 ->
-    let n1 = index() in
-    let n2 = index() in
-    KNameAndType (n1, n2)
-  | 1 ->
-    let len = read_ui16 ch in
-    let str = IO.nread_string ch len in
-    (* TODO: correctly decode modified UTF8 *)
-    KUtf8String str
-  | 15 ->
-    let reft = get_reference_type (IO.read_byte ch) idx in
-    let dynref = index() in
-    KMethodHandle (reft, dynref)
-  | 16 ->
-    KMethodType (index())
-  | 17 ->
-    let bootstrapref = read_ui16 ch in (* not index *)
-    let nametyperef = index() in
-    KDynamic (bootstrapref, nametyperef)
-  | 18 ->
-    let bootstrapref = read_ui16 ch in (* not index *)
-    let nametyperef = index() in
-    KInvokeDynamic (bootstrapref, nametyperef)
-  | 19 ->
-    KModule (index())
-  | 20 ->
-    KPackage (index())
-  | n ->
-    error()
-
-let expand_path s =
-  let rec loop remaining acc =
-    match remaining with
-    | name :: [] -> List.rev acc, name
-    | v :: tl -> loop tl (v :: acc)
-    | _ -> assert false
-  in
-  loop (String.nsplit s "/") []
-
-let rec parse_type_parameter_part s =
-  match s.[0] with
-  | '*' -> TAny, 1
-  | c ->
-    let wildcard, i = match c with
-      | '+' -> WExtends, 1
-      | '-' -> WSuper, 1
-      | _ -> WNone, 0
-    in
-    let jsig, l = parse_signature_part (String.sub s i (String.length s - 1)) in
-    (TType (wildcard, jsig), l + i)
-
-and parse_signature_part s =
-  let len = String.length s in
-  if len = 0 then raise Exit;
-  match s.[0] with
-  | 'B' -> TByte, 1
-  | 'C' -> TChar, 1
-  | 'D' -> TDouble, 1
-  | 'F' -> TFloat, 1
-  | 'I' -> TInt, 1
-  | 'J' -> TLong, 1
-  | 'S' -> TShort, 1
-  | 'Z' -> TBool, 1
-  | 'L' ->
-    (try
-      let orig_s = s in
-      let rec loop start i acc =
-        match s.[i] with
-        | '/' -> loop (i + 1) (i + 1) (String.sub s start (i - start) :: acc)
-        | ';' | '.' -> List.rev acc, (String.sub s start (i - start)), [], (i)
-        | '<' ->
-          let name = String.sub s start (i - start) in
-          let rec loop_params i acc =
-            let s = String.sub s i (len - i) in
-            match s.[0] with
-            | '>' -> List.rev acc, i + 1
-            | _ ->
-              let tp, l = parse_type_parameter_part s in
-              loop_params (l + i) (tp :: acc)
-          in
-          let params, _end = loop_params (i + 1) [] in
-          List.rev acc, name, params, (_end)
-        | _ -> loop start (i+1) acc
-      in
-      let pack, name, params, _end = loop 1 1 [] in
-      let rec loop_inner i acc =
-        match s.[i] with
-        | '.' ->
-          let pack, name, params, _end = loop (i+1) (i+1) [] in
-          if pack <> [] then error ("Inner types must not define packages. For '" ^ orig_s ^ "'.");
-          loop_inner _end ( (name,params) :: acc )
-        | ';' -> List.rev acc, i + 1
-        | c -> error ("End of complex type signature expected after type parameter. Got '" ^ Char.escaped c ^ "' for '" ^ orig_s ^ "'." );
-      in
-      let inners, _end = loop_inner _end [] in
-      match inners with
-      | [] -> TObject((pack,name), params), _end
-      | _ -> TObjectInner( pack, (name,params) :: inners ), _end
-    with
-      Invalid_string -> raise Exit)
-  | '[' ->
-    let p = ref 1 in
-    while !p < String.length s && s.[!p] >= '0' && s.[!p] <= '9' do
-      incr p;
-    done;
-    let size = (if !p > 1 then Some (int_of_string (String.sub s 1 (!p - 1))) else None) in
-    let s , l = parse_signature_part (String.sub s !p (String.length s - !p)) in
-    TArray (s,size) , l + !p
-  | '(' ->
-    let p = ref 1 in
-    let args = ref [] in
-    while !p < String.length s && s.[!p] <> ')' do
-      let a , l = parse_signature_part (String.sub s !p (String.length s - !p)) in
-      args := a :: !args;
-      p := !p + l;
-    done;
-    incr p;
-    if !p >= String.length s then raise Exit;
-    let ret , l = (match s.[!p] with 'V' -> None , 1 | _ ->
-      let s, l = parse_signature_part (String.sub s !p (String.length s - !p)) in
-      Some s, l
-    ) in
-    TMethod (List.rev !args,ret) , !p + l
-  | 'T' ->
-    (try
-      let s1 , _ = String.split s ";" in
-      let len = String.length s1 in
-      TTypeParameter (String.sub s1 1 (len - 1)) , len + 1
-    with
-      Invalid_string -> raise Exit)
-  | _ ->
-    raise Exit
-
-let parse_signature s =
-  try
-    let sign , l = parse_signature_part s in
-    if String.length s <> l then raise Exit;
-    sign
-  with
-    Exit -> error ("Invalid signature '" ^ s ^ "'")
-
-let parse_method_signature s =
-  match parse_signature s with
-  | (TMethod m) -> m
-  | _ -> error ("Unexpected signature '" ^ s ^ "'. Expecting method")
-
-let parse_formal_type_params s =
-  match s.[0] with
-  | '<' ->
-    let rec read_id i =
-      match s.[i] with
-      | ':' | '>' -> i
-      | _ -> read_id (i + 1)
-    in
-    let len = String.length s in
-    let rec parse_params idx acc =
-      let idi = read_id (idx + 1) in
-      let id = String.sub s (idx + 1) (idi - idx - 1) in
-      (* next must be a : *)
-      (match s.[idi] with | ':' -> () | _ -> error ("Invalid formal type signature character: " ^ Char.escaped s.[idi] ^ " ; from " ^ s));
-      let ext, l = match s.[idi + 1] with
-        | ':' | '>' -> None, idi + 1
-        | _ ->
-          let sgn, l = parse_signature_part (String.sub s (idi + 1) (len - idi - 1)) in
-          Some sgn, l + idi + 1
-      in
-      let rec loop idx acc =
-        match s.[idx] with
-        | ':' ->
-          let ifacesig, ifacei = parse_signature_part (String.sub s (idx + 1) (len - idx - 1)) in
-          loop (idx + ifacei + 1) (ifacesig :: acc)
-        | _ -> acc, idx
-      in
-      let ifaces, idx = loop l [] in
-      let acc = (id, ext, ifaces) :: acc in
-      if s.[idx] = '>' then List.rev acc, idx + 1 else parse_params (idx - 1) acc
-    in
-    parse_params 0 []
-  | _ -> [], 0
-
-let parse_throws s =
-  let len = String.length s in
-  let rec loop idx acc =
-    if idx > len then raise Exit
-    else if idx = len then acc, idx
-    else match s.[idx] with
-    | '^' ->
-      let tsig, l = parse_signature_part (String.sub s (idx+1) (len - idx - 1)) in
-      loop (idx + l + 1) (tsig :: acc)
-    | _ -> acc, idx
-  in
-  loop 0 []
-
-let parse_complete_method_signature s =
-  try
-    let len = String.length s in
-    let tparams, i = parse_formal_type_params s in
-    let sign, l = parse_signature_part (String.sub s i (len - i)) in
-    let throws, l2 = parse_throws (String.sub s (i+l) (len - i - l)) in
-    if (i + l + l2) <> len then raise Exit;
-
-    match sign with
-    | TMethod msig -> tparams, msig, throws
-    | _ -> raise Exit
-  with
-    Exit -> error ("Invalid method extended signature '" ^ s ^ "'")
-
-
-let rec expand_constant consts i =
-  let unexpected i = error (string_of_int i ^ ": Unexpected constant type") in
-  let expand_path n = match Array.get consts n with
-    | KUtf8String s -> expand_path s
-    | _ -> unexpected n
-  in
-  let expand_cls n = match expand_constant consts n with
-    | ConstClass p -> p
-    | _ -> unexpected n
-  in
-  let expand_nametype n = match expand_constant consts n with
-    | ConstNameAndType (s,jsig) -> s, jsig
-    | _ -> unexpected n
-  in
-  let expand_string n = match Array.get consts n with
-    | KUtf8String s -> s
-    | _ -> unexpected n
-  in
-  let expand_nametype_m n = match expand_nametype n with
-    | (n, TMethod m) -> n, m
-    | _ -> unexpected n
-  in
-  let expand ncls nt = match expand_cls ncls, expand_nametype nt with
-    | path, (n, m) -> path, n, m
-  in
-  let expand_m ncls nt = match expand_cls ncls, expand_nametype_m nt with
-    | path, (n, m) -> path, n, m
-  in
-
-  match Array.get consts i with
-  | KClass utf8ref ->
-    ConstClass (expand_path utf8ref)
-  | KFieldRef (classref, nametyperef) ->
-    ConstField (expand classref nametyperef)
-  | KMethodRef (classref, nametyperef) ->
-    ConstMethod (expand_m classref nametyperef)
-  | KInterfaceMethodRef (classref, nametyperef) ->
-    ConstInterfaceMethod (expand_m classref nametyperef)
-  | KString utf8ref ->
-    ConstString (expand_string utf8ref)
-  | KInt i32 ->
-    ConstInt i32
-  | KFloat f ->
-    ConstFloat f
-  | KLong i64 ->
-    ConstLong i64
-  | KDouble d ->
-    ConstDouble d
-  | KNameAndType (n, t) ->
-    ConstNameAndType(expand_string n, parse_signature (expand_string t))
-  | KUtf8String s ->
-    ConstUtf8 s (* TODO: expand UTF8 characters *)
-  | KMethodHandle (reference_type, dynref) ->
-    ConstMethodHandle (reference_type, expand_constant consts dynref)
-  | KMethodType utf8ref ->
-    ConstMethodType (parse_method_signature (expand_string utf8ref))
-  | KDynamic(bootstrapref, nametyperef) ->
-    let n, t = expand_nametype nametyperef in
-    ConstDynamic(bootstrapref, n, t)
-  | KInvokeDynamic (bootstrapref, nametyperef) ->
-    let n, t = expand_nametype nametyperef in
-    ConstInvokeDynamic(bootstrapref, n, t)
-  | KModule n ->
-    ConstModule (expand_string n)
-  | KPackage n ->
-    ConstPackage (expand_string n)
-  | KUnusable ->
-    ConstUnusable
-
-let parse_access_flags ch all_flags =
-  let fl = read_ui16 ch in
-  let flags = ref [] in
-  List.iteri (fun fbit f ->
-    if fl land (1 lsl fbit) <> 0 then begin
-      flags := f :: !flags;
-      if f = JUnusable then error ("Unusable flag: " ^ string_of_int fl)
-    end
-  ) all_flags;
-  (*if fl land (0x4000 - (1 lsl !fbit)) <> 0 then error ("Invalid access flags " ^ string_of_int fl);*)
-  !flags
-
-let get_constant c n =
-  if n < 1 || n >= Array.length c then error ("Invalid constant index " ^ string_of_int n);
-  match c.(n) with
-  | ConstUnusable -> error "Unusable constant index";
-  | x -> x
-
-let get_class consts ch =
-  match get_constant consts (read_ui16 ch) with
-  | ConstClass n -> n
-  | _ -> error "Invalid class index"
-
-let get_string consts ch =
-  let i = read_ui16 ch in
-  match get_constant consts i with
-  | ConstUtf8 s -> s
-  | _ -> error ("Invalid string index " ^ string_of_int i)
-
-let rec parse_element_value consts ch =
-  let tag = IO.read_byte ch in
-  match Char.chr tag with
-  | 'B' | 'C' | 'D' | 'F' | 'I' | 'J' | 'S' | 'Z' | 's' ->
-    let jsig = match (Char.chr tag) with
-      | 's' ->
-        TObject( (["java";"lang"],"String"), [] )
-      | tag ->
-        fst (parse_signature_part (Char.escaped tag))
-    in
-    ValConst(jsig, get_constant consts (read_ui16 ch))
-  | 'e' ->
-    let path = parse_signature (get_string consts ch) in
-    let name = get_string consts ch in
-    ValEnum (path, name)
-  | 'c' ->
-    let name = get_string consts ch in
-    let jsig = if name = "V" then
-      TObject(([], "Void"), [])
-    else
-      parse_signature name
-    in
-    ValClass jsig
-  | '@' ->
-    ValAnnotation (parse_annotation consts ch)
-  | '[' ->
-    let num_vals = read_ui16 ch in
-    ValArray (List.init (num_vals) (fun _ -> parse_element_value consts ch))
-  | tag -> error ("Invalid element value: '" ^  Char.escaped tag ^ "'")
-
-and parse_ann_element consts ch =
-  let name = get_string consts ch in
-  let element_value = parse_element_value consts ch in
-  name, element_value
-
-and parse_annotation consts ch =
-  let anntype = parse_signature (get_string consts ch) in
-  let count = read_ui16 ch in
-  {
-    ann_type = anntype;
-    ann_elements = List.init count (fun _ -> parse_ann_element consts ch)
-  }
-
-let parse_attribute on_special consts ch =
-  let aname = get_string consts ch in
-  let error() = error ("Malformed attribute " ^ aname) in
-  let alen = read_i32 ch in
-  match aname with
-  | "Deprecated" ->
-    if alen <> 0 then error();
-    Some (AttrDeprecated)
-  | "LocalVariableTable" ->
-	let len = read_ui16 ch in
-	let locals = List.init len (fun _ ->
-		let start_pc = read_ui16 ch in
-		let length = read_ui16 ch in
-		let name = get_string consts ch in
-		let descriptor = get_string consts ch in
-		let index = read_ui16 ch in
-		{
-			ld_start_pc = start_pc;
-			ld_length = length;
-			ld_name = name;
-			ld_descriptor = descriptor;
-			ld_index = index
-		}
-	) in
-	Some (AttrLocalVariableTable locals)
-  | "MethodParameters" ->
-	let len = IO.read_byte ch in
-	let parameters = List.init len (fun _ ->
-		let name = get_string consts ch in
-		let flags = read_ui16 ch in
-		(name,flags)
-	) in
-	Some (AttrMethodParameters parameters)
-  | "RuntimeVisibleAnnotations" ->
-    let anncount = read_ui16 ch in
-    Some (AttrVisibleAnnotations (List.init anncount (fun _ -> parse_annotation consts ch)))
-  | "RuntimeInvisibleAnnotations" ->
-    let anncount = read_ui16 ch in
-    Some (AttrInvisibleAnnotations (List.init anncount (fun _ -> parse_annotation consts ch)))
-  | _ ->
-    let do_default () =
-      Some (AttrUnknown (aname,IO.nread_string ch alen))
-    in
-    match on_special with
-    | None -> do_default()
-    | Some fn -> fn consts ch aname alen do_default
-
-let parse_attributes ?on_special consts ch count =
-  let rec loop i acc =
-    if i >= count then List.rev acc
-    else match parse_attribute on_special consts ch with
-    | None -> loop (i + 1) acc
-    | Some attrib -> loop (i + 1) (attrib :: acc)
-  in
-  loop 0 []
-
-let parse_field kind consts ch =
-  let all_flags = match kind with
-    | JKField ->
-      [JPublic; JPrivate; JProtected; JStatic; JFinal; JUnusable; JVolatile; JTransient; JSynthetic; JEnum]
-    | JKMethod ->
-      [JPublic; JPrivate; JProtected; JStatic; JFinal; JSynchronized; JBridge; JVarArgs; JNative; JUnusable; JAbstract; JStrict; JSynthetic]
-  in
-  let acc = ref (parse_access_flags ch all_flags) in
-  let name = get_string consts ch in
-  let sign = parse_signature (get_string consts ch) in
-
-  let jsig = ref sign in
-  let throws = ref [] in
-  let types = ref [] in
-  let constant = ref None in
-  let code = ref None in
-
-  let attrib_count = read_ui16 ch in
-  let attribs = parse_attributes ~on_special:(fun _ _ aname alen do_default ->
-    match kind, aname with
-    | JKField, "ConstantValue" ->
-      constant := Some (get_constant consts (read_ui16 ch));
-      None
-    | JKField, "Synthetic" ->
-      if not (List.mem JSynthetic !acc) then acc := !acc @ [JSynthetic];
-      None
-    | JKField, "Signature" ->
-      let s = get_string consts ch in
-      jsig := parse_signature s;
-      None
-    | JKMethod, "Code" ->
-	  ignore(read_ui16 ch); (* max stack *)
-	  ignore(read_ui16 ch); (* max locals *)
-	  let len = read_i32 ch in
-	  ignore(IO.nread_string ch len); (* code *)
-	  let len = read_ui16 ch in
-	  for i = 0 to len - 1 do
-	  	ignore(IO.nread_string ch 8);
-	  done; (* exceptions *)
-      let attrib_count = read_ui16 ch in
-	  let attribs = parse_attributes consts ch attrib_count in
-	  code := Some attribs;
-	  None
-    | JKMethod, "Exceptions" ->
-      let num = read_ui16 ch in
-      throws := List.init num (fun _ -> TObject(get_class consts ch,[]));
-      None
-    | JKMethod, "Signature" ->
-      let s = get_string consts ch in
-      let tp, sgn, thr = parse_complete_method_signature s in
-      if thr <> [] then throws := thr;
-      types := tp;
-      jsig := TMethod(sgn);
-      None
-    | _ -> do_default()
-  ) consts ch attrib_count in
-  {
-    jf_name = name;
-    jf_kind = kind;
-    (* signature, as used by the vm *)
-    jf_vmsignature = sign;
-    (* actual signature, as used in java code *)
-    jf_signature = !jsig;
-    jf_throws = !throws;
-    jf_types = !types;
-    jf_flags = !acc;
-    jf_attributes = attribs;
-    jf_constant = !constant;
-    jf_code = !code;
-  }
-
-let parse_class ch =
-  if read_real_i32 ch <> 0xCAFEBABEl then error "Invalid header";
-  let minorv = read_ui16 ch in
-  let majorv = read_ui16 ch in
-  let constant_count = read_ui16 ch in
-  let const_big = ref true in
-  let consts = Array.init constant_count (fun idx ->
-    if !const_big then begin
-      const_big := false;
-      KUnusable
-    end else
-      let c = parse_constant constant_count idx ch in
-      (match c with KLong _ | KDouble _ -> const_big := true | _ -> ());
-      c
-  ) in
-  let consts = Array.mapi (fun i _ -> expand_constant consts i) consts in
-  let flags = parse_access_flags ch [JPublic; JUnusable; JUnusable; JUnusable; JFinal; JSuper; JUnusable; JUnusable; JUnusable; JInterface; JAbstract; JUnusable; JSynthetic; JAnnotation; JEnum; JModule] in
-  let this = get_class consts ch in
-  let super_idx = read_ui16 ch in
-  let super = match super_idx with
-    | 0 -> TObject((["java";"lang"], "Object"), []);
-    | idx -> match get_constant consts idx with
-      | ConstClass path -> TObject(path,[])
-      | _ -> error "Invalid super index"
-  in
-  let interfaces = List.init (read_ui16 ch) (fun _ -> TObject (get_class consts ch, [])) in
-  let fields = List.init (read_ui16 ch) (fun _ -> parse_field JKField consts ch) in
-  let methods = List.init (read_ui16 ch) (fun _ -> parse_field JKMethod consts ch) in
-
-  let inner = ref [] in
-  let types = ref [] in
-  let super = ref super in
-  let interfaces = ref interfaces in
-
-  let attribs = read_ui16 ch in
-  let attribs = parse_attributes ~on_special:(fun _ _ aname alen do_default ->
-    match aname with
-    | "InnerClasses" ->
-      let count = read_ui16 ch in
-      let classes = List.init count (fun _ ->
-        let inner_ci = get_class consts ch in
-        let outeri = read_ui16 ch in
-        let outer_ci = match outeri with
-          | 0 -> None
-          | _ -> match get_constant consts outeri with
-          | ConstClass n -> Some n
-          | _ -> error "Invalid class index"
-        in
-
-        let inner_namei = read_ui16 ch in
-        let inner_name = match inner_namei with
-          | 0 -> None
-          | _ -> match get_constant consts inner_namei with
-          | ConstUtf8 s -> Some s
-          | _ -> error ("Invalid string index " ^ string_of_int inner_namei)
-        in
-        let flags = parse_access_flags ch [JPublic; JPrivate; JProtected; JStatic; JFinal; JUnusable; JUnusable; JUnusable; JUnusable; JInterface; JAbstract; JSynthetic; JAnnotation; JEnum] in
-        inner_ci, outer_ci, inner_name, flags
-      ) in
-      inner := classes;
-      None
-    | "Signature" ->
-      let s = get_string consts ch in
-      let formal, idx = parse_formal_type_params s in
-      types := formal;
-      let s = String.sub s idx (String.length s - idx) in
-      let len = String.length s in
-      let sup, idx = parse_signature_part s in
-      let rec loop idx acc =
-        if idx = len then
-          acc
-        else begin
-          let s = String.sub s idx (len - idx) in
-          let iface, i2 = parse_signature_part s in
-          loop (idx + i2) (iface :: acc)
-        end
-      in
-      interfaces := loop idx [];
-      super := sup;
-      None
-    | _ -> do_default()
-  ) consts ch attribs in
-  IO.close_in ch;
-  {
-    cversion = majorv, minorv;
-    cpath = this;
-    csuper = !super;
-    cflags = flags;
-    cinterfaces = !interfaces;
-    cfields = fields;
-    cmethods = methods;
-    cattributes = attribs;
-    cinner_types = !inner;
-    ctypes = !types;
-  }
-

libs/javalib/jWriter.ml

@@ -1,299 +0,0 @@
-(*
- *  This file is part of JavaLib
- *  Copyright (c)2004-2012 Nicolas Cannasse and Caue Waneck
- *
- *  This program is free software; you can redistribute it and/or modify
- *  it under the terms of the GNU General Public License as published by
- *  the Free Software Foundation; either version 2 of the License, or
- *  (at your option) any later version.
- *
- *  This program is distributed in the hope that it will be useful,
- *  but WITHOUT ANY WARRANTY; without even the implied warranty of
- *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- *  GNU General Public License for more details.
- *
- *  You should have received a copy of the GNU General Public License
- *  along with this program; if not, write to the Free Software
- *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
- *)
-open JData;;
-open IO.BigEndian;;
-open IO;;
-open ExtString;;
-open ExtList;;
-
-exception Writer_error_message of string
-
-type context = {
-  cpool : unit IO.output;
-  mutable ccount : int;
-  ch : string IO.output;
-  mutable constants : (jconstant,int) PMap.t;
-}
-
-let error msg = raise (Writer_error_message msg)
-
-let get_reference_type i =
-  match i with
-  | RGetField ->  1
-  | RGetStatic ->  2
-  | RPutField ->  3
-  | RPutStatic ->  4
-  | RInvokeVirtual ->  5
-  | RInvokeStatic ->  6
-  | RInvokeSpecial ->  7
-  | RNewInvokeSpecial ->  8
-  | RInvokeInterface ->  9
-
-let encode_path ctx (pack,name) =
-  String.concat "/" (pack @ [name])
-
-let rec encode_param ctx ch param =
-  match param with
-  | TAny -> write_byte ch (Char.code '*')
-  | TType(w, s) ->
-    (match w with
-    | WExtends -> write_byte ch (Char.code '+')
-    | WSuper -> write_byte ch (Char.code '-')
-    | WNone -> ());
-    encode_sig_part ctx ch s
-
-and encode_sig_part ctx ch jsig = match jsig with
-  | TByte -> write_byte ch (Char.code 'B')
-  | TChar -> write_byte ch (Char.code 'C')
-  | TDouble -> write_byte ch (Char.code 'D')
-  | TFloat -> write_byte ch (Char.code 'F')
-  | TInt -> write_byte ch (Char.code 'I')
-  | TLong -> write_byte ch (Char.code 'J')
-  | TShort -> write_byte ch (Char.code 'S')
-  | TBool -> write_byte ch (Char.code 'Z')
-  | TObject(path, params) ->
-    write_byte ch (Char.code 'L');
-    write_string ch (encode_path ctx path);
-    if params <> [] then begin
-      write_byte ch (Char.code '<');
-      List.iter (encode_param ctx ch) params;
-      write_byte ch (Char.code '>')
-    end;
-    write_byte ch (Char.code ';')
-  | TObjectInner(pack, inners) ->
-    write_byte ch (Char.code 'L');
-    List.iter (fun p ->
-      write_string ch p;
-      write_byte ch (Char.code '/')
-    ) pack;
-
-    let first = ref true in
-    List.iter (fun (name,params) ->
-      (if !first then first := false else write_byte ch (Char.code '.'));
-      write_string ch name;
-      if params <> [] then begin
-        write_byte ch (Char.code '<');
-        List.iter (encode_param ctx ch) params;
-        write_byte ch (Char.code '>')
-      end;
-    ) inners;
-    write_byte ch (Char.code ';')
-  | TArray(s,size) ->
-    write_byte ch (Char.code '[');
-    (match size with
-    | Some size ->
-      write_string ch (string_of_int size);
-    | None -> ());
-    encode_sig_part ctx ch s
-  | TMethod(args, ret) ->
-    write_byte ch (Char.code '(');
-    List.iter (encode_sig_part ctx ch) args;
-    (match ret with
-      | None -> write_byte ch (Char.code 'V')
-      | Some jsig -> encode_sig_part ctx ch jsig)
-  | TTypeParameter name ->
-    write_byte ch (Char.code 'T');
-    write_string ch name;
-    write_byte ch (Char.code ';')
-
-let encode_sig ctx jsig =
-  let buf = IO.output_string() in
-  encode_sig_part ctx buf jsig;
-  close_out buf
-
-let write_utf8 ch s =
-  String.iter (fun c ->
-    let c = Char.code c in
-    if c = 0 then begin
-      write_byte ch 0xC0;
-      write_byte ch 0x80
-    end else
-      write_byte ch c
-  ) s
-
-let rec const ctx c =
-  try
-    PMap.find c ctx.constants
-  with
-  | Not_found ->
-    let ret = ctx.ccount in
-    (match c with
-    (** references a class or an interface - jpath must be encoded as StringUtf8 *)
-    | ConstClass path -> (* tag = 7 *)
-        write_byte ctx.cpool 7;
-        write_ui16 ctx.cpool (const ctx (ConstUtf8 (encode_path ctx path)))
-    (** field reference *)
-    | ConstField (jpath, unqualified_name, jsignature) (* tag = 9 *) ->
-        write_byte ctx.cpool 9;
-        write_ui16 ctx.cpool (const ctx (ConstClass jpath));
-        write_ui16 ctx.cpool (const ctx (ConstNameAndType (unqualified_name, jsignature)))
-    (** method reference; string can be special "<init>" and "<clinit>" values *)
-    | ConstMethod (jpath, unqualified_name, jmethod_signature) (* tag = 10 *) ->
-        write_byte ctx.cpool 10;
-        write_ui16 ctx.cpool (const ctx (ConstClass jpath));
-        write_ui16 ctx.cpool (const ctx (ConstNameAndType (unqualified_name, TMethod jmethod_signature)))
-    (** interface method reference *)
-    | ConstInterfaceMethod (jpath, unqualified_name, jmethod_signature) (* tag = 11 *) ->
-        write_byte ctx.cpool 11;
-        write_ui16 ctx.cpool (const ctx (ConstClass jpath));
-        write_ui16 ctx.cpool (const ctx (ConstNameAndType (unqualified_name, TMethod jmethod_signature)))
-    (** constant values *)
-    | ConstString s  (* tag = 8 *) ->
-        write_byte ctx.cpool 8;
-        write_ui16 ctx.cpool (const ctx (ConstUtf8 s))
-    | ConstInt i (* tag = 3 *) ->
-        write_byte ctx.cpool 3;
-        write_real_i32 ctx.cpool i
-    | ConstFloat f (* tag = 4 *) ->
-        write_byte ctx.cpool 4;
-        (match classify_float f with
-        | FP_normal | FP_subnormal | FP_zero ->
-            write_real_i32 ctx.cpool (Int32.bits_of_float f)
-        | FP_infinite when f > 0.0 ->
-            write_real_i32 ctx.cpool 0x7f800000l
-        | FP_infinite ->
-            write_real_i32 ctx.cpool 0xff800000l
-        | FP_nan ->
-            write_real_i32 ctx.cpool 0x7f800001l)
-    | ConstLong i (* tag = 5 *) ->
-        write_byte ctx.cpool 5;
-        write_i64 ctx.cpool i;
-    | ConstDouble d (* tag = 6 *) ->
-        write_byte ctx.cpool 6;
-        write_double ctx.cpool d;
-        ctx.ccount <- ctx.ccount + 1
-    (** name and type: used to represent a field or method, without indicating which class it belongs to *)
-    | ConstNameAndType (unqualified_name, jsignature) ->
-        write_byte ctx.cpool 12;
-        write_ui16 ctx.cpool (const ctx (ConstUtf8 (unqualified_name)));
-        write_ui16 ctx.cpool (const ctx (ConstUtf8 (encode_sig ctx jsignature)))
-    (** UTF8 encoded strings. Note that when reading/writing, take into account Utf8 modifications of java *)
-    (* (http://docs.oracle.com/javase/specs/jvms/se7/html/jvms-4.html#jvms-4.4.7) *)
-    | ConstUtf8 s ->
-        write_byte ctx.cpool 1;
-        write_ui16 ctx.cpool (String.length s);
-        write_utf8 ctx.cpool s
-    (** invokeDynamic-specific *)
-    | ConstMethodHandle (reference_type, jconstant) (* tag = 15 *) ->
-        write_byte ctx.cpool 15;
-        write_byte ctx.cpool (get_reference_type reference_type);
-        write_ui16 ctx.cpool (const ctx jconstant)
-    | ConstMethodType jmethod_signature (* tag = 16 *) ->
-        write_byte ctx.cpool 16;
-        write_ui16 ctx.cpool (const ctx (ConstUtf8 (encode_sig ctx (TMethod jmethod_signature))))
-    | ConstDynamic (bootstrap_method, unqualified_name, jsignature) (* tag = 17 *) ->
-        write_byte ctx.cpool 17;
-        write_ui16 ctx.cpool bootstrap_method;
-        write_ui16 ctx.cpool (const ctx (ConstNameAndType(unqualified_name, jsignature)))
-    | ConstInvokeDynamic (bootstrap_method, unqualified_name, jsignature) (* tag = 18 *) ->
-        write_byte ctx.cpool 18;
-        write_ui16 ctx.cpool bootstrap_method;
-        write_ui16 ctx.cpool (const ctx (ConstNameAndType(unqualified_name, jsignature)))
-    | ConstModule unqualified_name (* tag = 19 *) ->
-        write_byte ctx.cpool 19;
-        write_ui16 ctx.cpool (const ctx (ConstUtf8 (unqualified_name)));
-    | ConstPackage unqualified_name (* tag = 20 *) ->
-        write_byte ctx.cpool 20;
-        write_ui16 ctx.cpool (const ctx (ConstUtf8 (unqualified_name)));
-    | ConstUnusable -> assert false);
-    ctx.ccount <- ret + 1;
-    ret
-
-let write_const ctx ch cconst =
-  write_ui16 ch (const ctx cconst)
-;;
-
-let write_formal_type_params ctx ch tparams =
-  write_byte ch (Char.code '<');
-  List.iter (fun (name,ext,impl) ->
-    write_string ch name;
-    (match ext with
-    | None -> ()
-    | Some jsig ->
-      write_byte ch (Char.code ':');
-      write_string ch (encode_sig ctx jsig));
-    List.iter (fun jsig ->
-      write_byte ch (Char.code ':');
-      write_string ch (encode_sig ctx jsig)
-    ) impl
-  ) tparams;
-  write_byte ch (Char.code '>');
-;;
-
-let write_complete_method_signature ctx ch (tparams : jtypes) msig throws =
-  if tparams <> [] then write_formal_type_params ctx ch tparams;
-  write_string ch (encode_sig ctx (TMethod(msig)));
-  if throws <> [] then List.iter (fun jsig ->
-    write_byte ch (Char.code '^');
-    write_string ch (encode_sig ctx jsig)
-  ) throws
-;;
-
-let write_access_flags ctx ch all_flags flags =
-  let value = List.fold_left (fun acc flag ->
-    try
-      acc lor (Hashtbl.find all_flags flag)
-    with Not_found ->
-      error ("Not found flag: " ^ (string_of_int (Obj.magic flag)))
-  ) 0 flags in
-  write_ui16 ch value
-;;
-
-let rec write_ann_element ctx ch (name,eval) =
-  write_const ctx ch (ConstUtf8 name);
-  write_element_value ctx ch eval
-
-and write_annotation ctx ch ann =
-  write_const ctx ch (ConstUtf8 (encode_sig ctx ann.ann_type));
-  write_ui16 ch (List.length ann.ann_elements);
-  List.iter (write_ann_element ctx ch) ann.ann_elements
-
-and write_element_value ctx ch value = match value with
-  | ValConst(jsig, cconst) -> (match jsig with
-    | TObject((["java";"lang"],"String"), []) ->
-      write_byte ch (Char.code 's')
-    | TByte | TChar | TDouble | TFloat | TInt | TLong | TShort | TBool ->
-      write_string ch (encode_sig ctx jsig)
-    | _ ->
-      let s = encode_sig ctx jsig in
-      error ("Invalid signature " ^ s ^ " for constant value"));
-    write_ui16 ch (const ctx cconst)
-  | ValEnum(jsig,name) ->
-    write_byte ch (Char.code 'e');
-    write_const ctx ch (ConstUtf8 (encode_sig ctx jsig));
-    write_const ctx ch (ConstUtf8 name)
-  | ValClass(jsig) ->
-    write_byte ch (Char.code 'c');
-    let esig = match jsig with
-      | TObject(([],"Void"),[])
-      | TObject((["java";"lang"],"Void"),[]) ->
-        "V"
-      | _ ->
-        encode_sig ctx jsig
-    in
-    write_const ctx ch (ConstUtf8 (esig))
-  | ValAnnotation ann ->
-    write_byte ch (Char.code '@');
-    write_annotation ctx ch ann
-  | ValArray(lvals) ->
-    write_byte ch (Char.code '[');
-    write_ui16 ch (List.length lvals);
-    List.iter (write_element_value ctx ch) lvals
-;;
-