From: Richard W.M. Jones Date: Mon, 16 Jun 2008 21:37:16 +0000 (+0000) Subject: Change cil tools to use computed offsets. X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=03f7ce1afc9620e4b5f48817b5074a73b0c48048;p=ocaml-bitstring.git Change cil tools to use computed offsets. --- diff --git a/cil-tools/.depend b/cil-tools/.depend index 20be473..4fa223b 100644 --- a/cil-tools/.depend +++ b/cil-tools/.depend @@ -1,2 +1,2 @@ -bitmatch_import_c.cmo: ../bitmatch.cmi -bitmatch_import_c.cmx: ../bitmatch.cmx +bitmatch_import_c.cmo: ../bitmatch_persistent.cmi ../bitmatch.cmi +bitmatch_import_c.cmx: ../bitmatch_persistent.cmx ../bitmatch.cmx diff --git a/cil-tools/Makefile.in b/cil-tools/Makefile.in index a72952b..c50e05c 100644 --- a/cil-tools/Makefile.in +++ b/cil-tools/Makefile.in @@ -26,11 +26,11 @@ OCAMLDOC = @OCAMLDOC@ INSTALL = @INSTALL@ OCAMLCFLAGS = -g -OCAMLCPACKAGES = -package unix,str,extlib,cil -I .. -OCAMLCLIBS = $(OCAMLCPACKAGES) -linkpkg ../bitmatch.cma ../bitmatch_persistent.cma +OCAMLCPACKAGES = -package unix,str,extlib,cil -I +camlp4 -I .. +OCAMLCLIBS = $(OCAMLCPACKAGES) camlp4lib.cma -linkpkg ../bitmatch.cma ../bitmatch_persistent.cma OCAMLOPTFLAGS = OCAMLOPTPACKAGES = $(OCAMLCPACKAGES) -OCAMLOPTLIBS = $(OCAMLOPTPACKAGES) -linkpkg ../bitmatch.cmxa ../bitmatch_persistent.cmxa +OCAMLOPTLIBS = $(OCAMLOPTPACKAGES) camlp4lib.cmxa -linkpkg ../bitmatch.cmxa ../bitmatch_persistent.cmxa OCAMLDOCFLAGS = -html -sort @@ -53,13 +53,13 @@ LINUX_INCLUDES = -I $(LINUX_HEADERS) examples: ext3.ml task_struct.ml -ext3.ml: ext3.c bitmatch-import-c +ext3.bmpp: ext3.c bitmatch-import-c cd $(LINUX_HEADERS) && ln -sf asm-x86 asm rm -f $@.new ./bitmatch-import-c $(DEBUG) $(LINUX_INCLUDES) $< > $@.new mv $@.new $@ -task_struct.ml: task_struct.c bitmatch-import-c +task_struct.bmpp: task_struct.c bitmatch-import-c cd $(LINUX_HEADERS) && ln -sf asm-x86 asm rm -f $@.new ./bitmatch-import-c $(DEBUG) $(LINUX_INCLUDES) $< > $@.new diff --git a/cil-tools/bitmatch_import_c.ml b/cil-tools/bitmatch_import_c.ml index c61f751..8195f98 100644 --- a/cil-tools/bitmatch_import_c.ml +++ b/cil-tools/bitmatch_import_c.ml @@ -24,6 +24,8 @@ open ExtString open Cil +module P = Bitmatch_persistent + let () = (* Parse command line arguments. *) let debug = ref false in @@ -161,11 +163,15 @@ OPTIONS" in ) structs; ); - (* Output constants. *) +(* + (* Output constants. + * XXX Disabled at the moment until we work out where to put them XXX + *) List.iter ( fun (vname, vinit, loc) -> printf "let %s = 0x%LX\n" vname vinit ) constants; +*) (* Output structures. *) List.iter ( @@ -176,44 +182,28 @@ OPTIONS" in *) (*Errormsg.log "%a: %s %a\n" d_loc loc tname d_plaintype ttype;*) - (* Match on the type of this structure, and from it generate - * a single parsing function. - *) - match ttype with - (* struct or union *) - | TComp ({ cdefined = true; cname = cname }, _) -> - printf "let %s_of_bitstring bits =\n" tname; - printf " bitmatch bits with\n"; - printf " | {\n"; - (*output_struct [] NoOffset None ttype;*) - printf " } ->\n"; - printf " Some (...)\n"; - printf " | { _ } -> None\n\n" - - (* An undefined struct or union -- means one which was only ever - * defined with 'struct foo;'. This is an error. + (* Recursive function to generate a persistent pattern from a + * C struct or union. Quite a few limitations at the moment: + * (1) Structure elements must be in order. + * (2) Doesn't really work with unions [XXX]. + * + * Parameters: + * ?names List of names of parent structs. Used in the + * recursive case for nested structs. + * ?offset Offset of struct within parent, usually NoOffset. Used + * in the recursive case for nested structs. + * ?endian Inherited endianness, usually None. Used for C + * __attribute__((bitwise)). + * ttype CIL type of struct. + * Returns: + * pattern A bitmatch persistent pattern. *) - | TComp ({ cdefined = false; cname = cname }, _) -> - Errormsg.error - "%a: struct or union has no definition: %s" d_loc loc cname - - (* Types which are not allowed, eg. void, int, arrays. *) - | TVoid _ | TInt _ | TFloat _ | TPtr _ | TArray _ | TFun _ - | TNamed _ | TBuiltin_va_list _ -> - Errormsg.error - "%a: not a struct or union: %a" d_loc loc d_type ttype - - (* Types which we might implement in the future. - * For enum we should probably split out enums separately - * from structs above, since enums are more like constants. - *) - | TEnum ({ ename = ename }, _) -> - Errormsg.unimp "%a: %a" d_loc loc d_type ttype -(* - let rec to_fields names offset endian = function - (* Some types contain attributes to indicate their - * endianness. See many examples from . - *) + let rec pattern_of_struct ?(names=[]) ?(offset=NoOffset) ?(endian=None) + ttype = + match ttype with + (* Some types contain attributes to indicate their + * endianness. See many examples from . + *) | (TNamed ({ tname = tname; ttype = TNamed (_, attrs) }, _) as t) @@ -228,11 +218,11 @@ OPTIONS" in d_loc loc tname; endian ) in - to_fields names offset endian (unrollType t) + pattern_of_struct ~names ~offset ~endian (unrollType t) (* See into named types. *) | (TNamed _ as t) -> - to_fields names offset endian (unrollType t) + pattern_of_struct ~names ~offset ~endian (unrollType t) (* struct or union *) | TComp ({ cdefined = true; cfields = cfields }, _) -> @@ -241,13 +231,12 @@ OPTIONS" in fun ({ fname = fname; ftype = ftype } as finfo) -> let offset = Field (finfo, offset) in let names = fname :: names in - to_fields names offset endian ftype + pattern_of_struct ~names ~offset ~endian ftype ) cfields in List.flatten cfields (* int array with constant length *) - | TArray (basetype, (Some _ as len), _) - when isIntegralType basetype -> + | TArray (basetype, (Some _ as len), _) when isIntegralType basetype -> let len = lenOfArray len in let bitsoffset, totalwidth = bitsOffset ttype offset in let bitswidth = totalwidth / len (* of the element *) in @@ -264,13 +253,15 @@ OPTIONS" in Errormsg.unimp "%a: unhandled type: %a" d_loc loc d_type t; IInt in let field = - to_int_field "" bitsoffset bitswidth ikind endian in + pattern_field_of_int "" bitsoffset bitswidth ikind endian in let fname = String.concat "_" (List.rev names) in let byteoffset = bitsoffset lsr 3 in let bytetotalwidth = totalwidth lsr 3 in +(* printf "--> array %s: byteoffset=%d bytetotalwidth=%d len=%d\n" fname byteoffset bytetotalwidth len (* field *); - [] +*) + [] (* XXX *) (* basic integer type *) | TInt (ikind, _) -> @@ -281,7 +272,7 @@ OPTIONS" in );*) let fname = String.concat "_" (List.rev names) in let field = - to_int_field fname bitsoffset bitswidth ikind endian in + pattern_field_of_int fname bitsoffset bitswidth ikind endian in [field] (* a pointer - in this mapping we assume this is an address @@ -292,49 +283,75 @@ OPTIONS" in | TPtr _ -> let bitsoffset, bitswidth = bitsOffset ttype offset in let fname = String.concat "_" (List.rev names) in +(* printf "--> pointer %s: bitsoffset=%d bitswidth=%d\n" fname bitsoffset bitswidth; - [] +*) + [] (* XXX *) | t -> Errormsg.unimp "to_fields: %a: unhandled type: %a" d_loc loc d_type t; [] - and to_int_field fname bitsoffset bitswidth ikind endian = - let byteoffset = bitsoffset lsr 3 in - let bytewidth = bitswidth lsr 3 in + (* Convert a single int field into a pattern field. + * Could be a bitfield, byte, short, etc. + *) + and pattern_field_of_int fname bitsoffset bitswidth ikind endian = let signed = isSigned ikind in - - if bitsoffset land 7 = 0 && bitswidth land 7 = 0 then ( - (* Not a bitfield. *) - match bitswidth with - | 8 -> - printf "--> byte %s: byteoffset=%d bytewidth=%d signed=%b\n" - fname byteoffset bytewidth signed - | 16 -> - printf "--> short %s: byteoffset=%d bytewidth=%d signed=%b endian=%s\n" - fname byteoffset bytewidth signed (Option.map_default Bitmatch.string_of_endian "None" endian) - | 32 -> - printf "--> int %s: byteoffset=%d bytewidth=%d signed=%b endian=%s\n" - fname byteoffset bytewidth signed (Option.map_default Bitmatch.string_of_endian "None" endian) - | 64 -> - printf "--> long %s: byteoffset=%d bytewidth=%d signed=%b endian=%s\n" - fname byteoffset bytewidth signed (Option.map_default Bitmatch.string_of_endian "None" endian) - | _ -> - Errormsg.unimp "%s: unhandled integer width: %d bits" - fname bitswidth - ) else ( - (* It's a bitfield if either the offset or width isn't - * byte-aligned. - *) - let bitsoffset = bitsoffset land 7 in - printf "--> bitfield %s: byteoffset=%d bytewidth=%d signed=%b endian=%s bitsoffset=%d bitswidth=%d\n" - fname byteoffset bytewidth - signed (Option.map_default Bitmatch.string_of_endian "None" endian) bitsoffset bitswidth - ) + let _loc = camlp4_loc_of_cil_loc loc in + + let field = P.create_pattern_field _loc in + let field = P.set_lident_patt field fname in + let field = P.set_type_int field in + let field = P.set_length_int field bitswidth in + let field = P.set_offset_int field bitsoffset in + let field = P.set_signed field signed in + let field = + match endian with + | Some endian -> P.set_endian field endian + | None -> P.set_endian field Bitmatch.NativeEndian in + + field + + (* Convert a CIL location into a camlp4 location. Grrr these + * should be compatible! + *) + and camlp4_loc_of_cil_loc loc = + let _loc = Camlp4.PreCast.Syntax.Ast.Loc.mk loc.file in + Camlp4.PreCast.Syntax.Ast.Loc.move_line loc.line _loc in -*) + + (* Match on the type of this structure, and from it generate + * a single parsing function. + *) + match ttype with + (* struct or union *) + | TComp ({ cdefined = true; cname = cname }, _) -> + let pattern = pattern_of_struct ttype in + let named_pattern = cname, P.Pattern pattern in + P.named_to_channel stdout named_pattern + + (* An undefined struct or union -- means one which was only ever + * defined with 'struct foo;'. This is an error. + *) + | TComp ({ cdefined = false; cname = cname }, _) -> + Errormsg.error + "%a: struct or union has no definition: %s" d_loc loc cname + + (* Types which are not allowed, eg. void, int, arrays. *) + | TVoid _ | TInt _ | TFloat _ | TPtr _ | TArray _ | TFun _ + | TNamed _ | TBuiltin_va_list _ -> + Errormsg.error + "%a: not a struct or union: %a" d_loc loc d_type ttype + + (* Types which we might implement in the future. + * For enum we should probably split out enums separately + * from structs above, since enums are more like constants. + *) + | TEnum ({ ename = ename }, _) -> + Errormsg.unimp "%a: %a" d_loc loc d_type ttype + ) structs; if !Errormsg.hadErrors then exit 1; diff --git a/cil-tools/ext3.c b/cil-tools/ext3.c index 89ca20d..1e1a82d 100644 --- a/cil-tools/ext3.c +++ b/cil-tools/ext3.c @@ -17,8 +17,10 @@ * interested in. */ #include -#include +//#include +#include /* This tells the importer program what structures and constants to import. */ -typedef struct ext3_super_block BITMATCH_IMPORT(ext3_super_block); +//typedef struct ext3_super_block BITMATCH_IMPORT(ext3_super_block); +typedef struct ext2_super_block BITMATCH_IMPORT(ext2_super_block); BITMATCH_CONSTANT_INT32 (ext3_super_magic, EXT3_SUPER_MAGIC);