diff --git a/cfrontend/Cil2Csyntax.ml b/cfrontend/Cil2Csyntax.ml
deleted file mode 100644
index 822f6cb045e41b5bc7e07d5a944b64ab5daa8787..0000000000000000000000000000000000000000
--- a/cfrontend/Cil2Csyntax.ml
+++ /dev/null
@@ -1,1283 +0,0 @@
-(* *********************************************************************)
-(* *)
-(* The Compcert verified compiler *)
-(* *)
-(* Thomas Moniot, INRIA Paris-Rocquencourt *)
-(* Xavier Leroy, INRIA Paris-Rocquencourt *)
-(* *)
-(* Copyright Institut National de Recherche en Informatique et en *)
-(* Automatique. All rights reserved. This file is distributed *)
-(* 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 file is also distributed *)
-(* under the terms of the INRIA Non-Commercial License Agreement. *)
-(* *)
-(* *********************************************************************)
-
-(**************************************************************************
-CIL -> CabsCoq translator
-**************************************************************************)
-
-open Cil
-open Camlcoq
-open AST
-open Csyntax
-
-(* To associate CIL varinfo to the atoms representing global variables *)
-
-let varinfo_atom : (AST.ident, Cil.varinfo) Hashtbl.t =
- Hashtbl.create 103
-
-(** Functions used to handle locations *)
-
-let currentLocation = ref Cil.locUnknown
-
-(** Update the current location *)
-let updateLoc loc =
- currentLocation := loc
-
-(** Convert the current location into a string *)
-let currentLoc() =
- match !currentLocation with { line=l; file=f } ->
- f ^ ":" ^ (if l = -1 then "?" else string_of_int l) ^ ": "
-
-(** Exception raised when an error in the C source is encountered,
- e.g. unsupported C feature *)
-
-exception Error of string
-
-let error msg =
- raise (Error(currentLoc() ^ msg))
-
-let unsupported msg =
- error ("Unsupported C feature: " ^ msg)
-
-let internal_error msg =
- error ("Internal error: " ^ msg ^ "\nPlease report it.")
-
-(** Warning messages *)
-let warning msg =
- prerr_string (currentLoc());
- prerr_string "Warning: ";
- prerr_endline msg
-
-(** Evaluate compile-time constant expressions. This is a more
- aggressive variant of [Cil.constFold], which does not handle
- floats. *)
-
-exception NotConst
-
-let mkint64 k v =
- match Cil.kinteger64 k v with Const cst -> cst | _ -> assert false
-let mkint k v =
- mkint64 k (Int64.of_int v)
-let mkfloat k v =
- let v' =
- match k with
- | FFloat -> Int32.float_of_bits (Int32.bits_of_float v)
- | _ -> v in
- CReal(v', k, None)
-
-let bool_val = function
- | CInt64(v, _, _) -> v <> 0L
- | CReal(v, _, _) -> v <> 0.0
- | CStr s -> true
- | CWStr s -> true
- | _ -> assert false (* CChr, CEnum already expanded *)
-
-let rec eval_expr = function
- | Const cst ->
- eval_const cst
- | SizeOf ty ->
- (try mkint IUInt (bitsSizeOf ty / 8)
- with SizeOfError _ -> raise NotConst)
- | SizeOfE e ->
- eval_expr (SizeOf (typeOf e))
- | SizeOfStr s ->
- mkint IUInt (1 + String.length s)
- | AlignOf ty ->
- (try mkint IUInt (alignOf_int ty)
- with SizeOfError _ -> raise NotConst)
- | AlignOfE e ->
- eval_expr (AlignOf (typeOf e))
- | UnOp(op, e, ty) ->
- eval_unop op (eval_expr e) ty
- | BinOp(op, e1, e2, ty) ->
- eval_binop op (eval_expr e1) (eval_expr e2) ty
- | CastE(ty, e) ->
- eval_cast ty (eval_expr e)
- | Lval lv -> raise NotConst
- | AddrOf lv -> raise NotConst
- | StartOf lv -> raise NotConst
-
-and eval_const = function
- | CChr c -> charConstToInt c
- | CEnum(e, _, _) -> eval_expr e
- | cst -> cst
-
-and eval_unop op v ty =
- match op, Cil.unrollType ty, v with
- | Neg, TInt(ik, _), CInt64(v, _, _) -> mkint64 ik (Int64.neg v)
- | Neg, TFloat(fk, _), CReal(v, _, _) -> mkfloat fk (-. v)
- | BNot, TInt(ik, _), CInt64(v, _, _) -> mkint64 ik (Int64.logxor v (-1L))
- | LNot, TInt(ik, _), _ -> mkint ik (if bool_val v then 0 else 1)
- | _, _, _ -> raise NotConst
-
-and eval_binop op v1 v2 ty =
- match op, Cil.unrollType ty, v1, v2 with
- | PlusA, TInt(ik, _), CInt64(v1, _, _), CInt64(v2, _, _) ->
- mkint64 ik (Int64.add v1 v2)
- | PlusA, TFloat(fk, _), CReal(v1, _, _), CReal(v2, _, _) ->
- mkfloat fk (v1 +. v2)
- | MinusA, TInt(ik, _), CInt64(v1, _, _), CInt64(v2, _, _) ->
- mkint64 ik (Int64.sub v1 v2)
- | MinusA, TFloat(fk, _), CReal(v1, _, _), CReal(v2, _, _) ->
- mkfloat fk (v1 -. v2)
- | Mult, TInt(ik, _), CInt64(v1, _, _), CInt64(v2, _, _) ->
- mkint64 ik (Int64.mul v1 v2)
- | Mult, TFloat(fk, _), CReal(v1, _, _), CReal(v2, _, _) ->
- mkfloat fk (v1 *. v2)
- | Div, TInt(ik, _), CInt64(v1, _, _), CInt64(v2, _, _)
- when ik <> IULongLong && v2 != 0L ->
- mkint64 ik (Int64.div v1 v2)
- | Div, TFloat(fk, _), CReal(v1, _, _), CReal(v2, _, _) ->
- mkfloat fk (v1 /. v2)
- | Mod, TInt(ik, _), CInt64(v1, _, _), CInt64(v2, _, _)
- when ik <> IULongLong && v2 != 0L ->
- mkint64 ik (Int64.rem v1 v2)
- | Shiftlt, TInt(ik, _), CInt64(v1, _, _), CInt64(v2, _, _)
- when v2 >= 0L && v2 < 64L ->
- mkint64 ik (Int64.shift_left v1 (Int64.to_int v2))
- | Shiftrt, TInt(ik, _), CInt64(v1, _, _), CInt64(v2, _, _)
- when v2 >= 0L && v2 < 64L ->
- mkint64 ik (if isSigned ik
- then Int64.shift_right v1 (Int64.to_int v2)
- else Int64.shift_right_logical v1 (Int64.to_int v2))
- | Lt, _, _, _ -> eval_comparison (<) v1 v2
- | Gt, _, _, _ -> eval_comparison (>) v1 v2
- | Le, _, _, _ -> eval_comparison (<=) v1 v2
- | Ge, _, _, _ -> eval_comparison (>=) v1 v2
- | Eq, _, _, _ -> eval_comparison (=) v1 v2
- | Ne, _, _, _ -> eval_comparison (<>) v1 v2
- | BAnd, TInt(ik, _), CInt64(v1, _, _), CInt64(v2, _, _) ->
- mkint64 ik (Int64.logand v1 v2)
- | BXor, TInt(ik, _), CInt64(v1, _, _), CInt64(v2, _, _) ->
- mkint64 ik (Int64.logxor v1 v2)
- | BOr, TInt(ik, _), CInt64(v1, _, _), CInt64(v2, _, _) ->
- mkint64 ik (Int64.logor v1 v2)
- | LAnd, TInt(ik, _), _, _ ->
- mkint ik (if bool_val v1 && bool_val v2 then 1 else 0)
- | LOr, TInt(ik, _), _, _ ->
- mkint ik (if bool_val v1 || bool_val v2 then 1 else 0)
- | _, _, _, _ ->
- raise NotConst
-
-and eval_comparison op v1 v2 =
- let cmp =
- match v1, v2 with
- | CInt64(v1, ik1, _), CInt64(v2, ik2, _) ->
- let shift v = Int64.sub v 0x8000_0000_0000_0000L in
- if ik1 = IULongLong || ik2 = IULongLong
- then compare (shift v1) (shift v2)
- else compare v1 v2
- | CReal(v1, _, _), CReal(v2, _, _) ->
- compare v1 v2
- | _, _ ->
- raise NotConst
- in mkint IInt (if op cmp 0 then 1 else 0)
-
-and eval_cast ty v =
- match Cil.unrollType ty, v with
- | TInt(ik, _), CInt64(v, _, _) -> mkint64 ik v
- | TInt(ik, _), CReal(v, _, _) ->
- if ik = IULongLong then raise NotConst else mkint64 ik (Int64.of_float v)
- | TEnum _, CInt64(v, _, _) -> mkint64 IInt v
- | TEnum _, CReal(v, _, _) -> mkint64 IInt (Int64.of_float v)
- | TFloat(fk, _), CReal(v, _, _) -> mkfloat fk v
- | TFloat(fk, _), CInt64(v, ik, _) ->
- if ik = IULongLong then raise NotConst else mkfloat fk (Int64.to_float v)
- | TPtr(_, _), CInt64(_, _, _) -> v (* tolerance? *)
- | TPtr(_, _), CStr s -> v (* tolerance? *)
- | TPtr(_, _), CWStr s -> v (* tolerance? *)
- | _, _ -> raise NotConst
-
-(** Hooks -- overriden in machine-dependent CPragmas module *)
-
-let process_pragma_hook = ref (fun (a: Cil.attribute) -> false)
-let define_variable_hook = ref (fun (id: ident) (v: Cil.varinfo) -> ())
-let define_function_hook = ref (fun (id: ident) (v: Cil.varinfo) -> ())
-let define_stringlit_hook = ref (fun (id: ident) (v: Cil.varinfo) -> ())
-
-(** The parameter to the translation functor: it specifies the
- translation for integer and float types. *)
-
-module type TypeSpecifierTranslator =
- sig
- val convertIkind: Cil.ikind -> (intsize * signedness) option
- val convertFkind: Cil.fkind -> floatsize option
- end
-
-module Make(TS: TypeSpecifierTranslator) = struct
-(*-----------------------------------------------------------------------*)
-
-
-(** Pre-defined constants *)
-let constInt32 = Tint (I32, Signed)
-let constInt32uns = Tint (I32, Unsigned)
-let const0 = Expr (Econst_int (coqint_of_camlint Int32.zero), constInt32)
-
-
-(** Global variables *)
-let stringNum = ref 0 (* number of next global for string literals *)
-let stringTable = Hashtbl.create 47
-
-(** ** Functions related to [struct]s and [union]s *)
-
-(* Unroll recursion in struct or union types:
- substitute [Tcomp_ptr id] by [Tpointer compty] in [ty]. *)
-
-let unrollType id compty ty =
- let rec unrType ty =
- match ty with
- | Tvoid -> ty
- | Tint(sz, sg) -> ty
- | Tfloat sz -> ty
- | Tpointer ty -> Tpointer (unrType ty)
- | Tarray(ty, sz) -> Tarray (unrType ty, sz)
- | Tfunction(args, res) -> Tfunction(unrTypelist args, unrType res)
- | Tstruct(id', fld) ->
- if id' = id then ty else Tstruct(id', unrFieldlist fld)
- | Tunion(id', fld) ->
- if id' = id then ty else Tunion(id', unrFieldlist fld)
- | Tcomp_ptr id' ->
- if id' = id then Tpointer compty else ty
- and unrTypelist = function
- | Tnil -> Tnil
- | Tcons(hd, tl) -> Tcons(unrType hd, unrTypelist tl)
- and unrFieldlist = function
- | Fnil -> Fnil
- | Fcons(id, ty, tl) -> Fcons(id, unrType ty, unrFieldlist tl)
- in unrType ty
-
-(* Return the type of a [struct] field *)
-let rec getFieldType f = function
- | Fnil -> raise Not_found
- | Fcons(idf, t, rem) -> if idf = f then t else getFieldType f rem
-
-(** ** Some functions over lists *)
-
-(** Keep the elements in a list from [elt] (included) to the end
- (used for the translation of the [switch] statement) *)
-let rec keepFrom elt = function
- | [] -> []
- | (x :: l) as l' -> if x == elt then l' else keepFrom elt l
-
-(** Keep the elements in a list before [elt'] (excluded)
- (used for the translation of the [switch] statement) *)
-let rec keepUntil elt' = function
- | [] -> []
- | x :: l -> if x == elt' then [] else x :: (keepUntil elt' l)
-
-(** Keep the elements in a list from [elt] (included) to [elt'] (excluded)
- (used for the translation of the [switch] statement) *)
-let keepBetween elt elt' l =
- keepUntil elt' (keepFrom elt l)
-
-(** ** Functions used to handle string literals *)
-
-let name_for_string_literal s =
- try
- Hashtbl.find stringTable s
- with Not_found ->
- incr stringNum;
- let name = Printf.sprintf "__stringlit_%d" !stringNum in
- let id = intern_string name in
- let v =
- makeVarinfo true s (typeAddAttributes [Attr("const",[])] charPtrType) in
- v.vstorage <- Static;
- v.vreferenced <- true;
- Hashtbl.add varinfo_atom id v;
- !define_stringlit_hook id v;
- Hashtbl.add stringTable s id;
- id
-
-let typeStringLiteral s =
- Tarray(Tint(I8, Unsigned), z_of_camlint(Int32.of_int(String.length s + 1)))
-
-let global_for_string s id =
- let init = ref [] in
- let add_char c =
- init :=
- AST.Init_int8(coqint_of_camlint(Int32.of_int(Char.code c)))
- :: !init in
- add_char '\000';
- for i = String.length s - 1 downto 0 do add_char s.[i] done;
- Datatypes.Coq_pair(Datatypes.Coq_pair(id, !init), typeStringLiteral s)
-
-let globals_for_strings globs =
- Hashtbl.fold
- (fun s id l -> global_for_string s id :: l)
- stringTable globs
-
-(** ** Handling of stubs for variadic functions *)
-
-let stub_function_table = Hashtbl.create 47
-
-let register_stub_function name tres targs =
- let rec letters_of_type = function
- | Tnil -> []
- | Tcons(Tfloat _, tl) -> "f" :: letters_of_type tl
- | Tcons(_, tl) -> "i" :: letters_of_type tl in
- let stub_name =
- name ^ "$" ^ String.concat "" (letters_of_type targs) in
- try
- (stub_name, Hashtbl.find stub_function_table stub_name)
- with Not_found ->
- let rec types_of_types = function
- | Tnil -> Tnil
- | Tcons(Tfloat _, tl) -> Tcons(Tfloat F64, types_of_types tl)
- | Tcons(_, tl) -> Tcons(Tpointer Tvoid, types_of_types tl) in
- let stub_type = Tfunction (types_of_types targs, tres) in
- Hashtbl.add stub_function_table stub_name stub_type;
- (stub_name, stub_type)
-
-let declare_stub_function stub_name stub_type =
- match stub_type with
- | Tfunction(targs, tres) ->
- Datatypes.Coq_pair(intern_string stub_name,
- External(intern_string stub_name, targs, tres))
- | _ -> assert false
-
-let declare_stub_functions k =
- Hashtbl.fold (fun n i k -> declare_stub_function n i :: k)
- stub_function_table k
-
-(** ** Generation of temporary variable names *)
-
-let current_function = ref (None: Cil.fundec option)
-
-let make_temp typ =
- match !current_function with
- | None -> assert false
- | Some f ->
- let v = Cil.makeTempVar f typ in
- intern_string v.vname
-
-let rec constant_address e =
- match e with
- | Expr(Evar v, _) -> true
- | Expr(Efield(e, id), _) -> constant_address e
- | _ -> false
-
-let cache_address ty e (f: expr -> statement) =
- if constant_address e then
- f e
- else begin
- let t = make_temp (TPtr(ty, [])) in
- let ty = typeof e in
- let typ = Tpointer ty in
- Ssequence(Sassign(Expr(Evar t, typ), Expr(Eaddrof e, typ)),
- f (Expr(Ederef(Expr(Evar t, typ)), ty)))
- end
-
-let current_function_return_type() =
- match !current_function with
- | None -> assert false
- | Some f ->
- match f.svar.vtype with
- | TFun(ty_ret, ty_args, _, _) -> ty_ret
- | _ -> assert false
-
-(** Detect and report GCC's __builtin_ functions *)
-
-let check_builtin s =
- let b = "__builtin_" in
- if String.length s >= String.length b
- && String.sub s 0 (String.length b) = b
- then unsupported ("GCC `" ^ s ^ "' built-in function")
-
-(** ** Helpers for struct assignment *)
-
-let eintconst n =
- Expr(Econst_int n, Tint(I32, Signed))
-let eindex e1 e2 ty =
- Expr(Ederef(Expr (Ebinop(Oadd, e1, e2), typeof e1)), ty)
-let eaddrof e =
- Expr(Eaddrof e, Tpointer(typeof e))
-
-let memcpy_ident = intern_string "memcpy"
-let memcpy_arg_type =
- Tcons(Tpointer Tvoid, Tcons(Tpointer Tvoid, Tcons(Tint(I32, Unsigned), Tnil)))
-let memcpy_res_type = Tpointer Tvoid
-let memcpy_type = Tfunction(memcpy_arg_type, memcpy_res_type)
-let memcpy_used = ref false
-
-exception Use_memcpy
-
-let max_assignment_num = 8
-
-let compile_assignment ty lhs rhs =
-
- let num_assign = ref 0 in
-
- let rec comp_assign l r =
- match typeof l with
- | Tstruct(id, flds) ->
- let rec comp_field = function
- | Fnil -> Sskip
- | Fcons(id, ty, rem) ->
- let ty = unrollType id (Tstruct(id, flds)) ty in
- Ssequence(comp_assign (Expr (Efield(l, id), ty))
- (Expr (Efield(r, id), ty)),
- comp_field rem)
- in comp_field flds
- | Tunion(id, flds) -> raise Use_memcpy
- | Tarray(ty, sz) ->
- let sz = camlint_of_coqint sz in
- let rec comp_element i =
- if i >= sz then Sskip else begin
- let idx = eintconst (coqint_of_camlint i) in
- Ssequence(comp_assign (eindex l idx ty) (eindex r idx ty),
- comp_element (Int32.succ i))
- end
- in comp_element 0l
- | _ ->
- if !num_assign >= max_assignment_num then raise Use_memcpy;
- incr num_assign;
- Sassign(l, r)
- in
- try
- cache_address ty lhs (fun lhs' ->
- cache_address ty rhs (fun rhs' ->
- comp_assign lhs' rhs'))
- with Use_memcpy ->
- memcpy_used := true;
- Scall(None, Expr(Evar memcpy_ident, memcpy_type),
- [eaddrof lhs; eaddrof rhs; eintconst (sizeof (typeof lhs))])
-
-let declare_memcpy fundecl =
- if !memcpy_used
- && not (List.exists (fun (Datatypes.Coq_pair(id, _)) -> id = memcpy_ident)
- fundecl)
- then Datatypes.Coq_pair(memcpy_ident,
- External(memcpy_ident, memcpy_arg_type, memcpy_res_type))
- :: fundecl
- else fundecl
-
-(** ** Translation functions *)
-
-(** Convert a [Cil.ikind] into a pair [(intsize * signedness)] *)
-let convertIkind ik =
- match TS.convertIkind ik with
- | Some p -> p
- | None -> unsupported "integer type specifier"
-
-
-(** Convert a [Cil.fkind] into a [floatsize] *)
-let convertFkind fk =
- match TS.convertFkind fk with
- | Some fs -> fs
- | None -> unsupported "floating-point type specifier"
-
-
-(** Convert a [Cil.constant] into a [CabsCoq.expr] *)
-let rec convertConstant = function
- | CInt64 (i64, _, _) ->
- let i = coqint_of_camlint (Int64.to_int32 i64) in
- Expr (Econst_int i, constInt32)
- | CStr s ->
- let symb = name_for_string_literal s in
- Expr (Evar symb, typeStringLiteral s)
- | CWStr _ ->
- unsupported "wide string literal"
- | CChr c ->
- let i = coqint_of_camlint (Int32.of_int (Char.code c)) in
- Expr (Econst_int i, constInt32)
- | CReal (f, _, _) ->
- Expr (Econst_float f, Tfloat F64)
- | (CEnum (exp, str, enumInfo)) as enum ->
- (* do constant folding on an enum constant *)
- let e = Cil.constFold false (Const enum) in
- convertExp e
-
-
-(** Convert a [Cil.UnOp] into a [CabsCoq.expr]
- ([t] is the type of the result of applying [uop] to [e]) *)
-and convertUnop uop e t =
- let e' = convertExp e in
- let t' = convertTyp t in
- let uop' = match uop with
- | Neg -> Eunop (Oneg, e')
- | BNot -> Eunop (Onotint, e')
- | LNot -> Eunop (Onotbool, e')
- in
- Expr (uop', t')
-
-
-(** Convert a [Cil.BinOp] into a [CabsCoq.expr]
- ([t] is the type of the result of applying [bop] to [(e1, e2)], every
- arithmetic conversion being made explicit by CIL for both arguments] *)
-and convertBinop bop e1 e2 t =
- let e1' = convertExp e1 in
- let e2' = convertExp e2 in
- let t' = convertTyp t in
- let bop' = match bop with
- | PlusA -> Ebinop (Oadd, e1', e2')
- | PlusPI -> Ebinop (Oadd, e1', e2')
- | IndexPI -> Ebinop (Oadd, e1', e2')
- | MinusA -> Ebinop (Osub, e1', e2')
- | MinusPI -> Ebinop (Osub, e1', e2')
- | MinusPP -> Ebinop (Osub, e1', e2')
- | Mult -> Ebinop (Omul, e1', e2')
- | Div -> Ebinop (Odiv, e1', e2')
- | Mod -> Ebinop (Omod, e1', e2')
- | Shiftlt -> Ebinop (Oshl, e1', e2')
- | Shiftrt -> Ebinop (Oshr, e1', e2')
- | Lt -> Ebinop (Olt, e1', e2')
- | Gt -> Ebinop (Ogt, e1', e2')
- | Le -> Ebinop (Ole, e1', e2')
- | Ge -> Ebinop (Oge, e1', e2')
- | Eq -> Ebinop (Oeq, e1', e2')
- | Ne -> Ebinop (One, e1', e2')
- | BAnd -> Ebinop (Oand, e1', e2')
- | BXor -> Ebinop (Oxor, e1', e2')
- | BOr -> Ebinop (Oor, e1', e2')
- | LAnd -> Eandbool (e1', e2')
- | LOr -> Eorbool (e1', e2')
- in
- Expr (bop', t')
-
-
-(** Test if two types are compatible
- (in order to cast one of the types to the other) *)
-and compatibleTypes t1 t2 = true
-(*
- let isArithmeticType = function
- | Tint _ | Tfloat _ -> true
- | _ -> false
- in
- let isPointerType = function
- | Tpointer _ | Tarray _ -> true
- | _ -> false
- in
- (t1 = t2)
- || (isArithmeticType t1 && isArithmeticType t2)
- || match (t1, t2) with
- | (Tpointer Tvoid, t) | (t, Tpointer Tvoid) -> isPointerType t
- | (Tint _, t) | (t, Tint _) -> isPointerType t
- | _ -> false
-*)
-
-
-(** Convert a [Cil.CastE] into a [CabsCoq.expr]
- (fail if the cast is illegal) *)
-and processCast t e =
- let t' = convertTyp t in
- let te = convertTyp (Cil.typeOf e) in
- if compatibleTypes t' te then
- let e' = convertExp e in
- Expr (Ecast (t', e'), t')
- else internal_error "processCast: illegal cast"
-
-
-(** Convert a [Cil.exp list] into an [CamlCoq.exprlist] *)
-and processParamsE = function
- | [] -> []
- | e :: l ->
- let (Expr (_, t)) as e' = convertExp e in
- match t with
- | Tstruct _ | Tunion _ ->
- unsupported "function parameter of struct or union type"
- | _ -> e' :: processParamsE l
-
-
-(** Convert a [Cil.exp] into a [CabsCoq.expr] *)
-and convertExp = function
- | Const c ->
- convertConstant c
- | Lval lv ->
- convertLval lv
- | SizeOf t ->
- Expr (Esizeof (convertTyp t), constInt32uns)
- | SizeOfE e ->
- let ty = convertTyp (Cil.typeOf e) in
- Expr (Esizeof ty, constInt32uns)
- | SizeOfStr str ->
- let n = coqint_of_camlint (Int32.of_int(String.length str)) in
- Expr (Econst_int n, constInt32uns)
- | AlignOf t ->
- unsupported "GCC `alignof' construct"
- | AlignOfE e ->
- unsupported "GCC `alignof' construct"
- | UnOp (uop, e, t) ->
- convertUnop uop e t
- | BinOp (bop, e1, e2, t) ->
- convertBinop bop e1 e2 t
- | CastE (t, e) ->
- processCast t e
- | AddrOf lv ->
- let (Expr (_, t)) as e = convertLval lv in
- Expr (Eaddrof e, Tpointer t)
- | StartOf lv ->
- (* convert an array into a pointer to the beginning of the array *)
- match Cil.unrollType (Cil.typeOfLval lv) with
- | TArray (t, _, _) ->
- let t' = convertTyp t in
- let tPtr = Tpointer t' in
- let e = convertLval lv in
- (* array A of type T replaced by (T* )A *)
- Expr (Ecast (tPtr, e), tPtr)
- | _ -> internal_error "convertExp: StartOf applied to a \
- lvalue whose type is not an array"
-
-
-(** Convert a [Cil.lval] into a [CabsCoq.expression] *)
-and convertLval lv =
- (* convert the offset of the lvalue *)
- let rec processOffset ((Expr (_, t)) as e) = function
- | NoOffset -> e
- | Field (f, ofs) ->
- begin match t with
- | Tstruct(id, fList) ->
- begin try
- let idf = intern_string f.fname in
- let t' = unrollType id t (getFieldType idf fList) in
- processOffset (Expr (Efield (e, idf), t')) ofs
- with Not_found ->
- internal_error "processOffset: no such struct field"
- end
- | Tunion(id, fList) ->
- begin try
- let idf = intern_string f.fname in
- let t' = unrollType id t (getFieldType idf fList) in
- processOffset (Expr (Efield (e, idf), t')) ofs
- with Not_found ->
- internal_error "processOffset: no such union field"
- end
- | _ ->
- internal_error "processOffset: Field on a non-struct nor union"
- end
- | Index (e', ofs) ->
- match t with
- | Tarray (t', _) ->
- let e'' = Ederef(Expr (Ebinop(Oadd, e, convertExp e'), t)) in
- processOffset (Expr (e'', t')) ofs
- | _ -> internal_error "processOffset: Index on a non-array"
- in
- (* convert the lvalue *)
- match lv with
- | (Var v, ofs) ->
- check_builtin v.vname;
- let id = intern_string v.vname in
- processOffset (Expr (Evar id, convertTyp v.vtype)) ofs
- | (Mem e, ofs) ->
- match Cil.unrollType (Cil.typeOf e) with
- | TPtr (t, _) -> let e' = Ederef (convertExp e) in
- processOffset (Expr (e', convertTyp t)) ofs
- | _ -> internal_error "convertLval: Mem on a non-pointer"
-
-
-(** Convert a [(Cil.string * Cil.typ * Cil.attributes)] list
- into a [typelist] *)
-and processParamsT convert = function
- | [] -> Tnil
- | (_, t, _) :: l ->
- let t' = convert t in
- match t' with
- | Tstruct _ | Tunion _ ->
- unsupported "function parameter of struct or union type"
- | _ -> Tcons (t', processParamsT convert l)
-
-
-(** Convert a [Cil.typ] into a [coq_type] *)
-and convertTypGen env = function
- | TVoid _ -> Tvoid
- | TInt (k, _) -> let (x, y) = convertIkind k in Tint (x, y)
- | TFloat (k, _) -> Tfloat (convertFkind k)
- | TPtr (TComp(c, _), _) when List.mem c.ckey env ->
- Tcomp_ptr (intern_string (Cil.compFullName c))
- | TPtr (t, _) -> Tpointer (convertTypGen env t)
- | TArray (t, eOpt, _) ->
- begin match eOpt with
- | None ->
- warning "array type of unspecified size";
- Tarray (convertTypGen env t, coqint_of_camlint 0l)
- | Some e ->
- begin try
- match eval_expr e with
- | CInt64 (i64, _, _) ->
- Tarray (convertTypGen env t,
- coqint_of_camlint (Int64.to_int32 i64))
- | _ -> unsupported "size of array type not an integer constant"
- with NotConst ->
- unsupported "size of array type not constant"
- end
- end
- | TFun (t, argListOpt, vArg, _) ->
- if vArg then unsupported "variadic function type";
- let argList =
- match argListOpt with
- | None -> unsupported "un-prototyped function type"
- | Some l -> l
- in
- let t' = convertTypGen env t in
- begin match t' with
- | Tstruct _ | Tunion _ ->
- unsupported "return type is a struct or union"
- | _ -> Tfunction (processParamsT (convertTypGen env) argList, t')
- end
- | TNamed (tinfo, _) -> convertTypGen env tinfo.ttype
- | TComp (c, _) ->
- let rec convertFieldList = function
- | [] -> Fnil
- | {fname=str; ftype=t} :: rem ->
- let idf = intern_string str in
- let t' = convertTypGen (c.ckey :: env) t in
- Fcons(idf, t', convertFieldList rem) in
- let fList = convertFieldList c.cfields in
- let id = intern_string (Cil.compFullName c) in
- if c.cstruct then Tstruct(id, fList) else Tunion(id, fList)
- | TEnum _ -> constInt32 (* enum constants are integers *)
- | TBuiltin_va_list _ -> unsupported "GCC `builtin va_list' type"
-
-and convertTyp ty = convertTypGen [] ty
-
-(** Convert a [Cil.varinfo] into a pair [(ident * coq_type)] *)
-let convertVarinfo v =
- updateLoc(v.vdecl);
- let id = intern_string v.vname in
- Datatypes.Coq_pair (id, convertTyp v.vtype)
-
-
-(** Convert a [Cil.varinfo] into a pair [(ident * coq_type)]
- (fail if the variable is of type struct or union) *)
-let convertVarinfoParam v =
- updateLoc(v.vdecl);
- let id = intern_string v.vname in
- let t' = convertTyp v.vtype in
- match t' with
- | Tstruct _ | Tunion _ ->
- unsupported "function parameter of struct or union type"
- | _ -> Datatypes.Coq_pair (id, t')
-
-
-(** Convert a [Cil.exp] which has a function type into a [CabsCoq.expr]
- (used only to translate function calls) *)
-let convertExpFuncall e eList =
- match typeOf e with
- | TFun (res, argListOpt, vArg, _) ->
- begin match argListOpt, vArg with
- | Some argList, false ->
- (* Prototyped, non-variadic function *)
- if List.length argList <> List.length eList then
- internal_error "convertExpFuncall: wrong number of arguments";
- (convertExp e, processParamsE eList)
- | _, _ ->
- (* Variadic or unprototyped function: generate a call to
- a stub function with the appropriate number and types
- of arguments. Works only if the function expression e
- is a global variable. *)
- let params = processParamsE eList in
- let fun_name =
- match e with
- | Lval(Var v, NoOffset) ->
- warning "working around a call to a variadic function";
- v.vname
- | _ ->
- unsupported "call to variadic function" in
- let rec typeOfExprList = function
- | [] -> Tnil
- | Expr (_, ty) :: rem -> Tcons (ty, typeOfExprList rem) in
- let targs = typeOfExprList params in
- let tres = convertTyp res in
- let (stub_fun_name, stub_fun_typ) =
- register_stub_function fun_name tres targs in
- (Expr(Evar(intern_string stub_fun_name), stub_fun_typ),
- params)
- end
- | _ -> internal_error "convertExpFuncall: not a function"
-
-(** Auxiliaries for function calls *)
-
-let makeFuncall1 tyfun (Expr(_, tlhs) as elhs) efun eargs =
- match tyfun with
- | TFun (t, _, _, _) ->
- let tres = convertTyp t in
- if tlhs = tres then
- Scall(Some elhs, efun, eargs)
- else begin
- let tmp = make_temp t in
- let elhs' = Expr(Evar tmp, tres) in
- Ssequence(Scall(Some elhs', efun, eargs),
- Sassign(elhs, Expr(Ecast(tlhs, elhs'), tlhs)))
- end
- | _ -> internal_error "wrong type for function in call"
-
-let makeFuncall2 tyfun tylhs elhs efun eargs =
- match elhs with
- | Expr(Evar _, _) ->
- makeFuncall1 tyfun elhs efun eargs
- | Expr(_, tlhs) ->
- let tmp = make_temp tylhs in
- let elhs' = Expr(Evar tmp, tlhs) in
- Ssequence(makeFuncall1 tyfun elhs' efun eargs,
- Sassign(elhs, elhs'))
-
-(** Convert a [Cil.instr] into a [CabsCoq.statement] *)
-let processInstr = function
- | Set (lv, rv, loc) ->
- updateLoc(loc);
- let lv' = convertLval lv in
- let rv' = convertExp rv in
- begin match typeof lv' with
- | Tstruct _ | Tunion _ -> compile_assignment (typeOfLval lv) lv' rv'
- | t -> Sassign (lv', rv')
- end
- | Call (None, e, eList, loc) ->
- updateLoc(loc);
- let (efun, params) = convertExpFuncall e eList in
- Scall(None, efun, params)
- | Call (Some lv, e, eList, loc) ->
- updateLoc(loc);
- let (efun, params) = convertExpFuncall e eList in
- makeFuncall2 (Cil.typeOf e) (Cil.typeOfLval lv) (convertLval lv) efun params
- | Asm (_, _, _, _, _, loc) ->
- updateLoc(loc);
- unsupported "inline assembly"
-
-(** Convert a [Cil.instr list] into a [CabsCoq.statement] *)
-
-let rec processInstrList = function
- | [] -> Sskip
- | [s] -> processInstr s
- | s :: l ->
- let cs = processInstr s in
- let cl = processInstrList l in
- Ssequence (cs, cl)
-
-
-(** Convert a [Cil.stmt list] into a [CabsCoq.statement] *)
-let rec processStmtList = function
- | [] -> Sskip
- | [s] -> convertStmt s
- | s :: l ->
- let cs = convertStmt s in
- let cl = processStmtList l in
- Ssequence (cs, cl)
-
-
-(** Return the list of the constant expressions in a label list
- (return [None] if this is the default case)
- (fail if the constant expression is not of type integer) *)
-and getCaseList lblList =
- match lblList with
- | [] -> Some []
- | Label (_, loc, _) :: l -> updateLoc(loc); getCaseList l
- | Default loc :: _ -> updateLoc(loc); None
- | Case (e, loc) :: l ->
- updateLoc(loc);
- begin match convertExp e with
- | Expr (Econst_int n, _) ->
- begin match getCaseList l with
- | None -> None
- | Some cl -> Some (n :: cl)
- end
- | _ -> internal_error "getCaseList: case label does not \
- reduce to an integer constant"
- end
-
-
-(** Convert a list of integers into a [CabsCoq.lblStatementList] *)
-and processCaseList cl s lrem =
- match cl with
- | [] -> internal_error "processCaseList: syntax error in switch statement"
- | [n] -> LScase (n, s, lrem)
- | n1 :: l -> LScase (n1, Sskip, processCaseList l s lrem)
-
-
-(** Convert a [Cil.stmt list] which is the body of a Switch structure
- into a [CabsCoq.lblStatementList]
- (Pre-condition: all the Case labels are supposed to be at the same level,
- ie. no nested structures) *)
-and processLblStmtList switchBody = function
- | [] -> LSdefault Sskip
- | [ls] ->
- let s = processStmtList (keepFrom ls switchBody) in
- begin match getCaseList ls.labels with
- | None -> LSdefault s
- | Some cl -> processCaseList cl s (LSdefault Sskip)
- end
- | ls :: ((ls' :: _) as l) ->
- if ls.labels = ls'.labels then processLblStmtList switchBody l
- else
- begin match getCaseList ls.labels with
- | None -> unsupported "default case is not at the end of this `switch' statement"
- | Some cl ->
- let s = processStmtList (keepBetween ls ls' switchBody) in
- let lrem = processLblStmtList switchBody l in
- processCaseList cl s lrem
- end
-
-
-(** Convert a [Cil.stmtkind] into a [CabsCoq.statement] *)
-and convertStmtKind = function
- | Instr iList ->
- processInstrList iList
- | Return (eOpt, loc) ->
- updateLoc(loc);
- let ty_ret = current_function_return_type() in
- let eOpt' = match eOpt with
- | None ->
- if isVoidType ty_ret
- then None
- else unsupported ("`return' without a value in function with non-void return type")
- | Some e ->
- if isVoidType ty_ret
- then unsupported ("`return' with a value in function returning void")
- else Some (convertExp e)
- in
- Sreturn eOpt'
- | Goto (sref, loc) ->
- updateLoc(loc);
- let rec extract_label = function
- | [] -> internal_error "convertStmtKind: goto without label"
- | Label(lbl, _, _) :: _ -> lbl
- | _ :: rem -> extract_label rem
- in
- Sgoto (intern_string (extract_label (!sref).labels))
- | Break loc ->
- updateLoc(loc);
- Sbreak
- | Continue loc ->
- updateLoc(loc);
- Scontinue
- | If (e, b1, b2, loc) ->
- updateLoc(loc);
- let e1 = processStmtList b1.bstmts in
- let e2 = processStmtList b2.bstmts in
- Sifthenelse (convertExp e, e1, e2)
- | Switch (e, b, l, loc) ->
- updateLoc(loc);
- Sswitch (convertExp e, processLblStmtList b.bstmts l)
- | While (e, b, loc) ->
- updateLoc(loc);
- Swhile (convertExp e, processStmtList b.bstmts)
- | DoWhile (e, b, loc) ->
- updateLoc(loc);
- Sdowhile (convertExp e, processStmtList b.bstmts)
- | For (bInit, e, bIter, b, loc) ->
- updateLoc(loc);
- let sInit = processStmtList bInit.bstmts in
- let e' = convertExp e in
- let sIter = processStmtList bIter.bstmts in
- Sfor (sInit, e', sIter, processStmtList b.bstmts)
- | Block b -> processStmtList b.bstmts
- | TryFinally (_, _, loc) ->
- updateLoc(loc);
- unsupported "`try'...`finally' statement"
- | TryExcept (_, _, _, loc) ->
- updateLoc(loc);
- unsupported "`try'...`except' statement"
-
-(** Convert a [Cil.stmtkind] into a [CabsCoq.statement] *)
-and convertStmt s =
- let rec add_labels l s =
- match l with
- | [] -> s
- | Label(lbl, _, _) :: rem -> Slabel(intern_string lbl, add_labels rem s)
- | _ :: rem -> add_labels rem s (* error? *)
- in add_labels s.labels (convertStmtKind s.skind)
-
-(** Convert a [Cil.GFun] into a pair [(ident * coq_fundecl)] *)
-let convertGFun fdec =
- current_function := Some fdec;
- let v = fdec.svar in
- let ret = match v.vtype with
- | TFun (t, _, vArg, _) ->
- if vArg then unsupported "variadic function";
- begin match convertTyp t with
- | Tstruct _ | Tunion _ ->
- unsupported "return value of struct or union type"
- | t' -> t'
- end
- | _ -> internal_error "convertGFun: incorrect function type"
- in
- let s = processStmtList fdec.sbody.bstmts in (* function body -- do it first because of generated temps *)
- let args = List.map convertVarinfoParam fdec.sformals in (* parameters*)
- let varList = List.map convertVarinfo fdec.slocals in (* local vars *)
- if v.vname = "main" then begin
- match ret with
- | Tint(_, _) -> ()
- | _ -> updateLoc v.vdecl;
- unsupported "the return type of main() must be an integer type"
- end;
- current_function := None;
- let id = intern_string v.vname in
- Hashtbl.add varinfo_atom id v;
- !define_function_hook id v;
- Datatypes.Coq_pair
- (id,
- Internal { fn_return=ret; fn_params=args; fn_vars=varList; fn_body=s })
-
-(** Auxiliary for [convertInit] *)
-
-let rec initDataLen accu = function
- | [] -> accu
- | i1 :: il ->
- let sz = match i1 with
- | Init_int8 _ -> 1l
- | Init_int16 _ -> 2l
- | Init_int32 _ -> 4l
- | Init_float32 _ -> 4l
- | Init_float64 _ -> 8l
- | Init_space n -> camlint_of_z n
- | Init_addrof(_, _) -> 4l
- | Init_pointer _ -> 4l in
- initDataLen (Int32.add sz accu) il
-
-(** Convert a [Cil.init] into a list of [AST.init_data] prepended to
- the given list [k]. Result is in reverse order. *)
-
-type init_constant =
- | ICint of int64 * intsize
- | ICfloat of float * floatsize
- | ICstring of string
- | ICaddrof of string
- | ICnone
-
-let extract_constant e =
- match e with
- | AddrOf(Var v, NoOffset) -> ICaddrof v.vname
- | StartOf(Var v, NoOffset) -> ICaddrof v.vname
- | _ ->
- try
- match eval_expr e with
- | CInt64(n, ikind, _) -> ICint(n, fst (convertIkind ikind))
- | CReal(n, fkind, _) -> ICfloat(n, convertFkind fkind)
- | CStr s -> ICstring s
- | _ -> ICnone
- with NotConst -> ICnone
-
-let init_data_of_string s =
- let id = ref [] in
- let enter_char c =
- let n = coqint_of_camlint(Int32.of_int(Char.code c)) in
- id := Init_int8 n :: !id in
- enter_char '\000';
- for i = String.length s - 1 downto 0 do enter_char s.[i] done;
- !id
-
-let convertInit init =
- let k = ref []
- and pos = ref 0 in
- let emit size datum =
- k := datum :: !k;
- pos := !pos + size in
- let emit_space size =
- emit size (Init_space (z_of_camlint (Int32.of_int size))) in
- let check_align size =
- assert (!pos land (size - 1) = 0) in
- let align size =
- let n = !pos land (size - 1) in
- if n > 0 then emit_space (size - n) in
-
- let rec cvtInit init =
- match init with
- | SingleInit e ->
- begin match extract_constant(Cil.constFold true e) with
- | ICint(n, I8) ->
- let n' = coqint_of_camlint (Int64.to_int32 n) in
- emit 1 (Init_int8 n')
- | ICint(n, I16) ->
- check_align 2;
- let n' = coqint_of_camlint (Int64.to_int32 n) in
- emit 2 (Init_int16 n')
- | ICint(n, I32) ->
- check_align 4;
- let n' = coqint_of_camlint (Int64.to_int32 n) in
- emit 4 (Init_int32 n')
- | ICfloat(n, F32) ->
- check_align 4;
- emit 4 (Init_float32 n)
- | ICfloat(n, F64) ->
- check_align 8;
- emit 8 (Init_float64 n)
- | ICaddrof id ->
- check_align 4;
- emit 4 (Init_addrof(intern_string id, coqint_of_camlint 0l))
- | ICstring s ->
- check_align 4;
- emit 4 (Init_pointer(init_data_of_string s))
- | ICnone ->
- unsupported "this kind of expression is not supported in global initializers"
- end
- | CompoundInit(ty, data) ->
- let ty' = convertTyp ty in
- let sz = Int32.to_int (camlint_of_z (Csyntax.sizeof ty')) in
- let pos0 = !pos in
- Cil.foldLeftCompoundAll
- ~doinit: cvtCompoundInit
- ~ct: ty
- ~initl: data
- ~acc: ();
- let pos1 = !pos in
- assert (pos1 <= pos0 + sz);
- if pos1 < pos0 + sz then emit_space (pos0 + sz - pos1)
-
- and cvtCompoundInit ofs init ty () =
- let ty' = convertTyp ty in
- let al = Int32.to_int (camlint_of_z (Csyntax.alignof ty')) in
- align al;
- cvtInit init
-
- in cvtInit init; List.rev !k
-
-(** Convert a [Cil.initinfo] into a list of [AST.init_data] *)
-
-let convertInitInfo ty info =
- match info.init with
- | None ->
- [ Init_space(Csyntax.sizeof (convertTyp ty)) ]
- | Some init ->
- convertInit init
-
-(** Convert a [Cil.GVar] into a global variable definition *)
-
-let convertGVar v i =
- updateLoc(v.vdecl);
- let id = intern_string v.vname in
- Hashtbl.add varinfo_atom id v;
- !define_variable_hook id v;
- Datatypes.Coq_pair (Datatypes.Coq_pair(id, convertInitInfo v.vtype i),
- convertTyp v.vtype)
-
-
-(** Convert a [Cil.GVarDecl] into a global variable declaration *)
-
-let convertExtVar v =
- updateLoc(v.vdecl);
- let id = intern_string v.vname in
- Hashtbl.add varinfo_atom id v;
- Datatypes.Coq_pair (Datatypes.Coq_pair(id, []),
- convertTyp v.vtype)
-
-(** Convert a [Cil.GVarDecl] into an external function declaration *)
-
-let convertExtFun v =
- updateLoc(v.vdecl);
- match convertTyp v.vtype with
- | Tfunction(args, res) ->
- let id = intern_string v.vname in
- Hashtbl.add varinfo_atom id v;
- Datatypes.Coq_pair (id, External(id, args, res))
- | _ ->
- assert false
-
-(** Convert a [Cil.global list] into a pair whose first component,
- of type [(ident * coq_function) coqlist], represents the definitions of the
- functions and the second component, of type [(ident * coq_type) coqlist],
- the definitions of the global variables of the program *)
-let rec processGlobals = function
- | [] -> ([], [])
- | g :: l ->
- match g with
- | GType _ -> processGlobals l (* typedefs are unrolled... *)
- | GCompTag _ -> processGlobals l
- | GCompTagDecl _ -> processGlobals l
- | GEnumTag _ -> processGlobals l (* enum constants are folded... *)
- | GEnumTagDecl _ -> processGlobals l
- | GVarDecl (v, loc) ->
- updateLoc(loc);
- (* Functions become external declarations,
- variadic and unprototyped functions are skipped,
- variables become uninitialized variables *)
- begin match Cil.unrollType v.vtype with
- | TFun (tres, Some targs, false, _) ->
- let fn = convertExtFun v in
- let (fList, vList) = processGlobals l in
- (fn :: fList, vList)
- | TFun (tres, _, _, _) ->
- processGlobals l
- | _ ->
- let var = convertExtVar v in
- let (fList, vList) = processGlobals l in
- (fList, var :: vList)
- end
- | GVar (v, init, loc) ->
- updateLoc(loc);
- let var = convertGVar v init in
- let (fList, vList) = processGlobals l in
- (fList, var :: vList)
- | GFun (fdec, loc) ->
- updateLoc(loc);
- let fn = convertGFun fdec in
- let (fList, vList) = processGlobals l in
- (fn :: fList, vList)
- | GAsm (_, loc) ->
- updateLoc(loc);
- unsupported "inline assembly"
- | GPragma (Attr(name, _) as attr, loc) ->
- updateLoc(loc);
- if not (!process_pragma_hook attr) then
- warning ("#pragma `" ^ name ^ "' directive ignored");
- processGlobals l
- | GText _ -> processGlobals l (* comments are ignored *)
-
-(** Eliminate forward declarations of globals that are defined later *)
-
-let cleanupGlobals globs =
- let defined =
- List.fold_right
- (fun g def ->
- match g with GVar (v, init, loc) -> v.vname :: def
- | GFun (fdec, loc) -> fdec.svar.vname :: def
- | _ -> def)
- globs [] in
- List.filter
- (function GVarDecl(v, loc) -> not(List.mem v.vname defined)
- | g -> true)
- globs
-
-(** Convert a [Cil.file] into a [CabsCoq.program] *)
-let convertFile f =
- stringNum := 0;
- Hashtbl.clear varinfo_atom;
- Hashtbl.clear stringTable;
- Hashtbl.clear stub_function_table;
- memcpy_used := false;
- let (funList, defList) = processGlobals (cleanupGlobals f.globals) in
- let funList1 = declare_stub_functions funList in
- let funList2 = match f.globinit with
- | Some fdec -> convertGFun fdec :: funList1
- | None -> funList1 in
- let funList3 = declare_memcpy funList2 in
- let defList1 = globals_for_strings defList in
- { AST.prog_funct = funList3;
- AST.prog_vars = defList1;
- AST.prog_main = intern_string "main" }
-
-(*-----------------------------------------------------------------------*)
-end
-
-(* Extracting information about global variables from their atom *)
-
-let atom_is_static a =
- try
- let v = Hashtbl.find varinfo_atom a in
- v.vstorage = Static
- with Not_found ->
- false
-
-let var_is_readonly v =
- let a = typeAttrs v.vtype in
- if hasAttribute "volatile" a then false else
- if hasAttribute "const" a then true else
- match Cil.unrollType v.vtype with
- | TArray(ty, _, _) ->
- let a' = typeAttrs ty in
- hasAttribute "const" a' && not (hasAttribute "volatile" a')
- | _ -> false
-
-let atom_is_readonly a =
- try var_is_readonly (Hashtbl.find varinfo_atom a)
- with Not_found -> false
diff --git a/cil/INSTALL b/cil/INSTALL
deleted file mode 100644
index ef7846fd9975f5c920e06038564d96a91d2a27fa..0000000000000000000000000000000000000000
--- a/cil/INSTALL
+++ /dev/null
@@ -1,41 +0,0 @@
-
- (For more complete installation instructions see the documentation in
- doc/html.)
-
- Building from source (see below for installing binary distributions)
----------------------------------------------------------------------
-
- 1. If you use Windows, you must first install cygwin.
-
- 2. You must install OCaml version 3.08 or higher (see instructions at
- http://caml.inria.fr/ocaml). The recommended build process is using
- the cygwin version of ocaml.
-
- You can also build with Microsoft Visual Studio, but you must still have
- cygwin during the build process. See msvcbuild.cmd.
-
- 3. Download and unpack the distribution.
-
- 4. Run ./configure (from within bash if on Windows)
-
- 5. Run make
-
- 6. Run make check
-
- Now you can start using bin/cilly and bin/ccured as explained in the
- documentation (in doc/html).
-
-
- Installing binary distributions (Windows-only)
------------------------------------------------
-
- 1. Unpack the installation package
-
- 2. Change CILHOME to the full path of the diretory where you put cil, in
- the following files: bin/CilConfig.pm, bin/cilly.bat, bin/patcher.bat
- 3. Go to test/small1 directory and run
- ..\..\cilly /c hello.c
-
-
-
-
\ No newline at end of file
diff --git a/cil/LICENSE b/cil/LICENSE
deleted file mode 100644
index 5a7dab5e33d679621bc87e6b71ad00677cddedac..0000000000000000000000000000000000000000
--- a/cil/LICENSE
+++ /dev/null
@@ -1,35 +0,0 @@
-Copyright (c) 2001-2005,
- George C. Necula <necula@cs.berkeley.edu>
- Scott McPeak <smcpeak@cs.berkeley.edu>
- Wes Weimer <weimer@cs.berkeley.edu>
- Ben Liblit <liblit@cs.wisc.edu>
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-1. Redistributions of source code must retain the above copyright notice,
-this list of conditions and the following disclaimer.
-
-2. Redistributions in binary form must reproduce the above copyright notice,
-this list of conditions and the following disclaimer in the documentation
-and/or other materials provided with the distribution.
-
-3. The names of the contributors may not be used to endorse or promote
-products derived from this software without specific prior written
-permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
-LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGE.
-
-
-(See http://www.opensource.org/licenses/bsd-license.php)
diff --git a/cil/Makefile.gcc b/cil/Makefile.gcc
deleted file mode 100644
index 8fae4e3436bbf181ec88f2eac18b76c1c587ee23..0000000000000000000000000000000000000000
--- a/cil/Makefile.gcc
+++ /dev/null
@@ -1,75 +0,0 @@
-# -*-makefile-*-
-# Makefile for CCured. The gcc part
-
-
-COMPILERNAME := GNUCC
-
-CC := gcc
-ifdef RELEASELIB
- # sm: I will leave this here, but only use it for compiling our runtime lib
- CFLAGS := -D_GNUCC -Wall -O3
-else
- CFLAGS := -D_GNUCC -Wall -g -ggdb -D_DEBUG
-endif
-
-# dsw: added optional -pg flag
-ifdef USE_PG
- CFLAGS += -pg
-endif
-
-ifdef NO_OPTIMIZATION
- OPT_O2 :=
-else
- OPT_O2 := -O2
-endif
-CONLY := -c
-OBJOUT := -o
-OBJEXT := o
-LIBEXT := a
-EXEOUT := -o
-LDEXT :=
-DEF := -D
-ASMONLY := -S -o
-WARNALL := -Wall
-# sm: shuffled around a couple things so I could use CPPSTART for patch2
-CPPSTART := gcc -E -x c -Dx86_LINUX -D_GNUCC -I/usr/include/sys
-CPPOUT := -o %o
-CPP := $(CPPSTART) -include fixup.h %i $(CPPOUT)
-INC := -I
-
-# sm: disable patching for now ('true' has no output)
-# (set it to 'echo' to re-enable)
-ifndef PATCHECHO
- PATCHECHO := echo
-endif
-
-AR := ar
-LIBOUT := -rs
-
-# The system include files to be patched
-PATCH_SYSINCLUDES := crypt.h ctype.h fcntl.h glob.h grp.h malloc.h netdb.h \
- pthread.h pwd.h signal.h stdarg.h stdio.h stdlib.h \
- string.h time.h unistd.h varargs.h arpa/inet.h \
- sys/cdefs.h sys/fcntl.h sys/ioctl.h sys/socket.h \
- sys/stat.h sys/types.h sys/uio.h malloc.h setjmp.h
-
-ifneq ($(ARCHOS), x86_WIN32)
-PATCH_SYSINCLUDES += sys/shm.h
-endif
-
-# dsw & sm: DON'T DO THIS. See comment in ccured_GNUCC.patch, search for 'sys/io.h'.
-# PATCH_SYSINCLUDES += sys/io.h
-
-# matth: reent.h is only in Cygwin, and Cygwin defines struct sigaction
-# in sys/signal.h:
-ifeq ($(ARCHOS), x86_WIN32)
-PATCH_SYSINCLUDES += sys/reent.h sys/signal.h
-endif
-
-# matth: these files are not in Cygwin
-ifeq ($(ARCHOS), x86_LINUX)
-PATCH_SYSINCLUDES += nl_types.h bits/sigaction.h bits/select.h sys/prctl.h \
- libgen.h shadow.h
-endif
-
-
diff --git a/cil/Makefile.in b/cil/Makefile.in
deleted file mode 100644
index a16d60cf1aa35b15cc7956a2117eee023af49ed0..0000000000000000000000000000000000000000
--- a/cil/Makefile.in
+++ /dev/null
@@ -1,656 +0,0 @@
-# -*- Mode: makefile -*-
-
-# Makefile for the cil wrapper
-# @do_not_edit@ Makefile.in
-#
-# author: George Necula
-
-#
-# If you want to add extra CIL features, you do not always need to change
-# this file. Just invoke
-# ./configure EXTRASRCDIRS=/home/foodir EXTRAFEATURES="foo bar"
-# This will add two features that must be defined in foo.ml and bar.ml
-#
-
-# Debugging. Set ECHO= to debug this Makefile
-.PHONY: setup quickbuild doc distrib machdep cilversion
-ECHO = @
-
-# It is important to build quickbuild first, to generate the proper dependencies
-all: quickbuild setup
-
-# Now add the defines for the CIL features
-@CIL_FEATURES_DEFINES@
-
-
-# look out for outdated Makefile; if it's out of date, this will automatically
-# re-run ./config.status, then re-exec make with the same arguments
-Makefile: config.status Makefile.in
- ./$<
-
-config.status: configure
- ./$@ --recheck
-
-configure: configure.in
- autoconf
-
-ocamlutil/perfcount.c: config.status ocamlutil/perfcount.c.in
- ./$<
-
-@DEFAULT_COMPILER@=1
-
-
-
-ifdef RELEASE
- NATIVECAML := 1
- UNSAFE := 1
-endif
-
-ifndef ARCHOS
- ARCHOS=@ARCHOS@
-endif
-
-# Put here all the byproducts of make
-OBJDIR := obj/$(ARCHOS)
-DEPENDDIR := obj/.depend
-
-CILLY_FEATURES :=
-ifdef USE_BLOCKINGGRAPH
- CILLY_FEATURES += blockinggraph
-endif
-ifdef USE_RAND
- CILLY_FEATURES += rand
-endif
-ifdef USE_ARITHABS
- CILLY_FEATURES += arithabs
-endif
-ifdef USE_SMALLOC
- CILLY_FEATURES += smalloc
-endif
-ifdef USE_CQUALANN
- CILLY_FEATURES += cqualann
-endif
-ifdef USE_ZRAPP
- CILLY_FEATURES += rmciltmps zrapp
-endif
-# Add the EXTRAFEATURES
-CILLY_FEATURES += @EXTRAFEATURES@
-
- # Now rules to make cilly
-CILLY_LIBRARY_MODULES = pretty inthash errormsg alpha trace stats util clist \
- cilutil escape growArray\
- cabs cabsvisit cprint lexerhack machdep cparser clexer \
- cilversion cil cillower formatparse formatlex formatcil cabs2cil \
- patch frontc check mergecil \
- dataflow dominators bitmap ssa ciltools \
- usedef logcalls logwrites rmtmps \
- callgraph epicenter heapify \
- setp uref olf ptranal \
- canonicalize heap oneret partial simplemem simplify \
- dataslicing sfi \
- cfg reachingdefs deadcodeelim availexps \
- liveness \
- testcil \
- $(CILLY_FEATURES) \
- ciloptions feature_config
-# ww: we don't want "main" in an external cil library (cil.cma),
-# otherwise every program that links against that library will get
-# main's argument checking and whatnot ...
-CILLY_MODULES = $(CILLY_LIBRARY_MODULES) main
-CILLY_CMODULES =
-CILLY_LIBS = unix str
-
-SOURCEDIRS += src src/frontc src/ext src/ext/pta ocamlutil @EXTRASRCDIRS@
-MLLS += clexer.mll formatlex.mll
-MLYS += cparser.mly formatparse.mly
-MODULES += $(CILLY_MODULES) libmaincil
-
-
-
- # Include now the common set of rules for OCAML
-include ocamlutil/Makefile.ocaml
-
-
- # Now the rule to make cilly
-
-PROJECT_EXECUTABLE = $(OBJDIR)/cilly$(EXE)
-PROJECT_MODULES = $(CILLY_MODULES)
-PROJECT_CMODULES = perfcount $(CILLY_CMODULES)
-PROJECT_LIBS = $(CILLY_LIBS)
-cilly: $(PROJECT_EXECUTABLE)
-include ocamlutil/Makefile.ocaml.build
-
-
-quickbuild: cilversion machdep cilly
-
-# Setup also makes the native code versions
-#
-# sm: cillib is only built with NATIVECAML=1 because it builds libcil.a,
-# which requires native-code .cmx compiled modules... could break it
-# into two targets so we build cil.cma both ways, but no one is using
-# cil.cma now so I'll leave it alone
-setup: cilversion machdep
- $(MAKE) cilly NATIVECAML=
- $(MAKE) cilly NATIVECAML=1
- $(MAKE) cillib NATIVECAML=
- $(MAKE) cillib NATIVECAML=1
-
-# Create the machine dependency module
-# If the cl command cannot be run then the MSVC part will be identical to GCC
-.PHONY : machdep
-machdep: $(OBJDIR)/machdep.ml
-$(OBJDIR)/machdep.ml : src/machdep.c configure.in Makefile.in
- rm -f $@
- echo "(* This module was generated automatically by code in Makefile and machdep.c *)" >$@
-# Now generate the type definition
- echo "type mach = {" >> $@
- echo " version_major: int; (* Major version number *)" >> $@
- echo " version_minor: int; (* Minor version number *)" >> $@
- echo " version: string; (* version number *)" >> $@
- echo " underscore_name: bool; (* If assembly names have leading underscore *)" >> $@
- echo " sizeof_short: int; (* Size of \"short\" *)" >> $@
- echo " sizeof_int: int; (* Size of \"int\" *)" >> $@
- echo " sizeof_long: int ; (* Size of \"long\" *)" >> $@
- echo " sizeof_longlong: int; (* Size of \"long long\" *)" >> $@
- echo " sizeof_ptr: int; (* Size of pointers *)" >> $@
- echo " sizeof_enum: int; (* Size of enum types *)" >> $@
- echo " sizeof_float: int; (* Size of \"float\" *)" >> $@
- echo " sizeof_double: int; (* Size of \"double\" *)" >> $@
- echo " sizeof_longdouble: int; (* Size of \"long double\" *)" >> $@
- echo " sizeof_sizeof: int; (* Size of \"sizeof(T)\" *)" >> $@
- echo " sizeof_wchar: int; (* Size of \"wchar_t\" *)" >> $@
- echo " sizeof_void: int; (* Size of \"void\" *)" >> $@
- echo " sizeof_fun: int; (* Size of function *)" >> $@
- echo " alignof_short: int; (* Alignment of \"short\" *)" >> $@
- echo " alignof_int: int; (* Alignment of \"int\" *)" >> $@
- echo " alignof_long: int; (* Alignment of \"long\" *)" >> $@
- echo " alignof_longlong: int; (* Alignment of \"long long\" *)" >> $@
- echo " alignof_ptr: int; (* Alignment of pointers *)" >> $@
- echo " alignof_enum: int; (* Alignment of enum types *)" >> $@
- echo " alignof_float: int; (* Alignment of \"float\" *)" >> $@
- echo " alignof_double: int; (* Alignment of \"double\" *)" >> $@
- echo " alignof_longdouble: int; (* Alignment of \"long double\" *)" >> $@
- echo " alignof_str: int; (* Alignment of strings *)" >> $@
- echo " alignof_fun: int; (* Alignment of function *)" >> $@
- echo " char_is_unsigned: bool; (* Whether \"char\" is unsigned *)">> $@
- echo " const_string_literals: bool; (* Whether string literals have const chars *)">> $@
- echo " little_endian: bool; (* whether the machine is little endian *)">>$@
- echo "}" >> $@
- if gcc -D_GNUCC $< -o $(OBJDIR)/machdep.exe ;then \
- echo "machdep.exe created succesfull." \
- ;else \
- rm -f $@; exit 1 \
- ;fi
- echo "let gcc = {" >>$@
- $(OBJDIR)/machdep.exe >>$@
- echo " underscore_name = @UNDERSCORE_NAME@ ;" >> $@
- echo "}" >>$@
- if cl /D_MSVC $< /Fe$(OBJDIR)/machdep.exe /Fo$(OBJDIR)/machdep.obj ;then \
- echo "let hasMSVC = true" >>$@ \
- ;else \
- echo "let hasMSVC = false" >>$@ ;fi
- echo "let msvc = {" >>$@
- $(OBJDIR)/machdep.exe >>$@
- echo " underscore_name = true ;" >> $@
- echo "}" >>$@
- echo "let gccHas__builtin_va_list = @HAVE_BUILTIN_VA_LIST@" >>$@
- echo "let __thread_is_keyword = @THREAD_IS_KEYWORD@" >>$@
-
-#
-# Create the version information module
-.PHONY: cilversion
-cilversion: $(OBJDIR)/cilversion.ml
-$(OBJDIR)/cilversion.ml: configure.in Makefile.in
- rm -f $@
- echo "(* This module was generated automatically by code in Makefile *)" >$@
-# Generate here the version information
- echo "let cilVersionMajor = @CIL_VERSION_MAJOR@" >>$@
- echo "let cilVersionMinor = @CIL_VERSION_MINOR@" >>$@
- echo "let cilVersionRev = @CIL_VERSION_REV@" >>$@
- echo "let cilVersion = \"@CIL_VERSION@\"" >>$@
-
-# build two libraries
-.PHONY: cillib libcil
-ifeq ($(NATIVECAML),1)
-cillib: $(OBJDIR)/cil.$(CMXA) # $(OBJDIR)/libcil.a
-else
-cillib: $(OBJDIR)/cil.$(CMXA)
-endif
-
-
-$(OBJDIR)/feature_config.ml: Makefile config.status
- rm -f $(OBJDIR)/feature_config.*
- echo "(* This module was generated automatically by code in Makefile.in *)" >$@
-# The Cilly feature options. A list of Cil.featureDescr
- echo "open Cil" >>$@
- echo "let features : featureDescr list = [" >> $@
-ifdef USE_BLOCKINGGRAPH
- echo " Blockinggraph.feature;" >> $@
-endif
-ifdef USE_RAND
- echo " Rand.feature;" >> $@
-endif
-ifdef USE_ARITHABS
- echo " Arithabs.feature;" >>$@
-endif
-ifdef USE_SMALLOC
- echo " Smalloc.feature;" >> $@
-endif
-ifdef USE_CQUALANN
- echo " Cqualann.feature;" >> $@
-endif
-ifdef USE_ZRAPP
- echo " Zrapp.feature;" >> $@
-endif
-# Now the extra features, with the first letter capitalized
- echo \
- $(foreach f,@EXTRAFEATURES@, \
- `echo $f | cut -c 1 | tr "[a-z]" "[A-Z]"``echo $f | cut -c 2-`".feature;") >> $@
- echo "]" >>$@
-# Must delete main.d and remake it, because it may have been made
-# before feature_config existed.
- rm -f $(DEPENDDIR)/main.d
- $(MAKE) $(DEPENDDIR)/main.d
-
-
-
-
-
-
-OCAML_CIL_LIB_MODULES := $(CILLY_LIBRARY_MODULES)
-OCAML_CIL_LIB_CMODULES := perfcount
-
-# list of modules to use for building a library; remove 'main'
-# and add 'libmaincil'
-OCAML_CIL_C_LIB_MODULES := $(CILLY_MODULES:main=) libmaincil
-
-# Build an OCAML library (CMA / CMXA) that exports our Cil stuff
-$(OBJDIR)/cil.$(CMXA): $(OCAML_CIL_LIB_CMODULES:%=$(OBJDIR)/lib%.a) \
- $(OCAML_CIL_LIB_MODULES:%=$(OBJDIR)/%.$(CMO))
- $(CAMLLINK) -a -o $@ -ccopt -L$(pkglibdir) \
- $(OCAML_CIL_LIB_CMODULES:%=-cclib -l%) \
- $(OCAML_CIL_LIB_MODULES:%=$(OBJDIR)/%.$(CMO))
-
-$(OBJDIR)/libperfcount.a: %: %($(OBJDIR)/perfcount.$(CMC))
- ranlib $@
-
-# sm: for Simon: build a library of CIL functions which can
-# be called from C code; this is like the target above, except
-# it is callable from C instead of from Ocaml
-ifeq ($(NATIVECAML),1)
-$(OBJDIR)/libcil.a: $(OCAML_CIL_LIB_CMODULES:%=$(OBJDIR)/lib%.a) \
- $(OCAML_CIL_LIB_MODULES:%=$(OBJDIR)/%.$(CMO))
- ocamlopt -output-obj -o $@ unix.cmxa str.cmxa $^
-else
-$(OBJDIR)/libcil.a:
- @echo "Can only build $@ when NATIVECAML is 1."
- exit 2
-endif
-
-# Test cil
-ifdef _MSVC
-TESTCILARG=--MSVC --testcil "bash msvctestcil"
-else
-TESTCILARG= --testcil "bash gcctestcil"
-endif
-
-.PHONY: testcil
-testcil: $(OBJDIR)/cilly$(EXE)
- cd test; ../$(OBJDIR)/cilly$(EXE) $(TESTCILARG)
-
-.PHONY: odoc texdoc pdfdoc
-
-###
-### DOCUMENTATION
-###
-### The following are available
-###
-### make doc - creates the documentation
-### make publish_doc - creates the documentation and puts it on the web page
-
-# Documentation generated by "ocamldoc"
-odoc: $(OBJDIR)/pretty.cmi $(OBJDIR)/cil.cmi
- -rm -rf doc/html/cil/api
- -mkdir doc/html/cil/api
- -mkdir doc/html/cil/api-latex
- -rm -f doc/ocamldoc.sty
- ocamldoc -d doc/html/cil/api -v -stars \
- -html \
- -t "CIL API Documentation (version @CIL_VERSION@)" \
- -I $(OBJDIR) \
- ocamlutil/pretty.mli ocamlutil/errormsg.mli \
- ocamlutil/clist.mli \
- ocamlutil/stats.mli src/cil.mli src/formatcil.mli \
- ocamlutil/alpha.mli src/cillower.mli \
- src/ext/cfg.mli src/ext/dataflow.mli \
- src/ext/dominators.mli
-
-doc/cilpp.tex: doc/cilcode.pl doc/cil.tex
- -rm -rf doc/html/cil
- -mkdir doc/html/cil
- -mkdir doc/html/cil/examples
- cd doc; perl cilcode.pl cil.tex >cilpp.tex.tmp
- mv doc/cilpp.tex.tmp $@
-
-# Documentation generated from latex files using "hevea"
-texdoc: doc/cilpp.tex
-# Create the version document
- cd doc/html/cil; echo "\def\cilversion{@CIL_VERSION@}" >cil.version.tex
- cd doc/html/cil; echo "\def\ccuredversion{@CCURED_VERSION@}" >>cil.version.tex
- cd doc/html/cil; hevea -exec xxdate.exe ../../cilpp
- cd doc/html/cil; hevea -exec xxdate.exe ../../cilpp
- cd doc/html/cil; mv cilpp.html cil.html
- cd doc/html/cil; hacha -o ciltoc.html cil.html
- cp -f doc/index.html doc/html/cil/index.html
- cp -f doc/header.html doc/html/cil
-
-pdfdoc: doc/cilpp.tex $(OBJDIR)/pretty.cmi $(OBJDIR)/cil.cmi
- cd doc; echo "\def\cilversion{@CIL_VERSION@}" >cil.version.tex
- cd doc; echo "\def\ccuredversion{@CCURED_VERSION@}" >>cil.version.tex
- cd doc; pdflatex cilpp.tex; pdflatex cilpp.tex
- cd doc; mv cilpp.pdf html/cil/CIL.pdf
- ocamldoc -o doc/cil-api.tex -v -stars \
- -latex \
- -t "CIL API Documentation (version @CIL_VERSION@)" \
- -I $(OBJDIR) \
- ocamlutil/pretty.mli ocamlutil/errormsg.mli \
- ocamlutil/clist.mli \
- ocamlutil/stats.mli src/cil.mli src/formatcil.mli \
- ocamlutil/alpha.mli
-
- cd doc ; TEXINPUTS="$$TEXINPUTS:/usr/local/lib/ocaml/ocamldoc:/usr/lib/ocaml/ocamldoc" pdflatex cil-api.tex
- cd doc ; mv cil-api.pdf html/cil/CIL-API.pdf
-
-doc: texdoc pdfdoc odoc
-
-
-#----------------------------------------------------------------------
-# Generate the CIL distribution
-# This will create a file cil.tar.gz. It includes the HTML documentation
-# so that people can use it even if they don't have ocamldoc, hevea etc.
-
-.PHONY: distrib distrib-nocheck checkdistrib
-CIL_TAR_GZ:=cil-@CIL_VERSION@.tar.gz
-## Make a distribution and check it
-distrib: distrib-nocheck checkdistrib
-
-# Work in a temporary directory
-TEMP_DIR = TEMP_cil-distrib
-
-# The tar archive members will be relative to this directory
-TOP_DIR = $(TEMP_DIR)/cil
-
-DISTRIB_ROOT = README LICENSE INSTALL Makefile.in \
- config.h.in Makefile.gcc Makefile.msvc \
- configure configure.in install-sh config.guess config.sub \
- cil.spec cil.spec.in
-
-DISTRIB_SRC = cilutil.ml cil.ml cil.mli check.ml check.mli \
- rmtmps.ml rmtmps.mli formatlex.mll formatparse.mly \
- formatcil.mli formatcil.ml testcil.ml \
- mergecil.ml mergecil.mli main.ml machdep.c \
- ciloptions.ml ciloptions.mli libmaincil.ml \
- escape.ml escape.mli cillower.mli cillower.ml
-
-DISTRIB_OCAMLUTIL = pretty.ml pretty.mli errormsg.ml errormsg.mli \
- trace.ml trace.mli stats.ml stats.mli util.ml util.mli \
- inthash.ml inthash.mli alpha.ml alpha.mli \
- intmap.ml intmap.mli clist.ml clist.mli \
- growArray.ml growArray.mli \
- perfcount.c.in Makefile.ocaml Makefile.ocaml.build
-
-
-DISTRIB_SRC_FRONTC = cabs.ml cprint.ml clexer.mli clexer.mll \
- cparser.mly lexerhack.ml \
- cabs2cil.ml cabs2cil.mli frontc.ml frontc.mli \
- cabsvisit.mli cabsvisit.ml patch.mli patch.ml
-
-DISTRIB_SRC_EXT = logcalls.ml logcalls.mli \
- astslicer.ml heap.ml partial.ml \
- logwrites.ml heapify.ml callgraph.ml callgraph.mli \
- epicenter.ml usedef.ml ciltools.ml \
- cfg.ml deadcodeelim.ml availexps.ml \
- dataflow.ml dataflow.mli \
- dominators.ml dominators.mli \
- bitmap.ml bitmap.mli \
- ssa.ml ssa.mli \
- stackoverflow.mli stackoverflow.ml \
- canonicalize.ml canonicalize.mli \
- oneret.ml oneret.mli sfi.ml \
- simplemem.ml simplify.ml \
- blockinggraph.ml blockinggraph.mli \
- dataslicing.ml dataslicing.mli \
- reachingdefs.ml \
- cfg.ml cfg.mli \
- liveness.ml
-
-DISTRIB_SRC_EXT_PTA = setp.ml setp.mli golf.ml golf.mli \
- ptranal.ml ptranal.mli \
- steensgaard.mli steensgaard.ml \
- uref.ml uref.mli olf.ml olf.mli
-
-DISTRIB_LIB = Cilly.pm KeptFile.pm OutputFile.pm TempFile.pm
-
-DISTRIB_BIN = CilConfig.pm.in cilly cilly.bat.in \
- patcher patcher.bat.in test-bad teetwo
-
-DISTRIB_SMALL1=hello.c func.c init.c init1.c wchar1.c vararg1.c testharness.h
-
-distrib-nocheck: $(DISTRIB_ROOT) doc
- # Create the distribution from scratch
- rm -rf $(TEMP_DIR)
- mkdir $(TEMP_DIR)
-
- rm -rf $(CIL_TAR_GZ)
- mkdir $(TOP_DIR) \
- $(TOP_DIR)/src \
- $(TOP_DIR)/src/frontc \
- $(TOP_DIR)/src/ext \
- $(TOP_DIR)/src/ext/pta \
- $(TOP_DIR)/obj \
- $(TOP_DIR)/doc \
- $(TOP_DIR)/lib \
- $(TOP_DIR)/bin \
- $(TOP_DIR)/doc/api \
- $(TOP_DIR)/obj/.depend \
- $(TOP_DIR)/obj/x86_WIN32 \
- $(TOP_DIR)/obj/x86_LINUX \
- $(TOP_DIR)/obj/ppc_DARWIN \
- $(TOP_DIR)/obj/sparc_SOLARIS \
- $(TOP_DIR)/test \
- $(TOP_DIR)/test/small1 \
- $(TOP_DIR)/ocamlutil
-
- cp $(patsubst %,%,$(DISTRIB_ROOT)) $(TOP_DIR)
-
- cp $(patsubst %,src/%,$(DISTRIB_SRC)) $(TOP_DIR)/src
- cp $(patsubst %,ocamlutil/%,$(DISTRIB_OCAMLUTIL)) $(TOP_DIR)/ocamlutil
- cp $(patsubst %,src/ext/%,$(DISTRIB_SRC_EXT)) $(TOP_DIR)/src/ext
- cp $(patsubst %,src/ext/pta/%,$(DISTRIB_SRC_EXT_PTA)) \
- $(TOP_DIR)/src/ext/pta
- cp $(patsubst %,src/frontc/%,$(DISTRIB_SRC_FRONTC)) \
- $(TOP_DIR)/src/frontc
- cp $(patsubst %,lib/%,$(DISTRIB_LIB)) $(TOP_DIR)/lib
- cp $(patsubst %,bin/%,$(DISTRIB_BIN)) $(TOP_DIR)/bin
- cp $(patsubst %,test/small1/%,$(DISTRIB_SMALL1)) $(TOP_DIR)/test/small1
-
- cp -r doc/html/cil/* $(TOP_DIR)/doc
-# Delete all CVS directories
- if find $(TEMP_DIR) -name CVS -print >cvss.txt ; then \
- rm -rf `cat cvss.txt` ;fi
-# Now make the TAR ball
- cd $(TEMP_DIR); tar cfz $(CIL_TAR_GZ) cil
- mv $(TEMP_DIR)/$(CIL_TAR_GZ) .
-
-# rm -rf $(TEMP_DIR)
-
-## Check a distribution
-checkdistrib:
- cd $(TOP_DIR) && ./configure && \
- $(MAKE) && $(MAKE) quicktest
-
-distclean: clean
- rm -f src/frontc/cparser.output
- rm -f src/formatparse.output
- rm -f ocamlutil/perfcount.c
- rm -f bin/cilly.bat
- rm -f bin/patcher.bat
- rm -f bin/CilConfig.pm
- rm -f config.log
- rm -f config.h
- rm -f Makefile
-
-## Publish the distribution
-CILHTMLDEST=/var/www/cil
-publish_distrib: publish_doc
- if test -d $(CILHTMLDEST); then \
- cp -rf doc/html/cil/* $(CILHTMLDEST); \
- cp -f $(CIL_TAR_GZ) $(CILHTMLDEST)/distrib; \
- ln -sf $(CILHTMLDEST)/distrib/$(CIL_TAR_GZ) $(CILHTMLDEST)/distrib/cil-latest.tar.gz ; \
- echo "Publish succeeded"; \
- else \
- error "Cannot publish because $(CILHTMLDEST) does not exist" ; \
- fi
-
-publish_doc: doc
- if test -d $(CILHTMLDEST); then \
- cp -rf doc/html/cil/* $(CILHTMLDEST); echo "Done publishing doc"; \
- else \
- error "Cannot publish because $(CILHTMLDEST) does not exist" ; \
- fi
-
-cleancheck:
- rm -f test/small1/*.o
- rm -f test/small1/hello
- rm -f test/small1/vararg1
- rm -f test/small1/wchar1
-
-clean: cleancaml cleancheck
- rm -f $(OBJDIR)/machdep.ml
-
-# Now include the compiler specific stuff
-ifdef _MSVC
- include Makefile.msvc
-else
- ifdef _GNUCC
- include Makefile.gcc
- endif
-endif
-
-test/%:
- bin/cilly $(CONLY) test/small1/$*.c $(OBJOUT)test/small1/$*.o
-
-testrun/%:
- bin/cilly test/small1/$*.c $(OBJOUT)test/small1/$*
- test/small1/$*
-
-
-
-.PHONY: quicktest
-quicktest: $(patsubst %,test/%,func init init1) \
- $(patsubst %,testrun/%,hello wchar1 vararg1)
-
-.PHONY: check
-check: quicktest
-
-############# Binary distribution ################
-.PHONY: bindistrb checkbindistrib
-
-BINCIL_TAR_GZ:=cil-win32-@CIL_VERSION@.tar.gz
-
-# Work in a temporary directory
-BINTEMP_DIR = TEMP_cil-bindistrib
-
-# The tar archive members will be relative to this directory
-BINTOP_DIR = $(BINTEMP_DIR)/cil
-
-BINDISTRIB_ROOT = README LICENSE
-
-BINDISTRIB_LIB = Cilly.pm KeptFile.pm OutputFile.pm TempFile.pm
-
-BINDISTRIB_BIN = CilConfig.pm.in cilly cilly.bat.in \
- patcher patcher.bat.in
-
-BINDISTRIB_OBJ = cilly.byte.exe cilly.asm.exe
-
-BINDISTRIB_SMALL1=hello.c
-
-bindistrib-nocheck: $(BINDISTRIB_ROOT) obj/x86_WIN32/cilly.asm.exe
- # Create the distribution from scratch
- rm -rf $(BINTEMP_DIR)
- mkdir $(BINTEMP_DIR)
-
- mkdir $(BINTOP_DIR) \
- $(BINTOP_DIR)/obj \
- $(BINTOP_DIR)/doc \
- $(BINTOP_DIR)/lib \
- $(BINTOP_DIR)/bin \
- $(BINTOP_DIR)/doc/api \
- $(BINTOP_DIR)/obj/.depend \
- $(BINTOP_DIR)/obj/x86_WIN32 \
- $(BINTOP_DIR)/test \
- $(BINTOP_DIR)/test/small1
-
- cp $(patsubst %,%,$(BINDISTRIB_ROOT)) $(BINTOP_DIR)
- cp $(patsubst %,lib/%,$(BINDISTRIB_LIB)) $(BINTOP_DIR)/lib
- cat bin/CilConfig.pm.in \
- | sed -e "s|@||g" \
- | sed -e "s|CC|cl|" \
- | sed -e "s|DEFAULT_CIL_MODE|MSVC|" \
- | sed -e "s|ARCHOS|x86_WIN32|" \
- > $(BINTOP_DIR)/bin/CilConfig.pm
- cat bin/patcher.bat.in | sed -e "s|@||g" >$(BINTOP_DIR)/bin/patcher.bat
- cp bin/patcher $(BINTOP_DIR)/bin
- cp bin/cilly $(BINTOP_DIR)/bin
- cat bin/cilly.bat.in | sed -e "s|@||g" > $(BINTOP_DIR)/bin/cilly.bat
- cp $(patsubst %,test/small1/%,$(BINDISTRIB_SMALL1)) \
- $(BINTOP_DIR)/test/small1
- cp $(patsubst %,obj/x86_WIN32/%,$(BINDISTRIB_OBJ)) \
- $(BINTOP_DIR)/obj/x86_WIN32
-
- cp -r doc/html/cil/* $(BINTOP_DIR)/doc
-# Delete all CVS directories
- if find $(BINTEMP_DIR) -name CVS -print >cvss.txt ; then \
- rm -rf `cat cvss.txt` ;fi
-# Now make the TAR ball
- cd $(BINTEMP_DIR); tar cfz $(BINCIL_TAR_GZ) cil
- mv $(BINTEMP_DIR)/$(BINCIL_TAR_GZ) .
-
-# rm -rf $(TEMP_DIR)
-
-## Check a distribution
-checkbindistrib:
-
-########################################################################
-
-
-INSTALL = @INSTALL@
-INSTALL_DATA = @INSTALL_DATA@
-
-prefix = @prefix@
-exec_prefix = @exec_prefix@
-libdir = @libdir@
-pkglibdir = $(libdir)/cil
-datadir = @datadir@
-pkgdatadir = $(datadir)/cil
-
-all_mli := $(filter %.mli, $(DISTRIB_OCAMLUTIL) $(DISTRIB_SRC) $(DISTRIB_SRC_FRONTC) $(DISTRIB_SRC_EXT) $(DISTRIB_SRC_EXT_PTA))
-install_mli := $(filter $(OCAML_CIL_LIB_MODULES:=.mli), $(all_mli))
-install_cmi := $(install_mli:%.mli=$(OBJDIR)/%.cmi)
-install_cma := $(addprefix $(OBJDIR)/cil., cma cmxa a)
-install_lib := $(OCAML_CIL_LIB_CMODULES:%=$(OBJDIR)/lib%.a)
-
-install: $(install_cmi) $(install_cma) $(install_lib)
- $(INSTALL) -d $(DESTDIR)$(pkglibdir)
- $(INSTALL_DATA) $(install_cma) $(DESTDIR)$(pkglibdir)
- $(INSTALL_DATA) $(install_cmi) $(DESTDIR)$(pkglibdir)
- $(INSTALL_DATA) $(install_lib) $(DESTDIR)$(pkglibdir)
- $(INSTALL) -d $(DESTDIR)$(pkgdatadir)
- $(INSTALL_DATA) $(addprefix lib/, $(filter %.pm, $(DISTRIB_LIB))) $(DESTDIR)$(pkgdatadir)
-
-cil.spec: cil.spec.in
- ./config.status $@
-
-rpms: distrib
- rpmbuild -ta $(CIL_TAR_GZ)
-
diff --git a/cil/Makefile.msvc b/cil/Makefile.msvc
deleted file mode 100644
index be1bb3823e12299f81fc856679cd6c87327ad6be..0000000000000000000000000000000000000000
--- a/cil/Makefile.msvc
+++ /dev/null
@@ -1,42 +0,0 @@
-#
-# Makefile for CCured. The Microsoft Visual C part
-#
-COMPILERNAME=MSVC
-
-CC:=cl /nologo
-ifdef RELEASELIB
-#matth: we need the frame pointer for CHECK_GETFRAME, so
-# use /Oy- to prevent that optimization.
- CFLAGS:=/DRELEASE /D_MSVC /Ox /Ob2 /G6 /Oy-
-else
- CFLAGS:=/D_DEBUG /D_MSVC /Zi /MLd
-endif
-CONLY:=/c
-
-OPT_O2:= /Ox /Ob2 /G6
-
-OBJOUT:=/Fo
-OBJEXT:=obj
-
-EXEOUT:=/Fe
-LIBEXT:=lib
-LDEXT:=.exe
-
-DEF:=/D
-ASMONLY:=/Fa
-INC:=/I
-
-CPPSTART:=cl /Dx86_WIN32 /D_MSVC /E /TC /I./lib /DCCURED
-CPPOUT:= >%o
-CPP:=$(CPPSTART) /FI fixup.h %i $(CPPOUT)
-
-PATCHECHO:=echo
-
-AR:=lib
-LIBOUT:=/OUT:
-
-# The system include files to be patched
-PATCH_SYSINCLUDES:=stdio.h ctype.h string.h io.h stdarg.h crtdbg.h \
- varargs.h stdlib.h time.h malloc.h
-
-
diff --git a/cil/README b/cil/README
deleted file mode 100644
index 52710f2a902814f3691ab1c0404132ec022fa9ea..0000000000000000000000000000000000000000
--- a/cil/README
+++ /dev/null
@@ -1,2 +0,0 @@
-
- See the documentation in doc/html.
diff --git a/cil/bin/CilConfig.pm.in b/cil/bin/CilConfig.pm.in
deleted file mode 100644
index 94241b19065798f2cebbc04e610b13aee0da8d97..0000000000000000000000000000000000000000
--- a/cil/bin/CilConfig.pm.in
+++ /dev/null
@@ -1,6 +0,0 @@
-
-$::archos = "@ARCHOS@";
-$::cc = "@CC@";
-$::cilhome = "@CILHOME@";
-$::default_mode = "@DEFAULT_CIL_MODE@";
-
diff --git a/cil/bin/cilly b/cil/bin/cilly
deleted file mode 100755
index e4bf737c7370a56525bfab1127b05357a84e7787..0000000000000000000000000000000000000000
--- a/cil/bin/cilly
+++ /dev/null
@@ -1,152 +0,0 @@
-#!/usr/bin/perl
-# A simple use of the Cilly module
-#
-#
-#
-# Copyright (c) 2001-2002,
-# George C. Necula <necula@cs.berkeley.edu>
-# Scott McPeak <smcpeak@cs.berkeley.edu>
-# Wes Weimer <weimer@cs.berkeley.edu>
-# All rights reserved.
-#
-# Redistribution and use in source and binary forms, with or without
-# modification, are permitted provided that the following conditions are
-# met:
-#
-# 1. Redistributions of source code must retain the above copyright
-# notice, this list of conditions and the following disclaimer.
-#
-# 2. Redistributions in binary form must reproduce the above copyright
-# notice, this list of conditions and the following disclaimer in the
-# documentation and/or other materials provided with the distribution.
-#
-# 3. The names of the contributors may not be used to endorse or promote
-# products derived from this software without specific prior written
-# permission.
-#
-# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
-# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
-# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
-# OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-# EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-#
-use strict;
-use Data::Dumper;
-use FindBin;
-use lib "$FindBin::Bin";
-use lib "$FindBin::Bin/../lib"; # The libraries are in the lib directory
-# Read the configuration script
-use CilConfig;
-
-use Cilly;
-
-$::default_is_merge = 0;
-my $stub = CilCompiler->new(@ARGV);
-
-$stub->setVersion ();
-
-# print Dumper($stub);
-$stub->doit();
-
-
-# Define here your favorite compiler by overriding Merger methods
-package CilCompiler;
-use File::Basename;
-use strict;
-BEGIN {
- @CilCompiler::ISA = qw(Cilly);
- $CilCompiler::base = "$::cilhome/obj/$::archos/cilly";
- # Use the most recent version of cilly
- $CilCompiler::mtime_asm = int((stat("$CilCompiler::base.asm.exe"))[9]);
- $CilCompiler::mtime_byte = int((stat("$CilCompiler::base.byte.exe"))[9]);
- $CilCompiler::use_debug =
- grep(/--bytecode/, @ARGV) ||
- grep(/--ocamldebug/, @ARGV) ||
- ($CilCompiler::mtime_asm < $CilCompiler::mtime_byte);
- $CilCompiler::compiler =
- $CilCompiler::base .
- ($CilCompiler::use_debug ? ".byte" : ".asm") . ".exe";
- if($CilCompiler::use_debug) {
- $ENV{"OCAMLRUNPARAM"} = "b" . $ENV{"OCAMLRUNPARAM"};
- }
-}
-
-# We need to customize the collection of arguments
-sub collectOneArgument {
- my($self, $arg, $pargs) = @_;
- if($arg =~ m|--transval=(.+)$|) {
- $self->{TRANSVAL} = $1; return 1;
- }
- if($arg eq '--ocamldebug') {
- $self->{OCAMLDEBUG} = 1; return 1;
- }
- if($arg eq '--cabsonly') {
- $self->{CABSONLY} = 1; return 1;
- }
- # See if the super class understands this
- return $self->SUPER::collectOneArgument($arg, $pargs);
-}
-
-sub usage {
- print "Usage: cilly [options] [gcc_or_mscl arguments]\n";
-}
-
-sub helpMessage {
- my($self) = @_;
- # Print first the original
- $self->SUPER::helpMessage();
- print <<EOF;
-
- All other arguments starting with -- are passed to the Cilly process.
-
-The following are the arguments of the Cilly process
-EOF
- my @cmd = ($CilCompiler::compiler, '-help');
- $self->runShell(@cmd);
-}
-
-
-sub CillyCommand {
- my ($self, $ppsrc, $dest) = @_;
-
- my $aftercil;
- my @cmd = ($CilCompiler::compiler);
-
- if(defined $ENV{OCAMLDEBUG} || $self->{OCAMLDEBUG}) {
- print "OCAMLDEBUG is on\n";
- my @idirs = ("src", "src/frontc", "src/ccured", "src/ext",
- "ocamlutil",
- "obj/$::archos");
- my @iflags = map { ('-I', "$::cilhome/$_") } @idirs;
- unshift @cmd, 'ocamldebug', '-emacs', @iflags;
- }
- if($::docxx) {
- push @cmd, '--cxx';
- }
- if($self->{CABSONLY}) {
- $aftercil = $self->cilOutputFile($dest, 'cabs.c');
- push @cmd, '--cabsonly', $aftercil;
- } else {
- if(defined $self->{CILLY_OUT}) {
- $aftercil = new OutputFile($dest, $self->{CILLY_OUT});
- return ($aftercil, @cmd);
- }
- $aftercil = $self->cilOutputFile($dest, 'cil.c');
- }
- return ($aftercil, @cmd, '--out', $aftercil);
-}
-
-sub MergeCommand {
- my ($self, $ppsrc, $dir, $base) = @_;
-
- return ('', $CilCompiler::compiler);
-}
-
-
-1;
diff --git a/cil/bin/cilly.bat.in b/cil/bin/cilly.bat.in
deleted file mode 100755
index 9e5a36e5224bb9045826b4c2cf3477e897c3e93c..0000000000000000000000000000000000000000
--- a/cil/bin/cilly.bat.in
+++ /dev/null
@@ -1 +0,0 @@
-perl @CILHOME@/bin/cilly %*
diff --git a/cil/bin/patcher b/cil/bin/patcher
deleted file mode 100755
index 6eb7d1546025ed96b22bbda6926c12be931fb97b..0000000000000000000000000000000000000000
--- a/cil/bin/patcher
+++ /dev/null
@@ -1,605 +0,0 @@
-#!/usr/bin/perl
-# A Perl script that patches a bunch of files
-#
-#
-#
-# Copyright (c) 2001-2002,
-# George C. Necula <necula@cs.berkeley.edu>
-# Scott McPeak <smcpeak@cs.berkeley.edu>
-# Wes Weimer <weimer@cs.berkeley.edu>
-# All rights reserved.
-#
-# Redistribution and use in source and binary forms, with or without
-# modification, are permitted provided that the following conditions are
-# met:
-#
-# 1. Redistributions of source code must retain the above copyright
-# notice, this list of conditions and the following disclaimer.
-#
-# 2. Redistributions in binary form must reproduce the above copyright
-# notice, this list of conditions and the following disclaimer in the
-# documentation and/or other materials provided with the distribution.
-#
-# 3. The names of the contributors may not be used to endorse or promote
-# products derived from this software without specific prior written
-# permission.
-#
-# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
-# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
-# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
-# OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-# EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-#
-use strict;
-use File::Basename;
-use File::Copy;
-use Getopt::Long; # Command-line option processing
-use Data::Dumper;
-use FindBin;
-use lib "$FindBin::Bin";
-use lib "$FindBin::Bin/../lib";
-# Read the configuration script
-use CilConfig;
-
-$::iswin32 = $^O eq 'MSWin32' || $^O eq 'cygwin';
-# matth: On cygwin, ^O is either MSWin32 or cygwin, depending on how you build
-# perl. We don't care about the distinction, so just treat all windows
-# platforms the same when looking at "system=cygwin" tags on patches.
-$::platform = $::iswin32 ? 'cygwin' : $^O;
-
-
-# Set filename parsing according to current operating system.
-File::Basename::fileparse_set_fstype($^O);
-
-sub printHelp {
- print <<EOL;
-Patch include files
-Usage: patcher [options] args
-
-options:
- --help Prints this help message
- --verbose Prints a lot of information about what is being done
- --mode=xxx What tool to emulate:
- GNUCC - GNU CC
- MSVC - MS VC cl compiler
- EDG - EDG front end
-
- --dest=xxx The destination directory. Will make one if it does not exist
- --patch=xxx Patch file (can be specified multiple times)
-
- --ufile=xxx A user-include file to be patched (treated as \#include "xxx")
- --sfile=xxx A system-include file to be patched (treated as \#include <xxx>)
-
- --clean Remove all files in the destination directory
- --dumpversion Print the version name used for the current compiler
-
- All of the other arguments are passed to the preprocessor.
-
-We will use \"$::platform\" as your system type.
-
-Send bugs to necula\@cs.berkeley.edu.
-EOL
-}
-
-
-my %option;
-&Getopt::Long::Configure("pass_through");
-&Getopt::Long::GetOptions
- (\%option,
- "--help", # Display help information
- "--verbose|v", # Display information about programs invoked
- "--mode=s", # The mode (GNUCC, MSVC)
- "--dest=s", # The destination directory
- "--patch=s@", # Patch files
- "--ufile=s@", # User include files
- "--sfile=s@", # System include files
- "--dumpversion",
- "--clean",
- );
-
-if($option{help}) {
- &printHelp();
- exit 0;
-}
-
-# print Dumper({"option" => \%option, "ARGV" => \@ARGV});
-
-my $cversion; # Compiler version
-my $cname; # Compiler name
-my @patches; # A list of the patches to apply
-
-my $ppargs = join(' ', @ARGV);
-
-my %groups;
-
-&findCompilerVersion();
-
-if($option{dumpversion}) {
- print $cversion;
- exit 0;
-}
-
-# Find the destination directory
-if(!defined($option{dest})) {
- die "Must give a --dest directory\n";
-}
-if(! -d $option{dest}) {
- die "The destination directory $option{dest} does not exist\n";
-}
-
-if($option{clean}) {
- # Find the destination directory for a dummy file
- my $dest = &destinationFileName("");
- chop $dest; # The final /
- print "Cleaning all files in $dest\n";
- (!system("rm -rf $dest")) || die "Cannot remove directory\n";
- exit 0;
-}
-
-print "Patching files for $cname version $cversion\n";
-
-# Prepare the patches
-if(defined($option{patch})) {
- my $pFile;
- foreach $pFile (@{$option{patch}}) {
- &preparePatchFile($pFile);
- }
-}
-
-# print Dumper(\@patches);
-
-my $file;
-foreach $file (@{$option{ufile}}) {
- &patchOneFile($file, 0);
-}
-foreach $file (@{$option{sfile}}) {
- &patchOneFile($file, 1);
-}
-
-# Now check whether we have used all the patches
-my $hadError = 0;
-foreach my $patch (@patches) {
- # It was optional
- if(defined $patch->{FLAGS}->{optional} ||
- defined $patch->{FLAGS}->{disabled}) { next; }
- # It was for another system
- if(defined $patch->{FLAGS}->{system} &&
- $patch->{FLAGS}->{system} ne $::platform) { next; }
- # Its group was done
- if(defined $patch->{FLAGS}->{group}) {
- if(! defined $groups{$patch->{FLAGS}->{group}}) {
- $hadError = 1;
- print "None of the following patches from group $patch->{FLAGS}->{group} was used:\n";
- foreach my $gp (@patches) {
- if($gp->{FLAGS}->{group} eq $patch->{FLAGS}->{group}) {
- print "\tfrom $gp->{PATCHFILE} at $gp->{PATCHLINENO}\n";
- }
- }
- $groups{$patch->{FLAGS}->{group}} = 1; # We're done with it
- }
- next;
- }
- # It was not in a group and was not optional
- if(! defined $patch->{USED}) {
- $hadError = 1;
- print "Non-optional patch was not used:\n\tfrom $patch->{PATCHFILE} at $patch->{PATCHLINENO}\n";
- next;
- }
-}
-exit $hadError;
-
-
-############# SUBROUTINES
-sub findCompilerVersion {
- $cname = "";
- $cversion = 0;
- if($option{mode} eq "GNUCC") {
- $cname = "GNU CC";
- open(VER, "$::cc -dumpversion $ppargs|")
- || die "Cannot start $cname";
- while(<VER>) {
- # sm: had to modify this to match "egcs-2.91.66", which is
- # how egcs responds to the -dumpversion request
- if($_ =~ m|^(\d+\S+)| ||
- $_ =~ m|^(egcs-\d+\S+)|) {
- $cversion = "gcc_$1";
- close(VER) || die "Cannot start $cname\n";
- return;
- }
- }
- die "Cannot find the version for GCC\n";
- }
- if($option{mode} eq "MSVC") {
- $cname = "Microsoft cl";
- $ppargs =~ s|/nologo||g;
- open(VER, "cl $ppargs 2>&1|") || die "Cannot start $cname: cl $ppargs\n";
- while(<VER>) {
- if($_ =~ m|Compiler Version (\S+) |) {
- $cversion = "cl_$1";
- close(VER);
- return;
- }
- }
- die "Cannot find the version for Microsoft CL\n";
- }
- die "You must specify a --mode (either GNUCC or MSVC)";
-}
-
-sub lineDirective {
- my ($fileName, $lineno) = @_;
- if($::iswin32) {
- $fileName =~ s|\\|/|g;
- }
- if($option{mode} eq "MSVC") {
- return "#line $lineno \"$fileName\"\n";
- }
- if($option{mode} eq "GNUCC" || $option{mode} eq "EDG") {
- return "# $lineno \"$fileName\"\n";
- }
- die "lineDirective: invalid mode";
-}
-
-# Find the absolute name for a file
-sub patchOneFile {
- my ($fname, $issys) = @_;
- my $fname1 = $issys ? "<$fname>" : "\"$fname\"";
- print "Patching $fname1\n";
- my $preprocfile = "__topreproc";
- unlink "$preprocfile.i";
- open(TOPREPROC, ">$preprocfile.c") || die "Cannot open preprocessor file";
- print TOPREPROC "#include $fname1\n";
- close(TOPREPROC);
- # Do not test for error while running the preprocessor because the
- # error might be due to an #error directive
- my $preproccmd = "";
- if($option{mode} eq "GNUCC") {
- $preproccmd = "$::cc -E $ppargs $preprocfile.c >$preprocfile.i";
- if ($^O ne 'MSWin32') { # Windows has no /dev/null
- # ignore stderr (e.g. #error directives)
- $preproccmd .= " 2>/dev/null";
- }
- } elsif($option{mode} eq "MSVC") {
- $preproccmd = "cl /nologo /P $ppargs $preprocfile.c";
- } else { die "Invalid --mode"; }
-
- if(system($preproccmd) && $option{mode} eq "MSVC" ) {
- # For some reason the gcc returns spurious error codes
- die "Error running preprocessor: $preproccmd"
- }
-
- # Now scan the resulting file and get the real name of the file
- my $absname = "";
- open(PPOUT, "<$preprocfile.i") || die "Cannot find $preprocfile.i";
- while(<PPOUT>) {
- if($_ =~ m|^\#.+\"(.+$fname)\"|) {
- $absname = $1;
- last;
- }
- }
- close(PPOUT);
- if($absname eq "") {
- die "Cannot find the absolute name of $fname1 in $preprocfile.i\n";
- }
- unlink "$preprocfile.c";
- unlink "$preprocfile.i";
- # If we fail then maybe we are using cygwin paths in a Win32 system
- if($option{mode} eq "GNUCC" && $::iswin32) {
- open(WINNAME, "cygpath -w $absname|")
- || die "Cannot run cygpath to convert $absname to a Windows name";
- $absname = <WINNAME>;
- if($absname =~ m|\n$|) {
- chop $absname;
- }
- # print "Converted $fileName to $newName\n";
- close(WINNAME) || die "Cannot run cygpath to convert $absname";
- }
- if(! -f $absname) { #matth: we need to do this test after calling cygpath
- die "Cannot find the absolute name of $fname1 (\"$absname\")\n";
- }
- print " Absolute name is $absname\n";
- # Decide where to put the result
- my $dest = &destinationFileName($fname);
- print " Destination is $dest\n";
- &applyPatches($absname, $dest);
-}
-
-# Is absolute path name?
-sub isAbsolute {
- my($name) = @_;
- if($::iswin32) {
- return ($name =~ m%^([a-zA-Z]:)?[/\\]%);
- } else {
- return ($name =~ m%^[/\\]%);
- }
-}
-
-# Compute the destination file name and create all necessary directories
-sub destinationFileName {
- my ($fname) = @_;
- if(&isAbsolute($fname)) {
- die "Cannot process files that have absolute names\n";
- }
- my $dest = $option{dest} . "/" . $cversion;
- # Break the file name into components
- my @fnamecomp = split(m%[/\\]%, $fname);
- # Add one component at a time
- do {
- if(! -d $dest) {
- (mkdir $dest, 0777) || die "Cannot create directory $dest\n";
- }
- my $comp = shift @fnamecomp;
- $dest .= ('/' . $comp);
- } while($#fnamecomp >= 0);
- return $dest;
-}
-#####################################################################
-# Patching of files
-#
-sub preparePatchFile {
- my ($pFile) = @_;
- open(PFILE, "<$pFile") ||
- die "Cannot read patch file $pFile\n";
- my $patchLineNo = 0;
- my $patchStartLine = 0;
- NextPattern:
- while(<PFILE>) {
- $patchLineNo ++;
- if($_ !~ m|^<<<(.*)$|) {
- next;
- }
- # Process the flags
- my @patchflags = split(/\s*,\s*/, $1);
- my %valueflags;
- foreach my $flg (@patchflags) {
- $flg = &trimSpaces($flg);
- if($flg =~ m|^(.+)\s*=\s*(.+)$|) {
- $valueflags{$1} = $2;
- } else {
- $valueflags{$flg} = 1;
- }
- }
- # Now we have found the start
- $_ = <PFILE>;
- $patchLineNo ++;
- my $current_pattern = [];
- my @all_patterns = ();
- if($_ =~ m|^===|) {
- if(! defined $valueflags{ateof} &&
- ! defined $valueflags{atsof}) {
- die "A pattern is missing in $pFile";
- }
- goto AfterPattern;
- }
- if($_ eq "") {
- die "A pattern is missing in $pFile";
- }
- push @{$current_pattern}, $_;
-
- while(<PFILE>) {
- $patchLineNo ++;
- if($_ =~ m|^===|) {
- last;
- }
- if($_ =~ m%^\|\|\|%) {
- # This is an alternate pattern
- push @all_patterns, $current_pattern;
- $current_pattern = [];
- next;
- }
- push @{$current_pattern}, $_;
- }
- AfterPattern:
- # Finish off the last pattern
- push @all_patterns, $current_pattern;
- if($_ !~ m|^===|) {
- die "No separator found after pattern in $pFile";
- }
- $patchStartLine = $patchLineNo + 1;
- my $replacement = "";
- # If we have more than one non-optional pattern with no group
- # specified, then create a group
- if(@all_patterns > 1 &&
- ! defined $valueflags{group} &&
- ! defined $valueflags{optional}) {
- $valueflags{group} = $pFile . "_$patchStartLine";
- }
- while(<PFILE>) {
- $patchLineNo ++;
- if($_ =~ m|^>>>|) {
- # For each alternate pattern
- my $patt;
- foreach $patt (@all_patterns) {
- # Maybe the @__pattern__@ string appears in the replacement
- my $pattern_repl = join('', @{$patt});
- my $nrlines = int(@{$patt});
- my $local_repl = $replacement;
- $local_repl =~ s/\@__pattern__\@/$pattern_repl/g;
- # Strip the spaces from patterns
- my @pattern_no_space = ();
- my $i;
- foreach $i (@{$patt}) {
- $i =~ s/\s+//g;
- push @pattern_no_space, $i;
- }
- push @patches, { HEAD => $pattern_no_space[0],
- FLAGS => \%valueflags,
- NRLINES => $nrlines,
- PATTERNS => \@pattern_no_space,
- REPLACE => $local_repl,
- PATCHFILE => $pFile,
- PATCHLINENO => $patchStartLine,
- };
- }
- next NextPattern;
- }
- $replacement .= $_;
- }
- die "Unfinished replacement for pattern in $pFile";
- }
- close(PFILE) ||
- die "Cannot close patch file $pFile\n";
- print "Loaded patches from $pFile\n";
- # print Dumper(\@patches); die "Here\n";
-
-}
-
-sub trimSpaces {
- my($str) = @_;
- if($str =~ m|^\s+(\S.*)$|) {
- $str = $1;
- }
- if($str =~ m|^(.*\S)\s+$|) {
- $str = $1;
- }
- return $str;
-}
-
-
-my @includeReadAhead = ();
-sub readIncludeLine {
- my($infile) = @_;
- if($#includeReadAhead < 0) {
- my $newLine = <$infile>;
- return $newLine;
- } else {
- return shift @includeReadAhead;
- }
-}
-
-sub undoReadIncludeLine {
- my($line) = @_;
- push @includeReadAhead, $line;
-}
-
-sub applyPatches {
- my($in, $out) = @_;
- # Initialize all the patches
- my $patch;
- # And remember the EOF patches that are applicable here
- my @eof_patches = ();
- foreach $patch (@patches) {
- $patch->{USE} = 1;
- my $infile = $patch->{FLAGS}->{file};
- if(defined $infile && $in !~ m|$infile$|) {
-# print "Will not use patch ",
-# &lineDirective($patch->{PATCHFILE},$patch->{PATCHLINENO});
- $patch->{USE} = 0;
- next;
- }
- # Disable the system specific patterns
- if(defined $patch->{FLAGS}->{system} &&
- $patch->{FLAGS}->{system} ne $::platform) {
- $patch->{USE} = 0;
- next;
- }
- # Disable also (for now) the patches that must be applied at EOF
- if(defined $patch->{FLAGS}->{ateof} ||
- defined $patch->{FLAGS}->{atsof} ||
- defined $patch->{FLAGS}->{disabled} ) {
- $patch->{USE} = 0;
- push @eof_patches, $patch;
- }
-
- }
-
- open(OUT, ">$out") || die "Cannot open patch output file $out";
- open(IN, "<$in") || die "Cannot open patch input file $in";
-
- @includeReadAhead = ();
-
- my $lineno = 0;
- my $line; # The current line
-
- # the file name that should be printed in the line directives
- my $lineDirectiveFile = $in;
- # Now apply the SOF patches
- foreach my $patch (@eof_patches) {
- if(defined $patch->{FLAGS}->{atsof}) {
- my $line = &applyOnePatch($patch, &lineDirective($in, $lineno));
- print OUT $line;
- }
- }
-
- while($line = &readIncludeLine(\*IN)) {
- $lineno ++;
- # Now we have a line to print out. See if it needs patching
- my $patch;
- my @lines = ($line); # A number of lines
- my $nrLines = 1; # How many lines
- my $toundo = 0;
- NextPatch:
- foreach $patch (@patches) {
- if(! $patch->{USE}) { next; } # We are not using this patch
- my $line_no_spaces = $line;
- $line_no_spaces =~ s/\s+//g;
- if($line_no_spaces eq $patch->{HEAD}) {
- # Now see if all the lines match
- my $patNrLines = $patch->{NRLINES};
- if($patNrLines > 1) {
- # Make sure we have enough lines
- while($nrLines < $patNrLines) {
- push @lines, &readIncludeLine(\*IN);
- $nrLines ++;
- $toundo ++;
- }
- my @checkLines = @{$patch->{PATTERNS}};
- my $i;
- # print "check: ", join(":", @checkLines);
- # print "with $nrLines lines: ", join("+", @lines);
- for($i=0;$i<$patNrLines;$i++) {
- $line_no_spaces = $lines[$i];
- $line_no_spaces =~ s/\s+//g;
- if($checkLines[$i] ne $line_no_spaces) {
- # print "No match for $patch->{HEAD}\n";
- next NextPatch;
- }
- }
- }
- # print "Using patch from $patch->{PATCHFILE}:$patch->{PATCHLINENO} at $in:$lineno\n";
- # Now replace
- $lineno += ($patNrLines - 1);
- $toundo -= ($patNrLines - 1);
- $line = &applyOnePatch($patch, &lineDirective($in, $lineno + 1));
- last;
- }
- }
- print OUT $line;
- # Now undo all but the first line
- my $i;
- for($i=$nrLines - $toundo;$i<$nrLines;$i++) {
- &undoReadIncludeLine($lines[$i]);
- }
- }
- close(IN) || die "Cannot close file $in";
- # Now apply the EOF patches
- foreach $patch (@eof_patches) {
- if(defined $patch->{FLAGS}->{ateof}) {
- my $line = &applyOnePatch($patch, &lineDirective($in, $lineno));
- print OUT $line;
- }
- }
-
- close(OUT);
- return 1;
-}
-
-
-sub applyOnePatch {
- my($patch, $after) = @_;
- my $line = &lineDirective($patch->{PATCHFILE},
- $patch->{PATCHLINENO});
- $line .= $patch->{REPLACE};
- $line .= $after;
- # Mark that we have used this group
- $patch->{USED} = 1;
- if(defined $patch->{FLAGS}->{group}) {
- $groups{$patch->{FLAGS}->{group}} = 1;
- }
- return $line;
-}
diff --git a/cil/bin/patcher.bat.in b/cil/bin/patcher.bat.in
deleted file mode 100755
index 2e356ae451fdb12da91e9030dea8a8a3f0372282..0000000000000000000000000000000000000000
--- a/cil/bin/patcher.bat.in
+++ /dev/null
@@ -1 +0,0 @@
-perl @CILHOME@/bin/patcher %*
diff --git a/cil/bin/teetwo b/cil/bin/teetwo
deleted file mode 100755
index 2aa68fa5ea1034a40d7dba652d433f21405a1d24..0000000000000000000000000000000000000000
--- a/cil/bin/teetwo
+++ /dev/null
@@ -1,36 +0,0 @@
-#!/bin/bash
-# run a command, sending stdout to one file and stderr to another,
-# but also sending both to this process' stdout/stderr, respectively
-
-if [ "$3" = "" ]; then
- echo "usage: $0 stdout-file stderr-file cmd [args..]"
- exit 0
-fi
-
-stdoutFile="$1"
-stderrFile="$2"
-command="$3"
-shift
-shift
-shift
-
-result=0
-handler() {
- # this signal means the underlying command exit erroneously,
- # though we don't know the code
- echo "The command failed!"
- result=2
-}
-trap handler SIGUSR1
-
-# dup my stdout/err on fd 3,4
-exec 3>&1
-exec 4>&2
-
-
-# run the command with tees to duplicate the data
-mypid=$$
-# echo "mypid = $mypid, command=$command, args=$@, stdout=$stdoutFile, stderr=$stderrFile"
-(("$command" "$@" || kill -s USR1 $mypid) | tee "$stdoutFile" >&3) 2>&1 | tee "$stderrFile" >&4
-
-exit $result
diff --git a/cil/bin/test-bad b/cil/bin/test-bad
deleted file mode 100755
index 4eacdc00644f4d0d26b1759e395140ad1cc14ec2..0000000000000000000000000000000000000000
--- a/cil/bin/test-bad
+++ /dev/null
@@ -1,202 +0,0 @@
-#!/bin/sh
-# run a regression test containing one or more intentional failures
-#
-# To create a source file to be processed by this script do the following:
-# - the file should be a standalone program with main without any arguments
-# You can add other files as part of the CFLAGS variable
-# - add a comment
-# // NUMERRORS n
-# where n is the number of errors to be tested by this file
-#
-# This file is processed n+1 times. The first time, it should succeed (main returns or
-# exits with code 0) and the other n times it should fail.
-# For each run the preprocessor variable ERROR is defined to be
-# be k (0 <= k <= n).
-# You can mark certain lines in your program so that they are used ONLY in a certain run: put the
-# following comment after a line to make it appear only in the run with ERROR == 3
-#
-# some_code; // ERROR(3)
-#
-#
-# Furthermore, for each run that is intended to fail you can specify a string that
-# must appear in the output.
-#
-# some_code; // ERROR(3):this string must appear in output
-#
-# Do not put any spaces around the :
-#
-# Simple example:
-#
-# #define E(n) {printf("Error %d\n", n); exit(n); }
-# #define SUCCESS {printf("Success\n"); exit(0); }
-#
-# // NUMERRORS 3
-# int main() {
-#
-# char char x; // ERROR(1):invalid type specifier
-# int y;
-# int z = ++y;
-# // This conditional should be true
-# if(z == y) E(2); // ERROR(2):Error 2
-#
-# #if ERROR == 3
-# z = (++y, y--);
-# if(z == y + 1) E(3); // ERROR(3):Error 3
-# #endif
-#
-# SUCCESS;
-# }
-#
-#
-# set RUNONLY=n to run only the test case n
-#
-
-if [ "$1" = "" ]; then
- # most parameters are passed by name, instead of as positional
- # arguments, for better impedance match with Makefile; but it's
- # good to have at least 1 positional arg so when it's missing I
- # can easily tell, and print this message
- echo "usage: CILHOME=... CILLY=... CFLAGS=... $0 source-file.c"
- echo "You can also set RUNONLY=n to run only the nth iteration"
- exit 0
-fi
-echo "CILLY=$CILLY"
-echo "CFLAGS=$CFLAGS"
-srcfile="$1"
-# Construct the name of the temporary file to use
-srcfilenoext=`echo $srcfile | sed s/.c\$//`
-tmpname="$srcfilenoext-tmp"
-
-# for GCC, use "# xx foo.c". For MSVC, use "#line xx foo.c"
-if [ "$_MSVC" != "" ]; then
- LINEOPT="line"
- OUTFLAG="/Fe"
- OUTEXT=".exe"
-else
- LINEOPT=""
- OUTFLAG="-o "
- OUTEXT=".exe" # So that I can delete the executables
-fi
-
-# Start it in the right directory
-# cd "$CILLYHOME/test/small2" || exit
-
-# read how many failure cases are in the file; expect line of form
-# "// NUMERRORS n"
-numcases=`grep NUMERRORS "$srcfile" | perl -e '$_ = <>; m|(\d+)|; print $1;'`
-if [ -z "$numcases" ]; then
- echo "didn't find a string of form NUMERRORS <n> in the file"
- exit 2
-fi
-echo "there are $numcases failure cases in this file"
-
-
-# iterate through the cases; first case (0) is where no errors are present
-i=0
-if [ "$RUNONLY" != "" ] ;then
- i=$RUNONLY
-fi
-while [ $i -le $numcases ]; do
- echo
- echo
- echo "********************** Iteration $i"
- echo
- echo
- # generate a temporary file; first hide the ERROR tags which identify
- # the current test, then remove all remaining ERROR lines
- # (syntax for errors has parentheses so if I have >=10 cases I don't
- # run into problems where e.g. ERROR1 is a substring of ERROR10)
- # use the little perl script to put line number directives where we remove
- # lines
- echo "generating test $i"
- rm -f $tmpname.c 2>/dev/null
- ( echo "#define ERROR $i"; echo "#$LINEOPT 1 \"$srcfile\"";cat "$srcfile") |\
- sed "s|ERROR($i)|(selected: $i)|" | \
- perl -e 'my $ln = 0; while(<>) { if($_ =~ m|ERROR\(|) { print "#'$LINEOPT' $ln\n"; } else { print $_; }; $ln ++}' \
- > "$tmpname.c"
- chmod a-w "$tmpname.c"
-
- # Grab the errorline for this test case
- themsg=`cat "$srcfile" | grep "ERROR($i).*:" | sed "s/^.*ERROR.*://" `
- if [ "x$themsg" != "x" ] ;then
- echo "Expecting error message:$themsg"
- fi
-
- # compile this with our tool
- rm -f test-bad.out test-bad.err ${tmpname}$OUTEXT
- echo $CILLY $CFLAGS $tmpname.c ${OUTFLAG}${tmpname}$OUTEXT
- $CILHOME/bin/teetwo test-bad.out test-bad.err \
- $CILLY $CFLAGS -DERROR=$i $tmpname.c ${OUTFLAG}${tmpname}$OUTEXT
- # cat test-bad.out test-bad.err
- status=$?
- runit=1
- if [ $status != 0 ]; then
- if [ $i = 0 ] ;then
- echo "The 0th iteration failed to CURE! It is supposed to succeed."
- exit $status
- else
- if [ "x$themsg" != "x" ] ;then
- echo "grep \"$themsg\" test-bad.out test-bad.err"
- if ! grep "$themsg" test-bad.out test-bad.err ;then
- echo "The ${i}th iteration failed to CURE but cannot find: $themsg"
- exit 3
- else
- echo "The ${i}th iteration failed to CURE, as expected!"
- fi
- else
- echo "The ${i}th iteration failed to CURE. We expected some failure!"
- fi
- runit=0
- fi
- fi
-
- # run it
- if [ $runit != 0 ]; then
- echo "./$tmpname$OUTEXT"
- rm -f test-bad.out test-bad.err
- if $CILHOME/bin/teetwo test-bad.out test-bad.err ./$tmpname$OUTEXT ; then
- # cat test-bad.out test-bad.err
- if [ $i = 0 ]; then
- # expected success on 0th iteration
- echo "(succeeded as expected)"
- else
- # unexpected success on >0th iteration
- echo "The ${i}th iteration did not fail! It is supposed to fail."
- exit 2
- fi
- else
- # cat test-bad.out test-bad.err
- if [ $i = 0 ]; then
- # unexpected failure on 0th iteration
- echo "The 0th iteration failed! It is supposed to succeed."
- #cat $tmpname.c
- exit 2
- else
- # expected failure on >0th iteration
- if [ "x$themsg" != "x" ] ;then
- echo "grep \"$themsg\" test-bad.out test-bad.err"
- if ! grep "$themsg" test-bad.out test-bad.err ;then
- echo "The ${i}th iteration failed but cannot find:$themsg"
- exit 3
- fi
- fi
- echo "(failed as expected)"
- fi
- fi
- fi
-
- # possibly bail after 0th
- if [ "$TESTBADONCE" != "" ]; then
- echo "bailing after 0th iteration because TESTBADONCE is set"
- exit 0
- fi
- if [ "$RUNONLY" != "" ]; then
- echo "bailing after ${RUNONLY}th iteration because RUNONLY is set"
- exit 0
- fi
-
- i=`expr $i + 1`
-done
-
-echo "all $numcases cases in $srcfile failed as expected"
-
diff --git a/cil/cil.spec b/cil/cil.spec
deleted file mode 100644
index 53809736363d9ccbf9ac3162a4d0461b74905b4e..0000000000000000000000000000000000000000
--- a/cil/cil.spec
+++ /dev/null
@@ -1,90 +0,0 @@
-Name: cil
-Version: 1.3.5
-Release: 1
-License: BSD
-URL: http://manju.cs.berkeley.edu/cil/
-Source0: %{name}-%{version}.tar.gz
-BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-buildroot
-BuildRequires: gcc
-BuildRequires: ocaml >= 3.08
-BuildRequires: perl >= 5.6.1
-
-# No ELF executables or shared libraries
-%define debug_package %{nil}
-
-
-########################################################################
-#
-# Package cil
-#
-
-Summary: OCaml library for C program analysis and transformation
-Group: Development/Libraries
-Requires: perl >= 5.6.1
-
-%description
-CIL (C Intermediate Language) is a high-level representation along
-with a set of tools that permit easy analysis and source-to-source
-transformation of C programs.
-
-This package provides Perl modules which are useful for building
-compiler wrappers. A wrapper can use CIL to transform C code before
-passing it along to the native C compiler.
-
-%files
-%defattr(-,root,root,-)
-%doc LICENSE
-%{_datadir}/%{name}
-
-
-########################################################################
-#
-# Package cil-devel
-#
-
-%package devel
-
-Summary: OCaml library for C program analysis and transformation
-Group: Development/Libraries
-Requires: ocaml >= 3.04
-
-%description devel
-CIL (C Intermediate Language) is a high-level representation along
-with a set of tools that permit easy analysis and source-to-source
-transformation of C programs.
-
-This package provides OCaml interfaces and an OCaml library which form
-the CIL API.
-
-%files devel
-%defattr(-,root,root,-)
-%doc LICENSE
-%{_libdir}/%{name}
-
-
-########################################################################
-#
-# General scripts
-#
-
-%prep
-%setup -q -n %{name}
-
-%build
-%configure
-%define cilmake make -f Makefile.cil
-%cilmake cilversion machdep
-%cilmake cillib NATIVECAML=
-%cilmake cillib NATIVECAML=1
-
-%install
-rm -rf $RPM_BUILD_ROOT
-%makeinstall
-
-%clean
-rm -rf $RPM_BUILD_ROOT
-
-
-%changelog
-* Tue Aug 5 2003 Ben Liblit <liblit@cs.berkeley.edu>
-- Initial build.
diff --git a/cil/cil.spec.in b/cil/cil.spec.in
deleted file mode 100644
index 0a47dbdd46ac45a051e4832485774fb473eb8ad3..0000000000000000000000000000000000000000
--- a/cil/cil.spec.in
+++ /dev/null
@@ -1,90 +0,0 @@
-Name: cil
-Version: @CIL_VERSION@
-Release: 1
-License: BSD
-URL: http://manju.cs.berkeley.edu/cil/
-Source0: %{name}-%{version}.tar.gz
-BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-buildroot
-BuildRequires: gcc
-BuildRequires: ocaml >= 3.08
-BuildRequires: perl >= 5.6.1
-
-# No ELF executables or shared libraries
-%define debug_package %{nil}
-
-
-########################################################################
-#
-# Package cil
-#
-
-Summary: OCaml library for C program analysis and transformation
-Group: Development/Libraries
-Requires: perl >= 5.6.1
-
-%description
-CIL (C Intermediate Language) is a high-level representation along
-with a set of tools that permit easy analysis and source-to-source
-transformation of C programs.
-
-This package provides Perl modules which are useful for building
-compiler wrappers. A wrapper can use CIL to transform C code before
-passing it along to the native C compiler.
-
-%files
-%defattr(-,root,root,-)
-%doc LICENSE
-%{_datadir}/%{name}
-
-
-########################################################################
-#
-# Package cil-devel
-#
-
-%package devel
-
-Summary: OCaml library for C program analysis and transformation
-Group: Development/Libraries
-Requires: ocaml >= 3.04
-
-%description devel
-CIL (C Intermediate Language) is a high-level representation along
-with a set of tools that permit easy analysis and source-to-source
-transformation of C programs.
-
-This package provides OCaml interfaces and an OCaml library which form
-the CIL API.
-
-%files devel
-%defattr(-,root,root,-)
-%doc LICENSE
-%{_libdir}/%{name}
-
-
-########################################################################
-#
-# General scripts
-#
-
-%prep
-%setup -q -n %{name}
-
-%build
-%configure
-%define cilmake make -f Makefile.cil
-%cilmake cilversion machdep
-%cilmake cillib NATIVECAML=
-%cilmake cillib NATIVECAML=1
-
-%install
-rm -rf $RPM_BUILD_ROOT
-%makeinstall
-
-%clean
-rm -rf $RPM_BUILD_ROOT
-
-
-%changelog
-* Tue Aug 5 2003 Ben Liblit <liblit@cs.berkeley.edu>
-- Initial build.
diff --git a/cil/config.guess b/cil/config.guess
deleted file mode 100755
index c085f4f51a2fe95e532cf168bc5e93f04ac5fdda..0000000000000000000000000000000000000000
--- a/cil/config.guess
+++ /dev/null
@@ -1,1497 +0,0 @@
-#! /bin/sh
-# Attempt to guess a canonical system name.
-# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation,
-# Inc.
-
-timestamp='2006-05-13'
-
-# This file 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.
-#
-# As a special exception to the GNU General Public License, if you
-# distribute this file as part of a program that contains a
-# configuration script generated by Autoconf, you may include it under
-# the same distribution terms that you use for the rest of that program.
-
-
-# Originally written by Per Bothner <per@bothner.com>.
-# Please send patches to <config-patches@gnu.org>. Submit a context
-# diff and a properly formatted ChangeLog entry.
-#
-# This script attempts to guess a canonical system name similar to
-# config.sub. If it succeeds, it prints the system name on stdout, and
-# exits with 0. Otherwise, it exits with 1.
-#
-# The plan is that this can be called by configure scripts if you
-# don't specify an explicit build system type.
-
-me=`echo "$0" | sed -e 's,.*/,,'`
-
-usage="\
-Usage: $0 [OPTION]
-
-Output the configuration name of the system \`$me' is run on.
-
-Operation modes:
- -h, --help print this help, then exit
- -t, --time-stamp print date of last modification, then exit
- -v, --version print version number, then exit
-
-Report bugs and patches to <config-patches@gnu.org>."
-
-version="\
-GNU config.guess ($timestamp)
-
-Originally written by Per Bothner.
-Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
-Free Software Foundation, Inc.
-
-This is free software; see the source for copying conditions. There is NO
-warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
-
-help="
-Try \`$me --help' for more information."
-
-# Parse command line
-while test $# -gt 0 ; do
- case $1 in
- --time-stamp | --time* | -t )
- echo "$timestamp" ; exit ;;
- --version | -v )
- echo "$version" ; exit ;;
- --help | --h* | -h )
- echo "$usage"; exit ;;
- -- ) # Stop option processing
- shift; break ;;
- - ) # Use stdin as input.
- break ;;
- -* )
- echo "$me: invalid option $1$help" >&2
- exit 1 ;;
- * )
- break ;;
- esac
-done
-
-if test $# != 0; then
- echo "$me: too many arguments$help" >&2
- exit 1
-fi
-
-trap 'exit 1' 1 2 15
-
-# CC_FOR_BUILD -- compiler used by this script. Note that the use of a
-# compiler to aid in system detection is discouraged as it requires
-# temporary files to be created and, as you can see below, it is a
-# headache to deal with in a portable fashion.
-
-# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still
-# use `HOST_CC' if defined, but it is deprecated.
-
-# Portable tmp directory creation inspired by the Autoconf team.
-
-set_cc_for_build='
-trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ;
-trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ;
-: ${TMPDIR=/tmp} ;
- { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
- { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } ||
- { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } ||
- { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ;
-dummy=$tmp/dummy ;
-tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ;
-case $CC_FOR_BUILD,$HOST_CC,$CC in
- ,,) echo "int x;" > $dummy.c ;
- for c in cc gcc c89 c99 ; do
- if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then
- CC_FOR_BUILD="$c"; break ;
- fi ;
- done ;
- if test x"$CC_FOR_BUILD" = x ; then
- CC_FOR_BUILD=no_compiler_found ;
- fi
- ;;
- ,,*) CC_FOR_BUILD=$CC ;;
- ,*,*) CC_FOR_BUILD=$HOST_CC ;;
-esac ; set_cc_for_build= ;'
-
-# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
-# (ghazi@noc.rutgers.edu 1994-08-24)
-if (test -f /.attbin/uname) >/dev/null 2>&1 ; then
- PATH=$PATH:/.attbin ; export PATH
-fi
-
-UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown
-UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
-UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown
-UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
-
-# Note: order is significant - the case branches are not exclusive.
-
-case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
- *:NetBSD:*:*)
- # NetBSD (nbsd) targets should (where applicable) match one or
- # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*,
- # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently
- # switched to ELF, *-*-netbsd* would select the old
- # object file format. This provides both forward
- # compatibility and a consistent mechanism for selecting the
- # object file format.
- #
- # Note: NetBSD doesn't particularly care about the vendor
- # portion of the name. We always set it to "unknown".
- sysctl="sysctl -n hw.machine_arch"
- UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \
- /usr/sbin/$sysctl 2>/dev/null || echo unknown)`
- case "${UNAME_MACHINE_ARCH}" in
- armeb) machine=armeb-unknown ;;
- arm*) machine=arm-unknown ;;
- sh3el) machine=shl-unknown ;;
- sh3eb) machine=sh-unknown ;;
- *) machine=${UNAME_MACHINE_ARCH}-unknown ;;
- esac
- # The Operating System including object format, if it has switched
- # to ELF recently, or will in the future.
- case "${UNAME_MACHINE_ARCH}" in
- arm*|i386|m68k|ns32k|sh3*|sparc|vax)
- eval $set_cc_for_build
- if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \
- | grep __ELF__ >/dev/null
- then
- # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout).
- # Return netbsd for either. FIX?
- os=netbsd
- else
- os=netbsdelf
- fi
- ;;
- *)
- os=netbsd
- ;;
- esac
- # The OS release
- # Debian GNU/NetBSD machines have a different userland, and
- # thus, need a distinct triplet. However, they do not need
- # kernel version information, so it can be replaced with a
- # suitable tag, in the style of linux-gnu.
- case "${UNAME_VERSION}" in
- Debian*)
- release='-gnu'
- ;;
- *)
- release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
- ;;
- esac
- # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:
- # contains redundant information, the shorter form:
- # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.
- echo "${machine}-${os}${release}"
- exit ;;
- *:OpenBSD:*:*)
- UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`
- echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE}
- exit ;;
- *:ekkoBSD:*:*)
- echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE}
- exit ;;
- *:SolidBSD:*:*)
- echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE}
- exit ;;
- macppc:MirBSD:*:*)
- echo powerppc-unknown-mirbsd${UNAME_RELEASE}
- exit ;;
- *:MirBSD:*:*)
- echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE}
- exit ;;
- alpha:OSF1:*:*)
- case $UNAME_RELEASE in
- *4.0)
- UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`
- ;;
- *5.*)
- UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'`
- ;;
- esac
- # According to Compaq, /usr/sbin/psrinfo has been available on
- # OSF/1 and Tru64 systems produced since 1995. I hope that
- # covers most systems running today. This code pipes the CPU
- # types through head -n 1, so we only detect the type of CPU 0.
- ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1`
- case "$ALPHA_CPU_TYPE" in
- "EV4 (21064)")
- UNAME_MACHINE="alpha" ;;
- "EV4.5 (21064)")
- UNAME_MACHINE="alpha" ;;
- "LCA4 (21066/21068)")
- UNAME_MACHINE="alpha" ;;
- "EV5 (21164)")
- UNAME_MACHINE="alphaev5" ;;
- "EV5.6 (21164A)")
- UNAME_MACHINE="alphaev56" ;;
- "EV5.6 (21164PC)")
- UNAME_MACHINE="alphapca56" ;;
- "EV5.7 (21164PC)")
- UNAME_MACHINE="alphapca57" ;;
- "EV6 (21264)")
- UNAME_MACHINE="alphaev6" ;;
- "EV6.7 (21264A)")
- UNAME_MACHINE="alphaev67" ;;
- "EV6.8CB (21264C)")
- UNAME_MACHINE="alphaev68" ;;
- "EV6.8AL (21264B)")
- UNAME_MACHINE="alphaev68" ;;
- "EV6.8CX (21264D)")
- UNAME_MACHINE="alphaev68" ;;
- "EV6.9A (21264/EV69A)")
- UNAME_MACHINE="alphaev69" ;;
- "EV7 (21364)")
- UNAME_MACHINE="alphaev7" ;;
- "EV7.9 (21364A)")
- UNAME_MACHINE="alphaev79" ;;
- esac
- # A Pn.n version is a patched version.
- # A Vn.n version is a released version.
- # A Tn.n version is a released field test version.
- # A Xn.n version is an unreleased experimental baselevel.
- # 1.2 uses "1.2" for uname -r.
- echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
- exit ;;
- Alpha\ *:Windows_NT*:*)
- # How do we know it's Interix rather than the generic POSIX subsystem?
- # Should we change UNAME_MACHINE based on the output of uname instead
- # of the specific Alpha model?
- echo alpha-pc-interix
- exit ;;
- 21064:Windows_NT:50:3)
- echo alpha-dec-winnt3.5
- exit ;;
- Amiga*:UNIX_System_V:4.0:*)
- echo m68k-unknown-sysv4
- exit ;;
- *:[Aa]miga[Oo][Ss]:*:*)
- echo ${UNAME_MACHINE}-unknown-amigaos
- exit ;;
- *:[Mm]orph[Oo][Ss]:*:*)
- echo ${UNAME_MACHINE}-unknown-morphos
- exit ;;
- *:OS/390:*:*)
- echo i370-ibm-openedition
- exit ;;
- *:z/VM:*:*)
- echo s390-ibm-zvmoe
- exit ;;
- *:OS400:*:*)
- echo powerpc-ibm-os400
- exit ;;
- arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
- echo arm-acorn-riscix${UNAME_RELEASE}
- exit ;;
- arm:riscos:*:*|arm:RISCOS:*:*)
- echo arm-unknown-riscos
- exit ;;
- SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)
- echo hppa1.1-hitachi-hiuxmpp
- exit ;;
- Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)
- # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
- if test "`(/bin/universe) 2>/dev/null`" = att ; then
- echo pyramid-pyramid-sysv3
- else
- echo pyramid-pyramid-bsd
- fi
- exit ;;
- NILE*:*:*:dcosx)
- echo pyramid-pyramid-svr4
- exit ;;
- DRS?6000:unix:4.0:6*)
- echo sparc-icl-nx6
- exit ;;
- DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*)
- case `/usr/bin/uname -p` in
- sparc) echo sparc-icl-nx7; exit ;;
- esac ;;
- sun4H:SunOS:5.*:*)
- echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
- exit ;;
- sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
- echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
- exit ;;
- i86pc:SunOS:5.*:*)
- echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
- exit ;;
- sun4*:SunOS:6*:*)
- # According to config.sub, this is the proper way to canonicalize
- # SunOS6. Hard to guess exactly what SunOS6 will be like, but
- # it's likely to be more like Solaris than SunOS4.
- echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
- exit ;;
- sun4*:SunOS:*:*)
- case "`/usr/bin/arch -k`" in
- Series*|S4*)
- UNAME_RELEASE=`uname -v`
- ;;
- esac
- # Japanese Language versions have a version number like `4.1.3-JL'.
- echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`
- exit ;;
- sun3*:SunOS:*:*)
- echo m68k-sun-sunos${UNAME_RELEASE}
- exit ;;
- sun*:*:4.2BSD:*)
- UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`
- test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3
- case "`/bin/arch`" in
- sun3)
- echo m68k-sun-sunos${UNAME_RELEASE}
- ;;
- sun4)
- echo sparc-sun-sunos${UNAME_RELEASE}
- ;;
- esac
- exit ;;
- aushp:SunOS:*:*)
- echo sparc-auspex-sunos${UNAME_RELEASE}
- exit ;;
- # The situation for MiNT is a little confusing. The machine name
- # can be virtually everything (everything which is not
- # "atarist" or "atariste" at least should have a processor
- # > m68000). The system name ranges from "MiNT" over "FreeMiNT"
- # to the lowercase version "mint" (or "freemint"). Finally
- # the system name "TOS" denotes a system which is actually not
- # MiNT. But MiNT is downward compatible to TOS, so this should
- # be no problem.
- atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)
- echo m68k-atari-mint${UNAME_RELEASE}
- exit ;;
- atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
- echo m68k-atari-mint${UNAME_RELEASE}
- exit ;;
- *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
- echo m68k-atari-mint${UNAME_RELEASE}
- exit ;;
- milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
- echo m68k-milan-mint${UNAME_RELEASE}
- exit ;;
- hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
- echo m68k-hades-mint${UNAME_RELEASE}
- exit ;;
- *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
- echo m68k-unknown-mint${UNAME_RELEASE}
- exit ;;
- m68k:machten:*:*)
- echo m68k-apple-machten${UNAME_RELEASE}
- exit ;;
- powerpc:machten:*:*)
- echo powerpc-apple-machten${UNAME_RELEASE}
- exit ;;
- RISC*:Mach:*:*)
- echo mips-dec-mach_bsd4.3
- exit ;;
- RISC*:ULTRIX:*:*)
- echo mips-dec-ultrix${UNAME_RELEASE}
- exit ;;
- VAX*:ULTRIX*:*:*)
- echo vax-dec-ultrix${UNAME_RELEASE}
- exit ;;
- 2020:CLIX:*:* | 2430:CLIX:*:*)
- echo clipper-intergraph-clix${UNAME_RELEASE}
- exit ;;
- mips:*:*:UMIPS | mips:*:*:RISCos)
- eval $set_cc_for_build
- sed 's/^ //' << EOF >$dummy.c
-#ifdef __cplusplus
-#include <stdio.h> /* for printf() prototype */
- int main (int argc, char *argv[]) {
-#else
- int main (argc, argv) int argc; char *argv[]; {
-#endif
- #if defined (host_mips) && defined (MIPSEB)
- #if defined (SYSTYPE_SYSV)
- printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);
- #endif
- #if defined (SYSTYPE_SVR4)
- printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);
- #endif
- #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
- printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);
- #endif
- #endif
- exit (-1);
- }
-EOF
- $CC_FOR_BUILD -o $dummy $dummy.c &&
- dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` &&
- SYSTEM_NAME=`$dummy $dummyarg` &&
- { echo "$SYSTEM_NAME"; exit; }
- echo mips-mips-riscos${UNAME_RELEASE}
- exit ;;
- Motorola:PowerMAX_OS:*:*)
- echo powerpc-motorola-powermax
- exit ;;
- Motorola:*:4.3:PL8-*)
- echo powerpc-harris-powermax
- exit ;;
- Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*)
- echo powerpc-harris-powermax
- exit ;;
- Night_Hawk:Power_UNIX:*:*)
- echo powerpc-harris-powerunix
- exit ;;
- m88k:CX/UX:7*:*)
- echo m88k-harris-cxux7
- exit ;;
- m88k:*:4*:R4*)
- echo m88k-motorola-sysv4
- exit ;;
- m88k:*:3*:R3*)
- echo m88k-motorola-sysv3
- exit ;;
- AViiON:dgux:*:*)
- # DG/UX returns AViiON for all architectures
- UNAME_PROCESSOR=`/usr/bin/uname -p`
- if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ]
- then
- if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \
- [ ${TARGET_BINARY_INTERFACE}x = x ]
- then
- echo m88k-dg-dgux${UNAME_RELEASE}
- else
- echo m88k-dg-dguxbcs${UNAME_RELEASE}
- fi
- else
- echo i586-dg-dgux${UNAME_RELEASE}
- fi
- exit ;;
- M88*:DolphinOS:*:*) # DolphinOS (SVR3)
- echo m88k-dolphin-sysv3
- exit ;;
- M88*:*:R3*:*)
- # Delta 88k system running SVR3
- echo m88k-motorola-sysv3
- exit ;;
- XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
- echo m88k-tektronix-sysv3
- exit ;;
- Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
- echo m68k-tektronix-bsd
- exit ;;
- *:IRIX*:*:*)
- echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`
- exit ;;
- ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
- echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id
- exit ;; # Note that: echo "'`uname -s`'" gives 'AIX '
- i*86:AIX:*:*)
- echo i386-ibm-aix
- exit ;;
- ia64:AIX:*:*)
- if [ -x /usr/bin/oslevel ] ; then
- IBM_REV=`/usr/bin/oslevel`
- else
- IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}
- fi
- echo ${UNAME_MACHINE}-ibm-aix${IBM_REV}
- exit ;;
- *:AIX:2:3)
- if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
- eval $set_cc_for_build
- sed 's/^ //' << EOF >$dummy.c
- #include <sys/systemcfg.h>
-
- main()
- {
- if (!__power_pc())
- exit(1);
- puts("powerpc-ibm-aix3.2.5");
- exit(0);
- }
-EOF
- if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy`
- then
- echo "$SYSTEM_NAME"
- else
- echo rs6000-ibm-aix3.2.5
- fi
- elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
- echo rs6000-ibm-aix3.2.4
- else
- echo rs6000-ibm-aix3.2
- fi
- exit ;;
- *:AIX:*:[45])
- IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'`
- if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then
- IBM_ARCH=rs6000
- else
- IBM_ARCH=powerpc
- fi
- if [ -x /usr/bin/oslevel ] ; then
- IBM_REV=`/usr/bin/oslevel`
- else
- IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}
- fi
- echo ${IBM_ARCH}-ibm-aix${IBM_REV}
- exit ;;
- *:AIX:*:*)
- echo rs6000-ibm-aix
- exit ;;
- ibmrt:4.4BSD:*|romp-ibm:BSD:*)
- echo romp-ibm-bsd4.4
- exit ;;
- ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and
- echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to
- exit ;; # report: romp-ibm BSD 4.3
- *:BOSX:*:*)
- echo rs6000-bull-bosx
- exit ;;
- DPX/2?00:B.O.S.:*:*)
- echo m68k-bull-sysv3
- exit ;;
- 9000/[34]??:4.3bsd:1.*:*)
- echo m68k-hp-bsd
- exit ;;
- hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
- echo m68k-hp-bsd4.4
- exit ;;
- 9000/[34678]??:HP-UX:*:*)
- HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
- case "${UNAME_MACHINE}" in
- 9000/31? ) HP_ARCH=m68000 ;;
- 9000/[34]?? ) HP_ARCH=m68k ;;
- 9000/[678][0-9][0-9])
- if [ -x /usr/bin/getconf ]; then
- sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`
- sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`
- case "${sc_cpu_version}" in
- 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0
- 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1
- 532) # CPU_PA_RISC2_0
- case "${sc_kernel_bits}" in
- 32) HP_ARCH="hppa2.0n" ;;
- 64) HP_ARCH="hppa2.0w" ;;
- '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20
- esac ;;
- esac
- fi
- if [ "${HP_ARCH}" = "" ]; then
- eval $set_cc_for_build
- sed 's/^ //' << EOF >$dummy.c
-
- #define _HPUX_SOURCE
- #include <stdlib.h>
- #include <unistd.h>
-
- int main ()
- {
- #if defined(_SC_KERNEL_BITS)
- long bits = sysconf(_SC_KERNEL_BITS);
- #endif
- long cpu = sysconf (_SC_CPU_VERSION);
-
- switch (cpu)
- {
- case CPU_PA_RISC1_0: puts ("hppa1.0"); break;
- case CPU_PA_RISC1_1: puts ("hppa1.1"); break;
- case CPU_PA_RISC2_0:
- #if defined(_SC_KERNEL_BITS)
- switch (bits)
- {
- case 64: puts ("hppa2.0w"); break;
- case 32: puts ("hppa2.0n"); break;
- default: puts ("hppa2.0"); break;
- } break;
- #else /* !defined(_SC_KERNEL_BITS) */
- puts ("hppa2.0"); break;
- #endif
- default: puts ("hppa1.0"); break;
- }
- exit (0);
- }
-EOF
- (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy`
- test -z "$HP_ARCH" && HP_ARCH=hppa
- fi ;;
- esac
- if [ ${HP_ARCH} = "hppa2.0w" ]
- then
- eval $set_cc_for_build
-
- # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating
- # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler
- # generating 64-bit code. GNU and HP use different nomenclature:
- #
- # $ CC_FOR_BUILD=cc ./config.guess
- # => hppa2.0w-hp-hpux11.23
- # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess
- # => hppa64-hp-hpux11.23
-
- if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) |
- grep __LP64__ >/dev/null
- then
- HP_ARCH="hppa2.0w"
- else
- HP_ARCH="hppa64"
- fi
- fi
- echo ${HP_ARCH}-hp-hpux${HPUX_REV}
- exit ;;
- ia64:HP-UX:*:*)
- HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
- echo ia64-hp-hpux${HPUX_REV}
- exit ;;
- 3050*:HI-UX:*:*)
- eval $set_cc_for_build
- sed 's/^ //' << EOF >$dummy.c
- #include <unistd.h>
- int
- main ()
- {
- long cpu = sysconf (_SC_CPU_VERSION);
- /* The order matters, because CPU_IS_HP_MC68K erroneously returns
- true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct
- results, however. */
- if (CPU_IS_PA_RISC (cpu))
- {
- switch (cpu)
- {
- case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;
- case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;
- case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;
- default: puts ("hppa-hitachi-hiuxwe2"); break;
- }
- }
- else if (CPU_IS_HP_MC68K (cpu))
- puts ("m68k-hitachi-hiuxwe2");
- else puts ("unknown-hitachi-hiuxwe2");
- exit (0);
- }
-EOF
- $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` &&
- { echo "$SYSTEM_NAME"; exit; }
- echo unknown-hitachi-hiuxwe2
- exit ;;
- 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* )
- echo hppa1.1-hp-bsd
- exit ;;
- 9000/8??:4.3bsd:*:*)
- echo hppa1.0-hp-bsd
- exit ;;
- *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*)
- echo hppa1.0-hp-mpeix
- exit ;;
- hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* )
- echo hppa1.1-hp-osf
- exit ;;
- hp8??:OSF1:*:*)
- echo hppa1.0-hp-osf
- exit ;;
- i*86:OSF1:*:*)
- if [ -x /usr/sbin/sysversion ] ; then
- echo ${UNAME_MACHINE}-unknown-osf1mk
- else
- echo ${UNAME_MACHINE}-unknown-osf1
- fi
- exit ;;
- parisc*:Lites*:*:*)
- echo hppa1.1-hp-lites
- exit ;;
- C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
- echo c1-convex-bsd
- exit ;;
- C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
- if getsysinfo -f scalar_acc
- then echo c32-convex-bsd
- else echo c2-convex-bsd
- fi
- exit ;;
- C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
- echo c34-convex-bsd
- exit ;;
- C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
- echo c38-convex-bsd
- exit ;;
- C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
- echo c4-convex-bsd
- exit ;;
- CRAY*Y-MP:*:*:*)
- echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
- exit ;;
- CRAY*[A-Z]90:*:*:*)
- echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \
- | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \
- -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \
- -e 's/\.[^.]*$/.X/'
- exit ;;
- CRAY*TS:*:*:*)
- echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
- exit ;;
- CRAY*T3E:*:*:*)
- echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
- exit ;;
- CRAY*SV1:*:*:*)
- echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
- exit ;;
- *:UNICOS/mp:*:*)
- echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
- exit ;;
- F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)
- FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
- FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
- FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'`
- echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
- exit ;;
- 5000:UNIX_System_V:4.*:*)
- FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
- FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'`
- echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
- exit ;;
- i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
- echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE}
- exit ;;
- sparc*:BSD/OS:*:*)
- echo sparc-unknown-bsdi${UNAME_RELEASE}
- exit ;;
- *:BSD/OS:*:*)
- echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
- exit ;;
- *:FreeBSD:*:*)
- case ${UNAME_MACHINE} in
- pc98)
- echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
- amd64)
- echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
- *)
- echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
- esac
- exit ;;
- i*:CYGWIN*:*)
- echo ${UNAME_MACHINE}-pc-cygwin
- exit ;;
- i*:MINGW*:*)
- echo ${UNAME_MACHINE}-pc-mingw32
- exit ;;
- i*:windows32*:*)
- # uname -m includes "-pc" on this system.
- echo ${UNAME_MACHINE}-mingw32
- exit ;;
- i*:PW*:*)
- echo ${UNAME_MACHINE}-pc-pw32
- exit ;;
- x86:Interix*:[345]*)
- echo i586-pc-interix${UNAME_RELEASE}
- exit ;;
- EM64T:Interix*:[345]*)
- echo x86_64-unknown-interix${UNAME_RELEASE}
- exit ;;
- [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*)
- echo i${UNAME_MACHINE}-pc-mks
- exit ;;
- i*:Windows_NT*:* | Pentium*:Windows_NT*:*)
- # How do we know it's Interix rather than the generic POSIX subsystem?
- # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we
- # UNAME_MACHINE based on the output of uname instead of i386?
- echo i586-pc-interix
- exit ;;
- i*:UWIN*:*)
- echo ${UNAME_MACHINE}-pc-uwin
- exit ;;
- amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*)
- echo x86_64-unknown-cygwin
- exit ;;
- p*:CYGWIN*:*)
- echo powerpcle-unknown-cygwin
- exit ;;
- prep*:SunOS:5.*:*)
- echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
- exit ;;
- *:GNU:*:*)
- # the GNU system
- echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
- exit ;;
- *:GNU/*:*:*)
- # other systems with GNU libc and userland
- echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu
- exit ;;
- i*86:Minix:*:*)
- echo ${UNAME_MACHINE}-pc-minix
- exit ;;
- arm*:Linux:*:*)
- echo ${UNAME_MACHINE}-unknown-linux-gnu
- exit ;;
- cris:Linux:*:*)
- echo cris-axis-linux-gnu
- exit ;;
- crisv32:Linux:*:*)
- echo crisv32-axis-linux-gnu
- exit ;;
- frv:Linux:*:*)
- echo frv-unknown-linux-gnu
- exit ;;
- ia64:Linux:*:*)
- echo ${UNAME_MACHINE}-unknown-linux-gnu
- exit ;;
- m32r*:Linux:*:*)
- echo ${UNAME_MACHINE}-unknown-linux-gnu
- exit ;;
- m68*:Linux:*:*)
- echo ${UNAME_MACHINE}-unknown-linux-gnu
- exit ;;
- mips:Linux:*:*)
- eval $set_cc_for_build
- sed 's/^ //' << EOF >$dummy.c
- #undef CPU
- #undef mips
- #undef mipsel
- #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
- CPU=mipsel
- #else
- #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
- CPU=mips
- #else
- CPU=
- #endif
- #endif
-EOF
- eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
- /^CPU/{
- s: ::g
- p
- }'`"
- test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }
- ;;
- mips64:Linux:*:*)
- eval $set_cc_for_build
- sed 's/^ //' << EOF >$dummy.c
- #undef CPU
- #undef mips64
- #undef mips64el
- #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
- CPU=mips64el
- #else
- #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
- CPU=mips64
- #else
- CPU=
- #endif
- #endif
-EOF
- eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
- /^CPU/{
- s: ::g
- p
- }'`"
- test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }
- ;;
- or32:Linux:*:*)
- echo or32-unknown-linux-gnu
- exit ;;
- ppc:Linux:*:*)
- echo powerpc-unknown-linux-gnu
- exit ;;
- ppc64:Linux:*:*)
- echo powerpc64-unknown-linux-gnu
- exit ;;
- alpha:Linux:*:*)
- case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in
- EV5) UNAME_MACHINE=alphaev5 ;;
- EV56) UNAME_MACHINE=alphaev56 ;;
- PCA56) UNAME_MACHINE=alphapca56 ;;
- PCA57) UNAME_MACHINE=alphapca56 ;;
- EV6) UNAME_MACHINE=alphaev6 ;;
- EV67) UNAME_MACHINE=alphaev67 ;;
- EV68*) UNAME_MACHINE=alphaev68 ;;
- esac
- objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null
- if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi
- echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC}
- exit ;;
- parisc:Linux:*:* | hppa:Linux:*:*)
- # Look for CPU level
- case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in
- PA7*) echo hppa1.1-unknown-linux-gnu ;;
- PA8*) echo hppa2.0-unknown-linux-gnu ;;
- *) echo hppa-unknown-linux-gnu ;;
- esac
- exit ;;
- parisc64:Linux:*:* | hppa64:Linux:*:*)
- echo hppa64-unknown-linux-gnu
- exit ;;
- s390:Linux:*:* | s390x:Linux:*:*)
- echo ${UNAME_MACHINE}-ibm-linux
- exit ;;
- sh64*:Linux:*:*)
- echo ${UNAME_MACHINE}-unknown-linux-gnu
- exit ;;
- sh*:Linux:*:*)
- echo ${UNAME_MACHINE}-unknown-linux-gnu
- exit ;;
- sparc:Linux:*:* | sparc64:Linux:*:*)
- echo ${UNAME_MACHINE}-unknown-linux-gnu
- exit ;;
- vax:Linux:*:*)
- echo ${UNAME_MACHINE}-dec-linux-gnu
- exit ;;
- x86_64:Linux:*:*)
- echo x86_64-unknown-linux-gnu
- exit ;;
- i*86:Linux:*:*)
- # The BFD linker knows what the default object file format is, so
- # first see if it will tell us. cd to the root directory to prevent
- # problems with other programs or directories called `ld' in the path.
- # Set LC_ALL=C to ensure ld outputs messages in English.
- ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \
- | sed -ne '/supported targets:/!d
- s/[ ][ ]*/ /g
- s/.*supported targets: *//
- s/ .*//
- p'`
- case "$ld_supported_targets" in
- elf32-i386)
- TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu"
- ;;
- a.out-i386-linux)
- echo "${UNAME_MACHINE}-pc-linux-gnuaout"
- exit ;;
- coff-i386)
- echo "${UNAME_MACHINE}-pc-linux-gnucoff"
- exit ;;
- "")
- # Either a pre-BFD a.out linker (linux-gnuoldld) or
- # one that does not give us useful --help.
- echo "${UNAME_MACHINE}-pc-linux-gnuoldld"
- exit ;;
- esac
- # Determine whether the default compiler is a.out or elf
- eval $set_cc_for_build
- sed 's/^ //' << EOF >$dummy.c
- #include <features.h>
- #ifdef __ELF__
- # ifdef __GLIBC__
- # if __GLIBC__ >= 2
- LIBC=gnu
- # else
- LIBC=gnulibc1
- # endif
- # else
- LIBC=gnulibc1
- # endif
- #else
- #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC)
- LIBC=gnu
- #else
- LIBC=gnuaout
- #endif
- #endif
- #ifdef __dietlibc__
- LIBC=dietlibc
- #endif
-EOF
- eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
- /^LIBC/{
- s: ::g
- p
- }'`"
- test x"${LIBC}" != x && {
- echo "${UNAME_MACHINE}-pc-linux-${LIBC}"
- exit
- }
- test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; }
- ;;
- i*86:DYNIX/ptx:4*:*)
- # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.
- # earlier versions are messed up and put the nodename in both
- # sysname and nodename.
- echo i386-sequent-sysv4
- exit ;;
- i*86:UNIX_SV:4.2MP:2.*)
- # Unixware is an offshoot of SVR4, but it has its own version
- # number series starting with 2...
- # I am not positive that other SVR4 systems won't match this,
- # I just have to hope. -- rms.
- # Use sysv4.2uw... so that sysv4* matches it.
- echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION}
- exit ;;
- i*86:OS/2:*:*)
- # If we were able to find `uname', then EMX Unix compatibility
- # is probably installed.
- echo ${UNAME_MACHINE}-pc-os2-emx
- exit ;;
- i*86:XTS-300:*:STOP)
- echo ${UNAME_MACHINE}-unknown-stop
- exit ;;
- i*86:atheos:*:*)
- echo ${UNAME_MACHINE}-unknown-atheos
- exit ;;
- i*86:syllable:*:*)
- echo ${UNAME_MACHINE}-pc-syllable
- exit ;;
- i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*)
- echo i386-unknown-lynxos${UNAME_RELEASE}
- exit ;;
- i*86:*DOS:*:*)
- echo ${UNAME_MACHINE}-pc-msdosdjgpp
- exit ;;
- i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*)
- UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'`
- if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
- echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL}
- else
- echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL}
- fi
- exit ;;
- i*86:*:5:[678]*)
- # UnixWare 7.x, OpenUNIX and OpenServer 6.
- case `/bin/uname -X | grep "^Machine"` in
- *486*) UNAME_MACHINE=i486 ;;
- *Pentium) UNAME_MACHINE=i586 ;;
- *Pent*|*Celeron) UNAME_MACHINE=i686 ;;
- esac
- echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}
- exit ;;
- i*86:*:3.2:*)
- if test -f /usr/options/cb.name; then
- UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
- echo ${UNAME_MACHINE}-pc-isc$UNAME_REL
- elif /bin/uname -X 2>/dev/null >/dev/null ; then
- UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')`
- (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486
- (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \
- && UNAME_MACHINE=i586
- (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \
- && UNAME_MACHINE=i686
- (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \
- && UNAME_MACHINE=i686
- echo ${UNAME_MACHINE}-pc-sco$UNAME_REL
- else
- echo ${UNAME_MACHINE}-pc-sysv32
- fi
- exit ;;
- pc:*:*:*)
- # Left here for compatibility:
- # uname -m prints for DJGPP always 'pc', but it prints nothing about
- # the processor, so we play safe by assuming i386.
- echo i386-pc-msdosdjgpp
- exit ;;
- Intel:Mach:3*:*)
- echo i386-pc-mach3
- exit ;;
- paragon:*:*:*)
- echo i860-intel-osf1
- exit ;;
- i860:*:4.*:*) # i860-SVR4
- if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
- echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4
- else # Add other i860-SVR4 vendors below as they are discovered.
- echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4
- fi
- exit ;;
- mini*:CTIX:SYS*5:*)
- # "miniframe"
- echo m68010-convergent-sysv
- exit ;;
- mc68k:UNIX:SYSTEM5:3.51m)
- echo m68k-convergent-sysv
- exit ;;
- M680?0:D-NIX:5.3:*)
- echo m68k-diab-dnix
- exit ;;
- M68*:*:R3V[5678]*:*)
- test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;;
- 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0)
- OS_REL=''
- test -r /etc/.relid \
- && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
- /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
- && { echo i486-ncr-sysv4.3${OS_REL}; exit; }
- /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
- && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;;
- 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
- /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
- && { echo i486-ncr-sysv4; exit; } ;;
- m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*)
- echo m68k-unknown-lynxos${UNAME_RELEASE}
- exit ;;
- mc68030:UNIX_System_V:4.*:*)
- echo m68k-atari-sysv4
- exit ;;
- TSUNAMI:LynxOS:2.*:*)
- echo sparc-unknown-lynxos${UNAME_RELEASE}
- exit ;;
- rs6000:LynxOS:2.*:*)
- echo rs6000-unknown-lynxos${UNAME_RELEASE}
- exit ;;
- PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*)
- echo powerpc-unknown-lynxos${UNAME_RELEASE}
- exit ;;
- SM[BE]S:UNIX_SV:*:*)
- echo mips-dde-sysv${UNAME_RELEASE}
- exit ;;
- RM*:ReliantUNIX-*:*:*)
- echo mips-sni-sysv4
- exit ;;
- RM*:SINIX-*:*:*)
- echo mips-sni-sysv4
- exit ;;
- *:SINIX-*:*:*)
- if uname -p 2>/dev/null >/dev/null ; then
- UNAME_MACHINE=`(uname -p) 2>/dev/null`
- echo ${UNAME_MACHINE}-sni-sysv4
- else
- echo ns32k-sni-sysv
- fi
- exit ;;
- PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort
- # says <Richard.M.Bartel@ccMail.Census.GOV>
- echo i586-unisys-sysv4
- exit ;;
- *:UNIX_System_V:4*:FTX*)
- # From Gerald Hewes <hewes@openmarket.com>.
- # How about differentiating between stratus architectures? -djm
- echo hppa1.1-stratus-sysv4
- exit ;;
- *:*:*:FTX*)
- # From seanf@swdc.stratus.com.
- echo i860-stratus-sysv4
- exit ;;
- i*86:VOS:*:*)
- # From Paul.Green@stratus.com.
- echo ${UNAME_MACHINE}-stratus-vos
- exit ;;
- *:VOS:*:*)
- # From Paul.Green@stratus.com.
- echo hppa1.1-stratus-vos
- exit ;;
- mc68*:A/UX:*:*)
- echo m68k-apple-aux${UNAME_RELEASE}
- exit ;;
- news*:NEWS-OS:6*:*)
- echo mips-sony-newsos6
- exit ;;
- R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
- if [ -d /usr/nec ]; then
- echo mips-nec-sysv${UNAME_RELEASE}
- else
- echo mips-unknown-sysv${UNAME_RELEASE}
- fi
- exit ;;
- BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only.
- echo powerpc-be-beos
- exit ;;
- BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only.
- echo powerpc-apple-beos
- exit ;;
- BePC:BeOS:*:*) # BeOS running on Intel PC compatible.
- echo i586-pc-beos
- exit ;;
- SX-4:SUPER-UX:*:*)
- echo sx4-nec-superux${UNAME_RELEASE}
- exit ;;
- SX-5:SUPER-UX:*:*)
- echo sx5-nec-superux${UNAME_RELEASE}
- exit ;;
- SX-6:SUPER-UX:*:*)
- echo sx6-nec-superux${UNAME_RELEASE}
- exit ;;
- Power*:Rhapsody:*:*)
- echo powerpc-apple-rhapsody${UNAME_RELEASE}
- exit ;;
- *:Rhapsody:*:*)
- echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE}
- exit ;;
- *:Darwin:*:*)
- UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown
- case $UNAME_PROCESSOR in
- unknown) UNAME_PROCESSOR=powerpc ;;
- esac
- echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE}
- exit ;;
- *:procnto*:*:* | *:QNX:[0123456789]*:*)
- UNAME_PROCESSOR=`uname -p`
- if test "$UNAME_PROCESSOR" = "x86"; then
- UNAME_PROCESSOR=i386
- UNAME_MACHINE=pc
- fi
- echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE}
- exit ;;
- *:QNX:*:4*)
- echo i386-pc-qnx
- exit ;;
- NSE-?:NONSTOP_KERNEL:*:*)
- echo nse-tandem-nsk${UNAME_RELEASE}
- exit ;;
- NSR-?:NONSTOP_KERNEL:*:*)
- echo nsr-tandem-nsk${UNAME_RELEASE}
- exit ;;
- *:NonStop-UX:*:*)
- echo mips-compaq-nonstopux
- exit ;;
- BS2000:POSIX*:*:*)
- echo bs2000-siemens-sysv
- exit ;;
- DS/*:UNIX_System_V:*:*)
- echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE}
- exit ;;
- *:Plan9:*:*)
- # "uname -m" is not consistent, so use $cputype instead. 386
- # is converted to i386 for consistency with other x86
- # operating systems.
- if test "$cputype" = "386"; then
- UNAME_MACHINE=i386
- else
- UNAME_MACHINE="$cputype"
- fi
- echo ${UNAME_MACHINE}-unknown-plan9
- exit ;;
- *:TOPS-10:*:*)
- echo pdp10-unknown-tops10
- exit ;;
- *:TENEX:*:*)
- echo pdp10-unknown-tenex
- exit ;;
- KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*)
- echo pdp10-dec-tops20
- exit ;;
- XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*)
- echo pdp10-xkl-tops20
- exit ;;
- *:TOPS-20:*:*)
- echo pdp10-unknown-tops20
- exit ;;
- *:ITS:*:*)
- echo pdp10-unknown-its
- exit ;;
- SEI:*:*:SEIUX)
- echo mips-sei-seiux${UNAME_RELEASE}
- exit ;;
- *:DragonFly:*:*)
- echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
- exit ;;
- *:*VMS:*:*)
- UNAME_MACHINE=`(uname -p) 2>/dev/null`
- case "${UNAME_MACHINE}" in
- A*) echo alpha-dec-vms ; exit ;;
- I*) echo ia64-dec-vms ; exit ;;
- V*) echo vax-dec-vms ; exit ;;
- esac ;;
- *:XENIX:*:SysV)
- echo i386-pc-xenix
- exit ;;
- i*86:skyos:*:*)
- echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//'
- exit ;;
- i*86:rdos:*:*)
- echo ${UNAME_MACHINE}-pc-rdos
- exit ;;
-esac
-
-#echo '(No uname command or uname output not recognized.)' 1>&2
-#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2
-
-eval $set_cc_for_build
-cat >$dummy.c <<EOF
-#ifdef _SEQUENT_
-# include <sys/types.h>
-# include <sys/utsname.h>
-#endif
-main ()
-{
-#if defined (sony)
-#if defined (MIPSEB)
- /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed,
- I don't know.... */
- printf ("mips-sony-bsd\n"); exit (0);
-#else
-#include <sys/param.h>
- printf ("m68k-sony-newsos%s\n",
-#ifdef NEWSOS4
- "4"
-#else
- ""
-#endif
- ); exit (0);
-#endif
-#endif
-
-#if defined (__arm) && defined (__acorn) && defined (__unix)
- printf ("arm-acorn-riscix\n"); exit (0);
-#endif
-
-#if defined (hp300) && !defined (hpux)
- printf ("m68k-hp-bsd\n"); exit (0);
-#endif
-
-#if defined (NeXT)
-#if !defined (__ARCHITECTURE__)
-#define __ARCHITECTURE__ "m68k"
-#endif
- int version;
- version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
- if (version < 4)
- printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
- else
- printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);
- exit (0);
-#endif
-
-#if defined (MULTIMAX) || defined (n16)
-#if defined (UMAXV)
- printf ("ns32k-encore-sysv\n"); exit (0);
-#else
-#if defined (CMU)
- printf ("ns32k-encore-mach\n"); exit (0);
-#else
- printf ("ns32k-encore-bsd\n"); exit (0);
-#endif
-#endif
-#endif
-
-#if defined (__386BSD__)
- printf ("i386-pc-bsd\n"); exit (0);
-#endif
-
-#if defined (sequent)
-#if defined (i386)
- printf ("i386-sequent-dynix\n"); exit (0);
-#endif
-#if defined (ns32000)
- printf ("ns32k-sequent-dynix\n"); exit (0);
-#endif
-#endif
-
-#if defined (_SEQUENT_)
- struct utsname un;
-
- uname(&un);
-
- if (strncmp(un.version, "V2", 2) == 0) {
- printf ("i386-sequent-ptx2\n"); exit (0);
- }
- if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */
- printf ("i386-sequent-ptx1\n"); exit (0);
- }
- printf ("i386-sequent-ptx\n"); exit (0);
-
-#endif
-
-#if defined (vax)
-# if !defined (ultrix)
-# include <sys/param.h>
-# if defined (BSD)
-# if BSD == 43
- printf ("vax-dec-bsd4.3\n"); exit (0);
-# else
-# if BSD == 199006
- printf ("vax-dec-bsd4.3reno\n"); exit (0);
-# else
- printf ("vax-dec-bsd\n"); exit (0);
-# endif
-# endif
-# else
- printf ("vax-dec-bsd\n"); exit (0);
-# endif
-# else
- printf ("vax-dec-ultrix\n"); exit (0);
-# endif
-#endif
-
-#if defined (alliant) && defined (i860)
- printf ("i860-alliant-bsd\n"); exit (0);
-#endif
-
- exit (1);
-}
-EOF
-
-$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` &&
- { echo "$SYSTEM_NAME"; exit; }
-
-# Apollos put the system type in the environment.
-
-test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; }
-
-# Convex versions that predate uname can use getsysinfo(1)
-
-if [ -x /usr/convex/getsysinfo ]
-then
- case `getsysinfo -f cpu_type` in
- c1*)
- echo c1-convex-bsd
- exit ;;
- c2*)
- if getsysinfo -f scalar_acc
- then echo c32-convex-bsd
- else echo c2-convex-bsd
- fi
- exit ;;
- c34*)
- echo c34-convex-bsd
- exit ;;
- c38*)
- echo c38-convex-bsd
- exit ;;
- c4*)
- echo c4-convex-bsd
- exit ;;
- esac
-fi
-
-cat >&2 <<EOF
-$0: unable to guess system type
-
-This script, last modified $timestamp, has failed to recognize
-the operating system you are using. It is advised that you
-download the most up to date version of the config scripts from
-
- http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess
-and
- http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub
-
-If the version you run ($0) is already up to date, please
-send the following data and any information you think might be
-pertinent to <config-patches@gnu.org> in order to provide the needed
-information to handle your system.
-
-config.guess timestamp = $timestamp
-
-uname -m = `(uname -m) 2>/dev/null || echo unknown`
-uname -r = `(uname -r) 2>/dev/null || echo unknown`
-uname -s = `(uname -s) 2>/dev/null || echo unknown`
-uname -v = `(uname -v) 2>/dev/null || echo unknown`
-
-/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null`
-/bin/uname -X = `(/bin/uname -X) 2>/dev/null`
-
-hostinfo = `(hostinfo) 2>/dev/null`
-/bin/universe = `(/bin/universe) 2>/dev/null`
-/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null`
-/bin/arch = `(/bin/arch) 2>/dev/null`
-/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null`
-/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null`
-
-UNAME_MACHINE = ${UNAME_MACHINE}
-UNAME_RELEASE = ${UNAME_RELEASE}
-UNAME_SYSTEM = ${UNAME_SYSTEM}
-UNAME_VERSION = ${UNAME_VERSION}
-EOF
-
-exit 1
-
-# Local variables:
-# eval: (add-hook 'write-file-hooks 'time-stamp)
-# time-stamp-start: "timestamp='"
-# time-stamp-format: "%:y-%02m-%02d"
-# time-stamp-end: "'"
-# End:
diff --git a/cil/config.h.in b/cil/config.h.in
deleted file mode 100644
index 57dc9f0a39ebef598b2d950ba36fd218e6ab864c..0000000000000000000000000000000000000000
--- a/cil/config.h.in
+++ /dev/null
@@ -1,23 +0,0 @@
-#undef HAVE_WCHAR_T
-
-#undef HAVE_STDLIB_H
-
-#undef HAVE_STRINGS_H
-
-#undef HAVE_SYS_TIME_H
-
-#undef HAVE_UNISTD_H
-
-#undef HAVE_CONST
-
-#undef HAVE_INLINE
-
-#undef HAVE_TIME_H
-
-#undef HAVE_MEMCP
-
-#undef HAVE_MKDIR
-
-#undef HAVE_SELECT
-
-#undef HAVE_SOCKET
diff --git a/cil/config.sub b/cil/config.sub
deleted file mode 100755
index f0675aa6b781c1f3557e5fc2dcb319becfddd60c..0000000000000000000000000000000000000000
--- a/cil/config.sub
+++ /dev/null
@@ -1,1469 +0,0 @@
-#! /bin/sh
-# Configuration validation subroutine script.
-# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-# 2000, 2001, 2002 Free Software Foundation, Inc.
-
-timestamp='2002-11-30'
-
-# This file is (in principle) common to ALL GNU software.
-# The presence of a machine in this file suggests that SOME GNU software
-# can handle that machine. It does not imply ALL GNU software can.
-#
-# This file 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., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-# As a special exception to the GNU General Public License, if you
-# distribute this file as part of a program that contains a
-# configuration script generated by Autoconf, you may include it under
-# the same distribution terms that you use for the rest of that program.
-
-# Please send patches to <config-patches@gnu.org>. Submit a context
-# diff and a properly formatted ChangeLog entry.
-#
-# Configuration subroutine to validate and canonicalize a configuration type.
-# Supply the specified configuration type as an argument.
-# If it is invalid, we print an error message on stderr and exit with code 1.
-# Otherwise, we print the canonical config type on stdout and succeed.
-
-# This file is supposed to be the same for all GNU packages
-# and recognize all the CPU types, system types and aliases
-# that are meaningful with *any* GNU software.
-# Each package is responsible for reporting which valid configurations
-# it does not support. The user should be able to distinguish
-# a failure to support a valid configuration from a meaningless
-# configuration.
-
-# The goal of this file is to map all the various variations of a given
-# machine specification into a single specification in the form:
-# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
-# or in some cases, the newer four-part form:
-# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
-# It is wrong to echo any other type of specification.
-
-me=`echo "$0" | sed -e 's,.*/,,'`
-
-usage="\
-Usage: $0 [OPTION] CPU-MFR-OPSYS
- $0 [OPTION] ALIAS
-
-Canonicalize a configuration name.
-
-Operation modes:
- -h, --help print this help, then exit
- -t, --time-stamp print date of last modification, then exit
- -v, --version print version number, then exit
-
-Report bugs and patches to <config-patches@gnu.org>."
-
-version="\
-GNU config.sub ($timestamp)
-
-Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
-Free Software Foundation, Inc.
-
-This is free software; see the source for copying conditions. There is NO
-warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
-
-help="
-Try \`$me --help' for more information."
-
-# Parse command line
-while test $# -gt 0 ; do
- case $1 in
- --time-stamp | --time* | -t )
- echo "$timestamp" ; exit 0 ;;
- --version | -v )
- echo "$version" ; exit 0 ;;
- --help | --h* | -h )
- echo "$usage"; exit 0 ;;
- -- ) # Stop option processing
- shift; break ;;
- - ) # Use stdin as input.
- break ;;
- -* )
- echo "$me: invalid option $1$help"
- exit 1 ;;
-
- *local*)
- # First pass through any local machine types.
- echo $1
- exit 0;;
-
- * )
- break ;;
- esac
-done
-
-case $# in
- 0) echo "$me: missing argument$help" >&2
- exit 1;;
- 1) ;;
- *) echo "$me: too many arguments$help" >&2
- exit 1;;
-esac
-
-# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any).
-# Here we must recognize all the valid KERNEL-OS combinations.
-maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`
-case $maybe_os in
- nto-qnx* | linux-gnu* | freebsd*-gnu* | netbsd*-gnu* | storm-chaos* | os2-emx* | rtmk-nova*)
- os=-$maybe_os
- basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`
- ;;
- *)
- basic_machine=`echo $1 | sed 's/-[^-]*$//'`
- if [ $basic_machine != $1 ]
- then os=`echo $1 | sed 's/.*-/-/'`
- else os=; fi
- ;;
-esac
-
-### Let's recognize common machines as not being operating systems so
-### that things like config.sub decstation-3100 work. We also
-### recognize some manufacturers as not being operating systems, so we
-### can provide default operating systems below.
-case $os in
- -sun*os*)
- # Prevent following clause from handling this invalid input.
- ;;
- -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \
- -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \
- -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \
- -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
- -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
- -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \
- -apple | -axis)
- os=
- basic_machine=$1
- ;;
- -sim | -cisco | -oki | -wec | -winbond)
- os=
- basic_machine=$1
- ;;
- -scout)
- ;;
- -wrs)
- os=-vxworks
- basic_machine=$1
- ;;
- -chorusos*)
- os=-chorusos
- basic_machine=$1
- ;;
- -chorusrdb)
- os=-chorusrdb
- basic_machine=$1
- ;;
- -hiux*)
- os=-hiuxwe2
- ;;
- -sco5)
- os=-sco3.2v5
- basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
- ;;
- -sco4)
- os=-sco3.2v4
- basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
- ;;
- -sco3.2.[4-9]*)
- os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`
- basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
- ;;
- -sco3.2v[4-9]*)
- # Don't forget version if it is 3.2v4 or newer.
- basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
- ;;
- -sco*)
- os=-sco3.2v2
- basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
- ;;
- -udk*)
- basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
- ;;
- -isc)
- os=-isc2.2
- basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
- ;;
- -clix*)
- basic_machine=clipper-intergraph
- ;;
- -isc*)
- basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
- ;;
- -lynx*)
- os=-lynxos
- ;;
- -ptx*)
- basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`
- ;;
- -windowsnt*)
- os=`echo $os | sed -e 's/windowsnt/winnt/'`
- ;;
- -psos*)
- os=-psos
- ;;
- -mint | -mint[0-9]*)
- basic_machine=m68k-atari
- os=-mint
- ;;
-esac
-
-# Decode aliases for certain CPU-COMPANY combinations.
-case $basic_machine in
- # Recognize the basic CPU types without company name.
- # Some are omitted here because they have special meanings below.
- 1750a | 580 \
- | a29k \
- | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \
- | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \
- | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr \
- | clipper \
- | d10v | d30v | dlx | dsp16xx \
- | fr30 | frv \
- | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
- | i370 | i860 | i960 | ia64 \
- | ip2k \
- | m32r | m68000 | m68k | m88k | mcore \
- | mips | mipsbe | mipseb | mipsel | mipsle \
- | mips16 \
- | mips64 | mips64el \
- | mips64vr | mips64vrel \
- | mips64orion | mips64orionel \
- | mips64vr4100 | mips64vr4100el \
- | mips64vr4300 | mips64vr4300el \
- | mips64vr5000 | mips64vr5000el \
- | mipsisa32 | mipsisa32el \
- | mipsisa64 | mipsisa64el \
- | mipsisa64sb1 | mipsisa64sb1el \
- | mipsisa64sr71k | mipsisa64sr71kel \
- | mipstx39 | mipstx39el \
- | mn10200 | mn10300 \
- | ns16k | ns32k \
- | openrisc | or32 \
- | pdp10 | pdp11 | pj | pjl \
- | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \
- | pyramid \
- | sh | sh[1234] | sh3e | sh[34]eb | shbe | shle | sh[1234]le | sh3ele \
- | sh64 | sh64le \
- | sparc | sparc64 | sparc86x | sparclet | sparclite | sparcv9 | sparcv9b \
- | strongarm \
- | tahoe | thumb | tic80 | tron \
- | v850 | v850e \
- | we32k \
- | x86 | xscale | xstormy16 | xtensa \
- | z8k)
- basic_machine=$basic_machine-unknown
- ;;
- m6811 | m68hc11 | m6812 | m68hc12)
- # Motorola 68HC11/12.
- basic_machine=$basic_machine-unknown
- os=-none
- ;;
- m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k)
- ;;
-
- # We use `pc' rather than `unknown'
- # because (1) that's what they normally are, and
- # (2) the word "unknown" tends to confuse beginning users.
- i*86 | x86_64)
- basic_machine=$basic_machine-pc
- ;;
- # Object if more than one company name word.
- *-*-*)
- echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
- exit 1
- ;;
- # Recognize the basic CPU types with company name.
- 580-* \
- | a29k-* \
- | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \
- | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \
- | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \
- | arm-* | armbe-* | armle-* | armeb-* | armv*-* \
- | avr-* \
- | bs2000-* \
- | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* \
- | clipper-* | cydra-* \
- | d10v-* | d30v-* | dlx-* \
- | elxsi-* \
- | f30[01]-* | f700-* | fr30-* | frv-* | fx80-* \
- | h8300-* | h8500-* \
- | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \
- | i*86-* | i860-* | i960-* | ia64-* \
- | ip2k-* \
- | m32r-* \
- | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \
- | m88110-* | m88k-* | mcore-* \
- | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \
- | mips16-* \
- | mips64-* | mips64el-* \
- | mips64vr-* | mips64vrel-* \
- | mips64orion-* | mips64orionel-* \
- | mips64vr4100-* | mips64vr4100el-* \
- | mips64vr4300-* | mips64vr4300el-* \
- | mips64vr5000-* | mips64vr5000el-* \
- | mipsisa32-* | mipsisa32el-* \
- | mipsisa64-* | mipsisa64el-* \
- | mipsisa64sb1-* | mipsisa64sb1el-* \
- | mipsisa64sr71k-* | mipsisa64sr71kel-* \
- | mipstx39 | mipstx39el \
- | none-* | np1-* | ns16k-* | ns32k-* \
- | orion-* \
- | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
- | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \
- | pyramid-* \
- | romp-* | rs6000-* \
- | sh-* | sh[1234]-* | sh3e-* | sh[34]eb-* | shbe-* \
- | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \
- | sparc-* | sparc64-* | sparc86x-* | sparclet-* | sparclite-* \
- | sparcv9-* | sparcv9b-* | strongarm-* | sv1-* | sx?-* \
- | tahoe-* | thumb-* | tic30-* | tic4x-* | tic54x-* | tic80-* | tron-* \
- | v850-* | v850e-* | vax-* \
- | we32k-* \
- | x86-* | x86_64-* | xps100-* | xscale-* | xstormy16-* \
- | xtensa-* \
- | ymp-* \
- | z8k-*)
- ;;
- # Recognize the various machine names and aliases which stand
- # for a CPU type and a company and sometimes even an OS.
- 386bsd)
- basic_machine=i386-unknown
- os=-bsd
- ;;
- 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
- basic_machine=m68000-att
- ;;
- 3b*)
- basic_machine=we32k-att
- ;;
- a29khif)
- basic_machine=a29k-amd
- os=-udi
- ;;
- adobe68k)
- basic_machine=m68010-adobe
- os=-scout
- ;;
- alliant | fx80)
- basic_machine=fx80-alliant
- ;;
- altos | altos3068)
- basic_machine=m68k-altos
- ;;
- am29k)
- basic_machine=a29k-none
- os=-bsd
- ;;
- amdahl)
- basic_machine=580-amdahl
- os=-sysv
- ;;
- amiga | amiga-*)
- basic_machine=m68k-unknown
- ;;
- amigaos | amigados)
- basic_machine=m68k-unknown
- os=-amigaos
- ;;
- amigaunix | amix)
- basic_machine=m68k-unknown
- os=-sysv4
- ;;
- apollo68)
- basic_machine=m68k-apollo
- os=-sysv
- ;;
- apollo68bsd)
- basic_machine=m68k-apollo
- os=-bsd
- ;;
- aux)
- basic_machine=m68k-apple
- os=-aux
- ;;
- balance)
- basic_machine=ns32k-sequent
- os=-dynix
- ;;
- c90)
- basic_machine=c90-cray
- os=-unicos
- ;;
- convex-c1)
- basic_machine=c1-convex
- os=-bsd
- ;;
- convex-c2)
- basic_machine=c2-convex
- os=-bsd
- ;;
- convex-c32)
- basic_machine=c32-convex
- os=-bsd
- ;;
- convex-c34)
- basic_machine=c34-convex
- os=-bsd
- ;;
- convex-c38)
- basic_machine=c38-convex
- os=-bsd
- ;;
- cray | j90)
- basic_machine=j90-cray
- os=-unicos
- ;;
- crds | unos)
- basic_machine=m68k-crds
- ;;
- cris | cris-* | etrax*)
- basic_machine=cris-axis
- ;;
- da30 | da30-*)
- basic_machine=m68k-da30
- ;;
- decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)
- basic_machine=mips-dec
- ;;
- decsystem10* | dec10*)
- basic_machine=pdp10-dec
- os=-tops10
- ;;
- decsystem20* | dec20*)
- basic_machine=pdp10-dec
- os=-tops20
- ;;
- delta | 3300 | motorola-3300 | motorola-delta \
- | 3300-motorola | delta-motorola)
- basic_machine=m68k-motorola
- ;;
- delta88)
- basic_machine=m88k-motorola
- os=-sysv3
- ;;
- dpx20 | dpx20-*)
- basic_machine=rs6000-bull
- os=-bosx
- ;;
- dpx2* | dpx2*-bull)
- basic_machine=m68k-bull
- os=-sysv3
- ;;
- ebmon29k)
- basic_machine=a29k-amd
- os=-ebmon
- ;;
- elxsi)
- basic_machine=elxsi-elxsi
- os=-bsd
- ;;
- encore | umax | mmax)
- basic_machine=ns32k-encore
- ;;
- es1800 | OSE68k | ose68k | ose | OSE)
- basic_machine=m68k-ericsson
- os=-ose
- ;;
- fx2800)
- basic_machine=i860-alliant
- ;;
- genix)
- basic_machine=ns32k-ns
- ;;
- gmicro)
- basic_machine=tron-gmicro
- os=-sysv
- ;;
- go32)
- basic_machine=i386-pc
- os=-go32
- ;;
- h3050r* | hiux*)
- basic_machine=hppa1.1-hitachi
- os=-hiuxwe2
- ;;
- h8300hms)
- basic_machine=h8300-hitachi
- os=-hms
- ;;
- h8300xray)
- basic_machine=h8300-hitachi
- os=-xray
- ;;
- h8500hms)
- basic_machine=h8500-hitachi
- os=-hms
- ;;
- harris)
- basic_machine=m88k-harris
- os=-sysv3
- ;;
- hp300-*)
- basic_machine=m68k-hp
- ;;
- hp300bsd)
- basic_machine=m68k-hp
- os=-bsd
- ;;
- hp300hpux)
- basic_machine=m68k-hp
- os=-hpux
- ;;
- hp3k9[0-9][0-9] | hp9[0-9][0-9])
- basic_machine=hppa1.0-hp
- ;;
- hp9k2[0-9][0-9] | hp9k31[0-9])
- basic_machine=m68000-hp
- ;;
- hp9k3[2-9][0-9])
- basic_machine=m68k-hp
- ;;
- hp9k6[0-9][0-9] | hp6[0-9][0-9])
- basic_machine=hppa1.0-hp
- ;;
- hp9k7[0-79][0-9] | hp7[0-79][0-9])
- basic_machine=hppa1.1-hp
- ;;
- hp9k78[0-9] | hp78[0-9])
- # FIXME: really hppa2.0-hp
- basic_machine=hppa1.1-hp
- ;;
- hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)
- # FIXME: really hppa2.0-hp
- basic_machine=hppa1.1-hp
- ;;
- hp9k8[0-9][13679] | hp8[0-9][13679])
- basic_machine=hppa1.1-hp
- ;;
- hp9k8[0-9][0-9] | hp8[0-9][0-9])
- basic_machine=hppa1.0-hp
- ;;
- hppa-next)
- os=-nextstep3
- ;;
- hppaosf)
- basic_machine=hppa1.1-hp
- os=-osf
- ;;
- hppro)
- basic_machine=hppa1.1-hp
- os=-proelf
- ;;
- i370-ibm* | ibm*)
- basic_machine=i370-ibm
- ;;
-# I'm not sure what "Sysv32" means. Should this be sysv3.2?
- i*86v32)
- basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
- os=-sysv32
- ;;
- i*86v4*)
- basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
- os=-sysv4
- ;;
- i*86v)
- basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
- os=-sysv
- ;;
- i*86sol2)
- basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
- os=-solaris2
- ;;
- i386mach)
- basic_machine=i386-mach
- os=-mach
- ;;
- i386-vsta | vsta)
- basic_machine=i386-unknown
- os=-vsta
- ;;
- iris | iris4d)
- basic_machine=mips-sgi
- case $os in
- -irix*)
- ;;
- *)
- os=-irix4
- ;;
- esac
- ;;
- isi68 | isi)
- basic_machine=m68k-isi
- os=-sysv
- ;;
- m88k-omron*)
- basic_machine=m88k-omron
- ;;
- magnum | m3230)
- basic_machine=mips-mips
- os=-sysv
- ;;
- merlin)
- basic_machine=ns32k-utek
- os=-sysv
- ;;
- mingw32)
- basic_machine=i386-pc
- os=-mingw32
- ;;
- miniframe)
- basic_machine=m68000-convergent
- ;;
- *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*)
- basic_machine=m68k-atari
- os=-mint
- ;;
- mips3*-*)
- basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`
- ;;
- mips3*)
- basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown
- ;;
- mmix*)
- basic_machine=mmix-knuth
- os=-mmixware
- ;;
- monitor)
- basic_machine=m68k-rom68k
- os=-coff
- ;;
- morphos)
- basic_machine=powerpc-unknown
- os=-morphos
- ;;
- msdos)
- basic_machine=i386-pc
- os=-msdos
- ;;
- mvs)
- basic_machine=i370-ibm
- os=-mvs
- ;;
- ncr3000)
- basic_machine=i486-ncr
- os=-sysv4
- ;;
- netbsd386)
- basic_machine=i386-unknown
- os=-netbsd
- ;;
- netwinder)
- basic_machine=armv4l-rebel
- os=-linux
- ;;
- news | news700 | news800 | news900)
- basic_machine=m68k-sony
- os=-newsos
- ;;
- news1000)
- basic_machine=m68030-sony
- os=-newsos
- ;;
- news-3600 | risc-news)
- basic_machine=mips-sony
- os=-newsos
- ;;
- necv70)
- basic_machine=v70-nec
- os=-sysv
- ;;
- next | m*-next )
- basic_machine=m68k-next
- case $os in
- -nextstep* )
- ;;
- -ns2*)
- os=-nextstep2
- ;;
- *)
- os=-nextstep3
- ;;
- esac
- ;;
- nh3000)
- basic_machine=m68k-harris
- os=-cxux
- ;;
- nh[45]000)
- basic_machine=m88k-harris
- os=-cxux
- ;;
- nindy960)
- basic_machine=i960-intel
- os=-nindy
- ;;
- mon960)
- basic_machine=i960-intel
- os=-mon960
- ;;
- nonstopux)
- basic_machine=mips-compaq
- os=-nonstopux
- ;;
- np1)
- basic_machine=np1-gould
- ;;
- nsr-tandem)
- basic_machine=nsr-tandem
- ;;
- op50n-* | op60c-*)
- basic_machine=hppa1.1-oki
- os=-proelf
- ;;
- or32 | or32-*)
- basic_machine=or32-unknown
- os=-coff
- ;;
- OSE68000 | ose68000)
- basic_machine=m68000-ericsson
- os=-ose
- ;;
- os68k)
- basic_machine=m68k-none
- os=-os68k
- ;;
- pa-hitachi)
- basic_machine=hppa1.1-hitachi
- os=-hiuxwe2
- ;;
- paragon)
- basic_machine=i860-intel
- os=-osf
- ;;
- pbd)
- basic_machine=sparc-tti
- ;;
- pbb)
- basic_machine=m68k-tti
- ;;
- pc532 | pc532-*)
- basic_machine=ns32k-pc532
- ;;
- pentium | p5 | k5 | k6 | nexgen | viac3)
- basic_machine=i586-pc
- ;;
- pentiumpro | p6 | 6x86 | athlon | athlon_*)
- basic_machine=i686-pc
- ;;
- pentiumii | pentium2)
- basic_machine=i686-pc
- ;;
- pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)
- basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'`
- ;;
- pentiumpro-* | p6-* | 6x86-* | athlon-*)
- basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
- ;;
- pentiumii-* | pentium2-*)
- basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
- ;;
- pn)
- basic_machine=pn-gould
- ;;
- power) basic_machine=power-ibm
- ;;
- ppc) basic_machine=powerpc-unknown
- ;;
- ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'`
- ;;
- ppcle | powerpclittle | ppc-le | powerpc-little)
- basic_machine=powerpcle-unknown
- ;;
- ppcle-* | powerpclittle-*)
- basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'`
- ;;
- ppc64) basic_machine=powerpc64-unknown
- ;;
- ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'`
- ;;
- ppc64le | powerpc64little | ppc64-le | powerpc64-little)
- basic_machine=powerpc64le-unknown
- ;;
- ppc64le-* | powerpc64little-*)
- basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'`
- ;;
- ps2)
- basic_machine=i386-ibm
- ;;
- pw32)
- basic_machine=i586-unknown
- os=-pw32
- ;;
- rom68k)
- basic_machine=m68k-rom68k
- os=-coff
- ;;
- rm[46]00)
- basic_machine=mips-siemens
- ;;
- rtpc | rtpc-*)
- basic_machine=romp-ibm
- ;;
- s390 | s390-*)
- basic_machine=s390-ibm
- ;;
- s390x | s390x-*)
- basic_machine=s390x-ibm
- ;;
- sa29200)
- basic_machine=a29k-amd
- os=-udi
- ;;
- sb1)
- basic_machine=mipsisa64sb1-unknown
- ;;
- sb1el)
- basic_machine=mipsisa64sb1el-unknown
- ;;
- sequent)
- basic_machine=i386-sequent
- ;;
- sh)
- basic_machine=sh-hitachi
- os=-hms
- ;;
- sparclite-wrs | simso-wrs)
- basic_machine=sparclite-wrs
- os=-vxworks
- ;;
- sps7)
- basic_machine=m68k-bull
- os=-sysv2
- ;;
- spur)
- basic_machine=spur-unknown
- ;;
- st2000)
- basic_machine=m68k-tandem
- ;;
- stratus)
- basic_machine=i860-stratus
- os=-sysv4
- ;;
- sun2)
- basic_machine=m68000-sun
- ;;
- sun2os3)
- basic_machine=m68000-sun
- os=-sunos3
- ;;
- sun2os4)
- basic_machine=m68000-sun
- os=-sunos4
- ;;
- sun3os3)
- basic_machine=m68k-sun
- os=-sunos3
- ;;
- sun3os4)
- basic_machine=m68k-sun
- os=-sunos4
- ;;
- sun4os3)
- basic_machine=sparc-sun
- os=-sunos3
- ;;
- sun4os4)
- basic_machine=sparc-sun
- os=-sunos4
- ;;
- sun4sol2)
- basic_machine=sparc-sun
- os=-solaris2
- ;;
- sun3 | sun3-*)
- basic_machine=m68k-sun
- ;;
- sun4)
- basic_machine=sparc-sun
- ;;
- sun386 | sun386i | roadrunner)
- basic_machine=i386-sun
- ;;
- sv1)
- basic_machine=sv1-cray
- os=-unicos
- ;;
- symmetry)
- basic_machine=i386-sequent
- os=-dynix
- ;;
- t3d)
- basic_machine=alpha-cray
- os=-unicos
- ;;
- t3e)
- basic_machine=alphaev5-cray
- os=-unicos
- ;;
- t90)
- basic_machine=t90-cray
- os=-unicos
- ;;
- tic4x | c4x*)
- basic_machine=tic4x-unknown
- os=-coff
- ;;
- tic54x | c54x*)
- basic_machine=tic54x-unknown
- os=-coff
- ;;
- tx39)
- basic_machine=mipstx39-unknown
- ;;
- tx39el)
- basic_machine=mipstx39el-unknown
- ;;
- toad1)
- basic_machine=pdp10-xkl
- os=-tops20
- ;;
- tower | tower-32)
- basic_machine=m68k-ncr
- ;;
- udi29k)
- basic_machine=a29k-amd
- os=-udi
- ;;
- ultra3)
- basic_machine=a29k-nyu
- os=-sym1
- ;;
- v810 | necv810)
- basic_machine=v810-nec
- os=-none
- ;;
- vaxv)
- basic_machine=vax-dec
- os=-sysv
- ;;
- vms)
- basic_machine=vax-dec
- os=-vms
- ;;
- vpp*|vx|vx-*)
- basic_machine=f301-fujitsu
- ;;
- vxworks960)
- basic_machine=i960-wrs
- os=-vxworks
- ;;
- vxworks68)
- basic_machine=m68k-wrs
- os=-vxworks
- ;;
- vxworks29k)
- basic_machine=a29k-wrs
- os=-vxworks
- ;;
- w65*)
- basic_machine=w65-wdc
- os=-none
- ;;
- w89k-*)
- basic_machine=hppa1.1-winbond
- os=-proelf
- ;;
- xps | xps100)
- basic_machine=xps100-honeywell
- ;;
- ymp)
- basic_machine=ymp-cray
- os=-unicos
- ;;
- z8k-*-coff)
- basic_machine=z8k-unknown
- os=-sim
- ;;
- none)
- basic_machine=none-none
- os=-none
- ;;
-
-# Here we handle the default manufacturer of certain CPU types. It is in
-# some cases the only manufacturer, in others, it is the most popular.
- w89k)
- basic_machine=hppa1.1-winbond
- ;;
- op50n)
- basic_machine=hppa1.1-oki
- ;;
- op60c)
- basic_machine=hppa1.1-oki
- ;;
- romp)
- basic_machine=romp-ibm
- ;;
- rs6000)
- basic_machine=rs6000-ibm
- ;;
- vax)
- basic_machine=vax-dec
- ;;
- pdp10)
- # there are many clones, so DEC is not a safe bet
- basic_machine=pdp10-unknown
- ;;
- pdp11)
- basic_machine=pdp11-dec
- ;;
- we32k)
- basic_machine=we32k-att
- ;;
- sh3 | sh4 | sh3eb | sh4eb | sh[1234]le | sh3ele)
- basic_machine=sh-unknown
- ;;
- sh64)
- basic_machine=sh64-unknown
- ;;
- sparc | sparcv9 | sparcv9b)
- basic_machine=sparc-sun
- ;;
- cydra)
- basic_machine=cydra-cydrome
- ;;
- orion)
- basic_machine=orion-highlevel
- ;;
- orion105)
- basic_machine=clipper-highlevel
- ;;
- mac | mpw | mac-mpw)
- basic_machine=m68k-apple
- ;;
- pmac | pmac-mpw)
- basic_machine=powerpc-apple
- ;;
- *-unknown)
- # Make sure to match an already-canonicalized machine name.
- ;;
- *)
- echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
- exit 1
- ;;
-esac
-
-# Here we canonicalize certain aliases for manufacturers.
-case $basic_machine in
- *-digital*)
- basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'`
- ;;
- *-commodore*)
- basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'`
- ;;
- *)
- ;;
-esac
-
-# Decode manufacturer-specific aliases for certain operating systems.
-
-if [ x"$os" != x"" ]
-then
-case $os in
- # First match some system type aliases
- # that might get confused with valid system types.
- # -solaris* is a basic system type, with this one exception.
- -solaris1 | -solaris1.*)
- os=`echo $os | sed -e 's|solaris1|sunos4|'`
- ;;
- -solaris)
- os=-solaris2
- ;;
- -svr4*)
- os=-sysv4
- ;;
- -unixware*)
- os=-sysv4.2uw
- ;;
- -gnu/linux*)
- os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`
- ;;
- # First accept the basic system types.
- # The portable systems comes first.
- # Each alternative MUST END IN A *, to match a version number.
- # -sysv* is not here because it comes later, after sysvr4.
- -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
- | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\
- | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \
- | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \
- | -aos* \
- | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
- | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \
- | -hiux* | -386bsd* | -netbsd* | -openbsd* | -freebsd* | -riscix* \
- | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \
- | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
- | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
- | -chorusos* | -chorusrdb* \
- | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
- | -mingw32* | -linux-gnu* | -uxpv* | -beos* | -mpeix* | -udk* \
- | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \
- | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \
- | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \
- | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \
- | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \
- | -powermax* | -dnix*)
- # Remember, each alternative MUST END IN *, to match a version number.
- ;;
- -qnx*)
- case $basic_machine in
- x86-* | i*86-*)
- ;;
- *)
- os=-nto$os
- ;;
- esac
- ;;
- -nto-qnx*)
- ;;
- -nto*)
- os=`echo $os | sed -e 's|nto|nto-qnx|'`
- ;;
- -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \
- | -windows* | -osx | -abug | -netware* | -os9* | -beos* \
- | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)
- ;;
- -mac*)
- os=`echo $os | sed -e 's|mac|macos|'`
- ;;
- -linux*)
- os=`echo $os | sed -e 's|linux|linux-gnu|'`
- ;;
- -sunos5*)
- os=`echo $os | sed -e 's|sunos5|solaris2|'`
- ;;
- -sunos6*)
- os=`echo $os | sed -e 's|sunos6|solaris3|'`
- ;;
- -opened*)
- os=-openedition
- ;;
- -wince*)
- os=-wince
- ;;
- -osfrose*)
- os=-osfrose
- ;;
- -osf*)
- os=-osf
- ;;
- -utek*)
- os=-bsd
- ;;
- -dynix*)
- os=-bsd
- ;;
- -acis*)
- os=-aos
- ;;
- -atheos*)
- os=-atheos
- ;;
- -386bsd)
- os=-bsd
- ;;
- -ctix* | -uts*)
- os=-sysv
- ;;
- -nova*)
- os=-rtmk-nova
- ;;
- -ns2 )
- os=-nextstep2
- ;;
- -nsk*)
- os=-nsk
- ;;
- # Preserve the version number of sinix5.
- -sinix5.*)
- os=`echo $os | sed -e 's|sinix|sysv|'`
- ;;
- -sinix*)
- os=-sysv4
- ;;
- -triton*)
- os=-sysv3
- ;;
- -oss*)
- os=-sysv3
- ;;
- -svr4)
- os=-sysv4
- ;;
- -svr3)
- os=-sysv3
- ;;
- -sysvr4)
- os=-sysv4
- ;;
- # This must come after -sysvr4.
- -sysv*)
- ;;
- -ose*)
- os=-ose
- ;;
- -es1800*)
- os=-ose
- ;;
- -xenix)
- os=-xenix
- ;;
- -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
- os=-mint
- ;;
- -none)
- ;;
- *)
- # Get rid of the `-' at the beginning of $os.
- os=`echo $os | sed 's/[^-]*-//'`
- echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2
- exit 1
- ;;
-esac
-else
-
-# Here we handle the default operating systems that come with various machines.
-# The value should be what the vendor currently ships out the door with their
-# machine or put another way, the most popular os provided with the machine.
-
-# Note that if you're going to try to match "-MANUFACTURER" here (say,
-# "-sun"), then you have to tell the case statement up towards the top
-# that MANUFACTURER isn't an operating system. Otherwise, code above
-# will signal an error saying that MANUFACTURER isn't an operating
-# system, and we'll never get to this point.
-
-case $basic_machine in
- *-acorn)
- os=-riscix1.2
- ;;
- arm*-rebel)
- os=-linux
- ;;
- arm*-semi)
- os=-aout
- ;;
- # This must come before the *-dec entry.
- pdp10-*)
- os=-tops20
- ;;
- pdp11-*)
- os=-none
- ;;
- *-dec | vax-*)
- os=-ultrix4.2
- ;;
- m68*-apollo)
- os=-domain
- ;;
- i386-sun)
- os=-sunos4.0.2
- ;;
- m68000-sun)
- os=-sunos3
- # This also exists in the configure program, but was not the
- # default.
- # os=-sunos4
- ;;
- m68*-cisco)
- os=-aout
- ;;
- mips*-cisco)
- os=-elf
- ;;
- mips*-*)
- os=-elf
- ;;
- or32-*)
- os=-coff
- ;;
- *-tti) # must be before sparc entry or we get the wrong os.
- os=-sysv3
- ;;
- sparc-* | *-sun)
- os=-sunos4.1.1
- ;;
- *-be)
- os=-beos
- ;;
- *-ibm)
- os=-aix
- ;;
- *-wec)
- os=-proelf
- ;;
- *-winbond)
- os=-proelf
- ;;
- *-oki)
- os=-proelf
- ;;
- *-hp)
- os=-hpux
- ;;
- *-hitachi)
- os=-hiux
- ;;
- i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)
- os=-sysv
- ;;
- *-cbm)
- os=-amigaos
- ;;
- *-dg)
- os=-dgux
- ;;
- *-dolphin)
- os=-sysv3
- ;;
- m68k-ccur)
- os=-rtu
- ;;
- m88k-omron*)
- os=-luna
- ;;
- *-next )
- os=-nextstep
- ;;
- *-sequent)
- os=-ptx
- ;;
- *-crds)
- os=-unos
- ;;
- *-ns)
- os=-genix
- ;;
- i370-*)
- os=-mvs
- ;;
- *-next)
- os=-nextstep3
- ;;
- *-gould)
- os=-sysv
- ;;
- *-highlevel)
- os=-bsd
- ;;
- *-encore)
- os=-bsd
- ;;
- *-sgi)
- os=-irix
- ;;
- *-siemens)
- os=-sysv4
- ;;
- *-masscomp)
- os=-rtu
- ;;
- f30[01]-fujitsu | f700-fujitsu)
- os=-uxpv
- ;;
- *-rom68k)
- os=-coff
- ;;
- *-*bug)
- os=-coff
- ;;
- *-apple)
- os=-macos
- ;;
- *-atari*)
- os=-mint
- ;;
- *)
- os=-none
- ;;
-esac
-fi
-
-# Here we handle the case where we know the os, and the CPU type, but not the
-# manufacturer. We pick the logical manufacturer.
-vendor=unknown
-case $basic_machine in
- *-unknown)
- case $os in
- -riscix*)
- vendor=acorn
- ;;
- -sunos*)
- vendor=sun
- ;;
- -aix*)
- vendor=ibm
- ;;
- -beos*)
- vendor=be
- ;;
- -hpux*)
- vendor=hp
- ;;
- -mpeix*)
- vendor=hp
- ;;
- -hiux*)
- vendor=hitachi
- ;;
- -unos*)
- vendor=crds
- ;;
- -dgux*)
- vendor=dg
- ;;
- -luna*)
- vendor=omron
- ;;
- -genix*)
- vendor=ns
- ;;
- -mvs* | -opened*)
- vendor=ibm
- ;;
- -ptx*)
- vendor=sequent
- ;;
- -vxsim* | -vxworks* | -windiss*)
- vendor=wrs
- ;;
- -aux*)
- vendor=apple
- ;;
- -hms*)
- vendor=hitachi
- ;;
- -mpw* | -macos*)
- vendor=apple
- ;;
- -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
- vendor=atari
- ;;
- -vos*)
- vendor=stratus
- ;;
- esac
- basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`
- ;;
-esac
-
-echo $basic_machine$os
-exit 0
-
-# Local variables:
-# eval: (add-hook 'write-file-hooks 'time-stamp)
-# time-stamp-start: "timestamp='"
-# time-stamp-format: "%:y-%02m-%02d"
-# time-stamp-end: "'"
-# End:
diff --git a/cil/configure b/cil/configure
deleted file mode 100755
index fe8634bf07653d5bdf368406b27b129261d5d59b..0000000000000000000000000000000000000000
--- a/cil/configure
+++ /dev/null
@@ -1,5697 +0,0 @@
-#! /bin/sh
-# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.59.
-#
-# Copyright (C) 2003 Free Software Foundation, Inc.
-# This configure script is free software; the Free Software Foundation
-# gives unlimited permission to copy, distribute and modify it.
-## --------------------- ##
-## M4sh Initialization. ##
-## --------------------- ##
-
-# Be Bourne compatible
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
- emulate sh
- NULLCMD=:
- # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
- # is contrary to our usage. Disable this feature.
- alias -g '${1+"$@"}'='"$@"'
-elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
- set -o posix
-fi
-DUALCASE=1; export DUALCASE # for MKS sh
-
-# Support unset when possible.
-if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
- as_unset=unset
-else
- as_unset=false
-fi
-
-
-# Work around bugs in pre-3.0 UWIN ksh.
-$as_unset ENV MAIL MAILPATH
-PS1='$ '
-PS2='> '
-PS4='+ '
-
-# NLS nuisances.
-for as_var in \
- LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
- LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
- LC_TELEPHONE LC_TIME
-do
- if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
- eval $as_var=C; export $as_var
- else
- $as_unset $as_var
- fi
-done
-
-# Required to use basename.
-if expr a : '\(a\)' >/dev/null 2>&1; then
- as_expr=expr
-else
- as_expr=false
-fi
-
-if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
- as_basename=basename
-else
- as_basename=false
-fi
-
-
-# Name of the executable.
-as_me=`$as_basename "$0" ||
-$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
- X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)$' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X/"$0" |
- sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
- /^X\/\(\/\/\)$/{ s//\1/; q; }
- /^X\/\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
-
-
-# PATH needs CR, and LINENO needs CR and PATH.
-# Avoid depending upon Character Ranges.
-as_cr_letters='abcdefghijklmnopqrstuvwxyz'
-as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
-as_cr_Letters=$as_cr_letters$as_cr_LETTERS
-as_cr_digits='0123456789'
-as_cr_alnum=$as_cr_Letters$as_cr_digits
-
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- echo "#! /bin/sh" >conf$$.sh
- echo "exit 0" >>conf$$.sh
- chmod +x conf$$.sh
- if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
- PATH_SEPARATOR=';'
- else
- PATH_SEPARATOR=:
- fi
- rm -f conf$$.sh
-fi
-
-
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" || {
- # Find who we are. Look in the path if we contain no path at all
- # relative or not.
- case $0 in
- *[\\/]* ) as_myself=$0 ;;
- *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
-done
-
- ;;
- esac
- # We did not find ourselves, most probably we were run as `sh COMMAND'
- # in which case we are not to be found in the path.
- if test "x$as_myself" = x; then
- as_myself=$0
- fi
- if test ! -f "$as_myself"; then
- { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2
- { (exit 1); exit 1; }; }
- fi
- case $CONFIG_SHELL in
- '')
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for as_base in sh bash ksh sh5; do
- case $as_dir in
- /*)
- if ("$as_dir/$as_base" -c '
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
- $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
- $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
- CONFIG_SHELL=$as_dir/$as_base
- export CONFIG_SHELL
- exec "$CONFIG_SHELL" "$0" ${1+"$@"}
- fi;;
- esac
- done
-done
-;;
- esac
-
- # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
- # uniformly replaced by the line number. The first 'sed' inserts a
- # line-number line before each line; the second 'sed' does the real
- # work. The second script uses 'N' to pair each line-number line
- # with the numbered line, and appends trailing '-' during
- # substitution so that $LINENO is not a special case at line end.
- # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
- # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
- sed '=' <$as_myself |
- sed '
- N
- s,$,-,
- : loop
- s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
- t loop
- s,-$,,
- s,^['$as_cr_digits']*\n,,
- ' >$as_me.lineno &&
- chmod +x $as_me.lineno ||
- { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
- { (exit 1); exit 1; }; }
-
- # Don't try to exec as it changes $[0], causing all sort of problems
- # (the dirname of $[0] is not the place where we might find the
- # original and so on. Autoconf is especially sensible to this).
- . ./$as_me.lineno
- # Exit status is that of the last command.
- exit
-}
-
-
-case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
- *c*,-n*) ECHO_N= ECHO_C='
-' ECHO_T=' ' ;;
- *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
- *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
-esac
-
-if expr a : '\(a\)' >/dev/null 2>&1; then
- as_expr=expr
-else
- as_expr=false
-fi
-
-rm -f conf$$ conf$$.exe conf$$.file
-echo >conf$$.file
-if ln -s conf$$.file conf$$ 2>/dev/null; then
- # We could just check for DJGPP; but this test a) works b) is more generic
- # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
- if test -f conf$$.exe; then
- # Don't use ln at all; we don't have any links
- as_ln_s='cp -p'
- else
- as_ln_s='ln -s'
- fi
-elif ln conf$$.file conf$$ 2>/dev/null; then
- as_ln_s=ln
-else
- as_ln_s='cp -p'
-fi
-rm -f conf$$ conf$$.exe conf$$.file
-
-if mkdir -p . 2>/dev/null; then
- as_mkdir_p=:
-else
- test -d ./-p && rmdir ./-p
- as_mkdir_p=false
-fi
-
-as_executable_p="test -f"
-
-# Sed expression to map a string onto a valid CPP name.
-as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
-
-# Sed expression to map a string onto a valid variable name.
-as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
-
-
-# IFS
-# We need space, tab and new line, in precisely that order.
-as_nl='
-'
-IFS=" $as_nl"
-
-# CDPATH.
-$as_unset CDPATH
-
-
-# Name of the host.
-# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
-# so uname gets run too.
-ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
-
-exec 6>&1
-
-#
-# Initializations.
-#
-ac_default_prefix=/usr/local
-ac_config_libobj_dir=.
-cross_compiling=no
-subdirs=
-MFLAGS=
-MAKEFLAGS=
-SHELL=${CONFIG_SHELL-/bin/sh}
-
-# Maximum number of lines to put in a shell here document.
-# This variable seems obsolete. It should probably be removed, and
-# only ac_max_sed_lines should be used.
-: ${ac_max_here_lines=38}
-
-# Identity of this package.
-PACKAGE_NAME=
-PACKAGE_TARNAME=
-PACKAGE_VERSION=
-PACKAGE_STRING=
-PACKAGE_BUGREPORT=
-
-ac_unique_file="src/cil.mli"
-# Factoring default headers for most tests.
-ac_includes_default="\
-#include <stdio.h>
-#if HAVE_SYS_TYPES_H
-# include <sys/types.h>
-#endif
-#if HAVE_SYS_STAT_H
-# include <sys/stat.h>
-#endif
-#if STDC_HEADERS
-# include <stdlib.h>
-# include <stddef.h>
-#else
-# if HAVE_STDLIB_H
-# include <stdlib.h>
-# endif
-#endif
-#if HAVE_STRING_H
-# if !STDC_HEADERS && HAVE_MEMORY_H
-# include <memory.h>
-# endif
-# include <string.h>
-#endif
-#if HAVE_STRINGS_H
-# include <strings.h>
-#endif
-#if HAVE_INTTYPES_H
-# include <inttypes.h>
-#else
-# if HAVE_STDINT_H
-# include <stdint.h>
-# endif
-#endif
-#if HAVE_UNISTD_H
-# include <unistd.h>
-#endif"
-
-ac_subst_vars='CIL_FEATURES_DEFINES NEWLINE SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os CPP EGREP LIBOBJS ARCHOS CILHOME HAS_MSVC DEFAULT_COMPILER DEFAULT_CIL_MODE CIL_VERSION_MAJOR CIL_VERSION_MINOR CIL_VERSION_REV CIL_VERSION CYCLES_PER_USEC HAS_PERFCOUNT HAVE_BUILTIN_VA_LIST THREAD_IS_KEYWORD UNDERSCORE_NAME EXTRAFEATURES EXTRASRCDIRS LTLIBOBJS'
-ac_subst_files=''
-
-# Initialize some variables set by options.
-ac_init_help=
-ac_init_version=false
-# The variables have the same names as the options, with
-# dashes changed to underlines.
-cache_file=/dev/null
-exec_prefix=NONE
-no_create=
-no_recursion=
-prefix=NONE
-program_prefix=NONE
-program_suffix=NONE
-program_transform_name=s,x,x,
-silent=
-site=
-srcdir=
-verbose=
-x_includes=NONE
-x_libraries=NONE
-
-# Installation directory options.
-# These are left unexpanded so users can "make install exec_prefix=/foo"
-# and all the variables that are supposed to be based on exec_prefix
-# by default will actually change.
-# Use braces instead of parens because sh, perl, etc. also accept them.
-bindir='${exec_prefix}/bin'
-sbindir='${exec_prefix}/sbin'
-libexecdir='${exec_prefix}/libexec'
-datadir='${prefix}/share'
-sysconfdir='${prefix}/etc'
-sharedstatedir='${prefix}/com'
-localstatedir='${prefix}/var'
-libdir='${exec_prefix}/lib'
-includedir='${prefix}/include'
-oldincludedir='/usr/include'
-infodir='${prefix}/info'
-mandir='${prefix}/man'
-
-ac_prev=
-for ac_option
-do
- # If the previous option needs an argument, assign it.
- if test -n "$ac_prev"; then
- eval "$ac_prev=\$ac_option"
- ac_prev=
- continue
- fi
-
- ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'`
-
- # Accept the important Cygnus configure options, so we can diagnose typos.
-
- case $ac_option in
-
- -bindir | --bindir | --bindi | --bind | --bin | --bi)
- ac_prev=bindir ;;
- -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
- bindir=$ac_optarg ;;
-
- -build | --build | --buil | --bui | --bu)
- ac_prev=build_alias ;;
- -build=* | --build=* | --buil=* | --bui=* | --bu=*)
- build_alias=$ac_optarg ;;
-
- -cache-file | --cache-file | --cache-fil | --cache-fi \
- | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
- ac_prev=cache_file ;;
- -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
- | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
- cache_file=$ac_optarg ;;
-
- --config-cache | -C)
- cache_file=config.cache ;;
-
- -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
- ac_prev=datadir ;;
- -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
- | --da=*)
- datadir=$ac_optarg ;;
-
- -disable-* | --disable-*)
- ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
- # Reject names that are not valid shell variable names.
- expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid feature name: $ac_feature" >&2
- { (exit 1); exit 1; }; }
- ac_feature=`echo $ac_feature | sed 's/-/_/g'`
- eval "enable_$ac_feature=no" ;;
-
- -enable-* | --enable-*)
- ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
- # Reject names that are not valid shell variable names.
- expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid feature name: $ac_feature" >&2
- { (exit 1); exit 1; }; }
- ac_feature=`echo $ac_feature | sed 's/-/_/g'`
- case $ac_option in
- *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
- *) ac_optarg=yes ;;
- esac
- eval "enable_$ac_feature='$ac_optarg'" ;;
-
- -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
- | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
- | --exec | --exe | --ex)
- ac_prev=exec_prefix ;;
- -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
- | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
- | --exec=* | --exe=* | --ex=*)
- exec_prefix=$ac_optarg ;;
-
- -gas | --gas | --ga | --g)
- # Obsolete; use --with-gas.
- with_gas=yes ;;
-
- -help | --help | --hel | --he | -h)
- ac_init_help=long ;;
- -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)
- ac_init_help=recursive ;;
- -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)
- ac_init_help=short ;;
-
- -host | --host | --hos | --ho)
- ac_prev=host_alias ;;
- -host=* | --host=* | --hos=* | --ho=*)
- host_alias=$ac_optarg ;;
-
- -includedir | --includedir | --includedi | --included | --include \
- | --includ | --inclu | --incl | --inc)
- ac_prev=includedir ;;
- -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
- | --includ=* | --inclu=* | --incl=* | --inc=*)
- includedir=$ac_optarg ;;
-
- -infodir | --infodir | --infodi | --infod | --info | --inf)
- ac_prev=infodir ;;
- -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
- infodir=$ac_optarg ;;
-
- -libdir | --libdir | --libdi | --libd)
- ac_prev=libdir ;;
- -libdir=* | --libdir=* | --libdi=* | --libd=*)
- libdir=$ac_optarg ;;
-
- -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
- | --libexe | --libex | --libe)
- ac_prev=libexecdir ;;
- -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
- | --libexe=* | --libex=* | --libe=*)
- libexecdir=$ac_optarg ;;
-
- -localstatedir | --localstatedir | --localstatedi | --localstated \
- | --localstate | --localstat | --localsta | --localst \
- | --locals | --local | --loca | --loc | --lo)
- ac_prev=localstatedir ;;
- -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
- | --localstate=* | --localstat=* | --localsta=* | --localst=* \
- | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
- localstatedir=$ac_optarg ;;
-
- -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
- ac_prev=mandir ;;
- -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
- mandir=$ac_optarg ;;
-
- -nfp | --nfp | --nf)
- # Obsolete; use --without-fp.
- with_fp=no ;;
-
- -no-create | --no-create | --no-creat | --no-crea | --no-cre \
- | --no-cr | --no-c | -n)
- no_create=yes ;;
-
- -no-recursion | --no-recursion | --no-recursio | --no-recursi \
- | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
- no_recursion=yes ;;
-
- -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
- | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
- | --oldin | --oldi | --old | --ol | --o)
- ac_prev=oldincludedir ;;
- -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
- | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
- | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
- oldincludedir=$ac_optarg ;;
-
- -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
- ac_prev=prefix ;;
- -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
- prefix=$ac_optarg ;;
-
- -program-prefix | --program-prefix | --program-prefi | --program-pref \
- | --program-pre | --program-pr | --program-p)
- ac_prev=program_prefix ;;
- -program-prefix=* | --program-prefix=* | --program-prefi=* \
- | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
- program_prefix=$ac_optarg ;;
-
- -program-suffix | --program-suffix | --program-suffi | --program-suff \
- | --program-suf | --program-su | --program-s)
- ac_prev=program_suffix ;;
- -program-suffix=* | --program-suffix=* | --program-suffi=* \
- | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
- program_suffix=$ac_optarg ;;
-
- -program-transform-name | --program-transform-name \
- | --program-transform-nam | --program-transform-na \
- | --program-transform-n | --program-transform- \
- | --program-transform | --program-transfor \
- | --program-transfo | --program-transf \
- | --program-trans | --program-tran \
- | --progr-tra | --program-tr | --program-t)
- ac_prev=program_transform_name ;;
- -program-transform-name=* | --program-transform-name=* \
- | --program-transform-nam=* | --program-transform-na=* \
- | --program-transform-n=* | --program-transform-=* \
- | --program-transform=* | --program-transfor=* \
- | --program-transfo=* | --program-transf=* \
- | --program-trans=* | --program-tran=* \
- | --progr-tra=* | --program-tr=* | --program-t=*)
- program_transform_name=$ac_optarg ;;
-
- -q | -quiet | --quiet | --quie | --qui | --qu | --q \
- | -silent | --silent | --silen | --sile | --sil)
- silent=yes ;;
-
- -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
- ac_prev=sbindir ;;
- -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
- | --sbi=* | --sb=*)
- sbindir=$ac_optarg ;;
-
- -sharedstatedir | --sharedstatedir | --sharedstatedi \
- | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
- | --sharedst | --shareds | --shared | --share | --shar \
- | --sha | --sh)
- ac_prev=sharedstatedir ;;
- -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
- | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
- | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
- | --sha=* | --sh=*)
- sharedstatedir=$ac_optarg ;;
-
- -site | --site | --sit)
- ac_prev=site ;;
- -site=* | --site=* | --sit=*)
- site=$ac_optarg ;;
-
- -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
- ac_prev=srcdir ;;
- -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
- srcdir=$ac_optarg ;;
-
- -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
- | --syscon | --sysco | --sysc | --sys | --sy)
- ac_prev=sysconfdir ;;
- -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
- | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
- sysconfdir=$ac_optarg ;;
-
- -target | --target | --targe | --targ | --tar | --ta | --t)
- ac_prev=target_alias ;;
- -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
- target_alias=$ac_optarg ;;
-
- -v | -verbose | --verbose | --verbos | --verbo | --verb)
- verbose=yes ;;
-
- -version | --version | --versio | --versi | --vers | -V)
- ac_init_version=: ;;
-
- -with-* | --with-*)
- ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
- # Reject names that are not valid shell variable names.
- expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid package name: $ac_package" >&2
- { (exit 1); exit 1; }; }
- ac_package=`echo $ac_package| sed 's/-/_/g'`
- case $ac_option in
- *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
- *) ac_optarg=yes ;;
- esac
- eval "with_$ac_package='$ac_optarg'" ;;
-
- -without-* | --without-*)
- ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`
- # Reject names that are not valid shell variable names.
- expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid package name: $ac_package" >&2
- { (exit 1); exit 1; }; }
- ac_package=`echo $ac_package | sed 's/-/_/g'`
- eval "with_$ac_package=no" ;;
-
- --x)
- # Obsolete; use --with-x.
- with_x=yes ;;
-
- -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
- | --x-incl | --x-inc | --x-in | --x-i)
- ac_prev=x_includes ;;
- -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
- | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
- x_includes=$ac_optarg ;;
-
- -x-libraries | --x-libraries | --x-librarie | --x-librari \
- | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
- ac_prev=x_libraries ;;
- -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
- | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
- x_libraries=$ac_optarg ;;
-
- -*) { echo "$as_me: error: unrecognized option: $ac_option
-Try \`$0 --help' for more information." >&2
- { (exit 1); exit 1; }; }
- ;;
-
- *=*)
- ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
- # Reject names that are not valid shell variable names.
- expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid variable name: $ac_envvar" >&2
- { (exit 1); exit 1; }; }
- ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`
- eval "$ac_envvar='$ac_optarg'"
- export $ac_envvar ;;
-
- *)
- # FIXME: should be removed in autoconf 3.0.
- echo "$as_me: WARNING: you should use --build, --host, --target" >&2
- expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
- echo "$as_me: WARNING: invalid host type: $ac_option" >&2
- : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
- ;;
-
- esac
-done
-
-if test -n "$ac_prev"; then
- ac_option=--`echo $ac_prev | sed 's/_/-/g'`
- { echo "$as_me: error: missing argument to $ac_option" >&2
- { (exit 1); exit 1; }; }
-fi
-
-# Be sure to have absolute paths.
-for ac_var in exec_prefix prefix
-do
- eval ac_val=$`echo $ac_var`
- case $ac_val in
- [\\/$]* | ?:[\\/]* | NONE | '' ) ;;
- *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
- { (exit 1); exit 1; }; };;
- esac
-done
-
-# Be sure to have absolute paths.
-for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \
- localstatedir libdir includedir oldincludedir infodir mandir
-do
- eval ac_val=$`echo $ac_var`
- case $ac_val in
- [\\/$]* | ?:[\\/]* ) ;;
- *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
- { (exit 1); exit 1; }; };;
- esac
-done
-
-# There might be people who depend on the old broken behavior: `$host'
-# used to hold the argument of --host etc.
-# FIXME: To remove some day.
-build=$build_alias
-host=$host_alias
-target=$target_alias
-
-# FIXME: To remove some day.
-if test "x$host_alias" != x; then
- if test "x$build_alias" = x; then
- cross_compiling=maybe
- echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
- If a cross compiler is detected then cross compile mode will be used." >&2
- elif test "x$build_alias" != "x$host_alias"; then
- cross_compiling=yes
- fi
-fi
-
-ac_tool_prefix=
-test -n "$host_alias" && ac_tool_prefix=$host_alias-
-
-test "$silent" = yes && exec 6>/dev/null
-
-
-# Find the source files, if location was not specified.
-if test -z "$srcdir"; then
- ac_srcdir_defaulted=yes
- # Try the directory containing this script, then its parent.
- ac_confdir=`(dirname "$0") 2>/dev/null ||
-$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$0" : 'X\(//\)[^/]' \| \
- X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$0" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- srcdir=$ac_confdir
- if test ! -r $srcdir/$ac_unique_file; then
- srcdir=..
- fi
-else
- ac_srcdir_defaulted=no
-fi
-if test ! -r $srcdir/$ac_unique_file; then
- if test "$ac_srcdir_defaulted" = yes; then
- { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2
- { (exit 1); exit 1; }; }
- else
- { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
- { (exit 1); exit 1; }; }
- fi
-fi
-(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null ||
- { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2
- { (exit 1); exit 1; }; }
-srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'`
-ac_env_build_alias_set=${build_alias+set}
-ac_env_build_alias_value=$build_alias
-ac_cv_env_build_alias_set=${build_alias+set}
-ac_cv_env_build_alias_value=$build_alias
-ac_env_host_alias_set=${host_alias+set}
-ac_env_host_alias_value=$host_alias
-ac_cv_env_host_alias_set=${host_alias+set}
-ac_cv_env_host_alias_value=$host_alias
-ac_env_target_alias_set=${target_alias+set}
-ac_env_target_alias_value=$target_alias
-ac_cv_env_target_alias_set=${target_alias+set}
-ac_cv_env_target_alias_value=$target_alias
-ac_env_CC_set=${CC+set}
-ac_env_CC_value=$CC
-ac_cv_env_CC_set=${CC+set}
-ac_cv_env_CC_value=$CC
-ac_env_CFLAGS_set=${CFLAGS+set}
-ac_env_CFLAGS_value=$CFLAGS
-ac_cv_env_CFLAGS_set=${CFLAGS+set}
-ac_cv_env_CFLAGS_value=$CFLAGS
-ac_env_LDFLAGS_set=${LDFLAGS+set}
-ac_env_LDFLAGS_value=$LDFLAGS
-ac_cv_env_LDFLAGS_set=${LDFLAGS+set}
-ac_cv_env_LDFLAGS_value=$LDFLAGS
-ac_env_CPPFLAGS_set=${CPPFLAGS+set}
-ac_env_CPPFLAGS_value=$CPPFLAGS
-ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set}
-ac_cv_env_CPPFLAGS_value=$CPPFLAGS
-ac_env_CPP_set=${CPP+set}
-ac_env_CPP_value=$CPP
-ac_cv_env_CPP_set=${CPP+set}
-ac_cv_env_CPP_value=$CPP
-
-#
-# Report the --help message.
-#
-if test "$ac_init_help" = "long"; then
- # Omit some internal or obsolete options to make the list less imposing.
- # This message is too long to be a string in the A/UX 3.1 sh.
- cat <<_ACEOF
-\`configure' configures this package to adapt to many kinds of systems.
-
-Usage: $0 [OPTION]... [VAR=VALUE]...
-
-To assign environment variables (e.g., CC, CFLAGS...), specify them as
-VAR=VALUE. See below for descriptions of some of the useful variables.
-
-Defaults for the options are specified in brackets.
-
-Configuration:
- -h, --help display this help and exit
- --help=short display options specific to this package
- --help=recursive display the short help of all the included packages
- -V, --version display version information and exit
- -q, --quiet, --silent do not print \`checking...' messages
- --cache-file=FILE cache test results in FILE [disabled]
- -C, --config-cache alias for \`--cache-file=config.cache'
- -n, --no-create do not create output files
- --srcdir=DIR find the sources in DIR [configure dir or \`..']
-
-_ACEOF
-
- cat <<_ACEOF
-Installation directories:
- --prefix=PREFIX install architecture-independent files in PREFIX
- [$ac_default_prefix]
- --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
- [PREFIX]
-
-By default, \`make install' will install all the files in
-\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify
-an installation prefix other than \`$ac_default_prefix' using \`--prefix',
-for instance \`--prefix=\$HOME'.
-
-For better control, use the options below.
-
-Fine tuning of the installation directories:
- --bindir=DIR user executables [EPREFIX/bin]
- --sbindir=DIR system admin executables [EPREFIX/sbin]
- --libexecdir=DIR program executables [EPREFIX/libexec]
- --datadir=DIR read-only architecture-independent data [PREFIX/share]
- --sysconfdir=DIR read-only single-machine data [PREFIX/etc]
- --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
- --localstatedir=DIR modifiable single-machine data [PREFIX/var]
- --libdir=DIR object code libraries [EPREFIX/lib]
- --includedir=DIR C header files [PREFIX/include]
- --oldincludedir=DIR C header files for non-gcc [/usr/include]
- --infodir=DIR info documentation [PREFIX/info]
- --mandir=DIR man documentation [PREFIX/man]
-_ACEOF
-
- cat <<\_ACEOF
-
-System types:
- --build=BUILD configure for building on BUILD [guessed]
- --host=HOST cross-compile to build programs to run on HOST [BUILD]
- --target=TARGET configure for building compilers for TARGET [HOST]
-_ACEOF
-fi
-
-if test -n "$ac_init_help"; then
-
- cat <<\_ACEOF
-
-Optional Packages:
- --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
- --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
- --with-blockinggraph enable the blocking graph feature
- --with-rand enable the randomized value numbering
- --with-arithabs enable the arithmetic abstraction
- --with-zrapp enable the zrapp pretty-printer
-
-Some influential environment variables:
- CC C compiler command
- CFLAGS C compiler flags
- LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a
- nonstandard directory <lib dir>
- CPPFLAGS C/C++ preprocessor flags, e.g. -I<include dir> if you have
- headers in a nonstandard directory <include dir>
- CPP C preprocessor
-
-Use these variables to override the choices made by `configure' or to help
-it to find libraries and programs with nonstandard names/locations.
-
-_ACEOF
-fi
-
-if test "$ac_init_help" = "recursive"; then
- # If there are subdirs, report their specific --help.
- ac_popdir=`pwd`
- for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
- test -d $ac_dir || continue
- ac_builddir=.
-
-if test "$ac_dir" != .; then
- ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
- # A "../" for each directory in $ac_dir_suffix.
- ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
-else
- ac_dir_suffix= ac_top_builddir=
-fi
-
-case $srcdir in
- .) # No --srcdir option. We are building in place.
- ac_srcdir=.
- if test -z "$ac_top_builddir"; then
- ac_top_srcdir=.
- else
- ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
- fi ;;
- [\\/]* | ?:[\\/]* ) # Absolute path.
- ac_srcdir=$srcdir$ac_dir_suffix;
- ac_top_srcdir=$srcdir ;;
- *) # Relative path.
- ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
- ac_top_srcdir=$ac_top_builddir$srcdir ;;
-esac
-
-# Do not use `cd foo && pwd` to compute absolute paths, because
-# the directories may not exist.
-case `pwd` in
-.) ac_abs_builddir="$ac_dir";;
-*)
- case "$ac_dir" in
- .) ac_abs_builddir=`pwd`;;
- [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
- *) ac_abs_builddir=`pwd`/"$ac_dir";;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_builddir=${ac_top_builddir}.;;
-*)
- case ${ac_top_builddir}. in
- .) ac_abs_top_builddir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
- *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_srcdir=$ac_srcdir;;
-*)
- case $ac_srcdir in
- .) ac_abs_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
- *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_srcdir=$ac_top_srcdir;;
-*)
- case $ac_top_srcdir in
- .) ac_abs_top_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
- *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
- esac;;
-esac
-
- cd $ac_dir
- # Check for guested configure; otherwise get Cygnus style configure.
- if test -f $ac_srcdir/configure.gnu; then
- echo
- $SHELL $ac_srcdir/configure.gnu --help=recursive
- elif test -f $ac_srcdir/configure; then
- echo
- $SHELL $ac_srcdir/configure --help=recursive
- elif test -f $ac_srcdir/configure.ac ||
- test -f $ac_srcdir/configure.in; then
- echo
- $ac_configure --help
- else
- echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
- fi
- cd $ac_popdir
- done
-fi
-
-test -n "$ac_init_help" && exit 0
-if $ac_init_version; then
- cat <<\_ACEOF
-
-Copyright (C) 2003 Free Software Foundation, Inc.
-This configure script is free software; the Free Software Foundation
-gives unlimited permission to copy, distribute and modify it.
-_ACEOF
- exit 0
-fi
-exec 5>config.log
-cat >&5 <<_ACEOF
-This file contains any messages produced by compilers while
-running configure, to aid debugging if configure makes a mistake.
-
-It was created by $as_me, which was
-generated by GNU Autoconf 2.59. Invocation command line was
-
- $ $0 $@
-
-_ACEOF
-{
-cat <<_ASUNAME
-## --------- ##
-## Platform. ##
-## --------- ##
-
-hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
-uname -m = `(uname -m) 2>/dev/null || echo unknown`
-uname -r = `(uname -r) 2>/dev/null || echo unknown`
-uname -s = `(uname -s) 2>/dev/null || echo unknown`
-uname -v = `(uname -v) 2>/dev/null || echo unknown`
-
-/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
-/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown`
-
-/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown`
-/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown`
-/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
-hostinfo = `(hostinfo) 2>/dev/null || echo unknown`
-/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown`
-/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown`
-/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown`
-
-_ASUNAME
-
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- echo "PATH: $as_dir"
-done
-
-} >&5
-
-cat >&5 <<_ACEOF
-
-
-## ----------- ##
-## Core tests. ##
-## ----------- ##
-
-_ACEOF
-
-
-# Keep a trace of the command line.
-# Strip out --no-create and --no-recursion so they do not pile up.
-# Strip out --silent because we don't want to record it for future runs.
-# Also quote any args containing shell meta-characters.
-# Make two passes to allow for proper duplicate-argument suppression.
-ac_configure_args=
-ac_configure_args0=
-ac_configure_args1=
-ac_sep=
-ac_must_keep_next=false
-for ac_pass in 1 2
-do
- for ac_arg
- do
- case $ac_arg in
- -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
- -q | -quiet | --quiet | --quie | --qui | --qu | --q \
- | -silent | --silent | --silen | --sile | --sil)
- continue ;;
- *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
- ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
- esac
- case $ac_pass in
- 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;
- 2)
- ac_configure_args1="$ac_configure_args1 '$ac_arg'"
- if test $ac_must_keep_next = true; then
- ac_must_keep_next=false # Got value, back to normal.
- else
- case $ac_arg in
- *=* | --config-cache | -C | -disable-* | --disable-* \
- | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
- | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
- | -with-* | --with-* | -without-* | --without-* | --x)
- case "$ac_configure_args0 " in
- "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
- esac
- ;;
- -* ) ac_must_keep_next=true ;;
- esac
- fi
- ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'"
- # Get rid of the leading space.
- ac_sep=" "
- ;;
- esac
- done
-done
-$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }
-$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; }
-
-# When interrupted or exit'd, cleanup temporary files, and complete
-# config.log. We remove comments because anyway the quotes in there
-# would cause problems or look ugly.
-# WARNING: Be sure not to use single quotes in there, as some shells,
-# such as our DU 5.0 friend, will then `close' the trap.
-trap 'exit_status=$?
- # Save into config.log some information that might help in debugging.
- {
- echo
-
- cat <<\_ASBOX
-## ---------------- ##
-## Cache variables. ##
-## ---------------- ##
-_ASBOX
- echo
- # The following way of writing the cache mishandles newlines in values,
-{
- (set) 2>&1 |
- case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in
- *ac_space=\ *)
- sed -n \
- "s/'"'"'/'"'"'\\\\'"'"''"'"'/g;
- s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p"
- ;;
- *)
- sed -n \
- "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
- ;;
- esac;
-}
- echo
-
- cat <<\_ASBOX
-## ----------------- ##
-## Output variables. ##
-## ----------------- ##
-_ASBOX
- echo
- for ac_var in $ac_subst_vars
- do
- eval ac_val=$`echo $ac_var`
- echo "$ac_var='"'"'$ac_val'"'"'"
- done | sort
- echo
-
- if test -n "$ac_subst_files"; then
- cat <<\_ASBOX
-## ------------- ##
-## Output files. ##
-## ------------- ##
-_ASBOX
- echo
- for ac_var in $ac_subst_files
- do
- eval ac_val=$`echo $ac_var`
- echo "$ac_var='"'"'$ac_val'"'"'"
- done | sort
- echo
- fi
-
- if test -s confdefs.h; then
- cat <<\_ASBOX
-## ----------- ##
-## confdefs.h. ##
-## ----------- ##
-_ASBOX
- echo
- sed "/^$/d" confdefs.h | sort
- echo
- fi
- test "$ac_signal" != 0 &&
- echo "$as_me: caught signal $ac_signal"
- echo "$as_me: exit $exit_status"
- } >&5
- rm -f core *.core &&
- rm -rf conftest* confdefs* conf$$* $ac_clean_files &&
- exit $exit_status
- ' 0
-for ac_signal in 1 2 13 15; do
- trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal
-done
-ac_signal=0
-
-# confdefs.h avoids OS command line length limits that DEFS can exceed.
-rm -rf conftest* confdefs.h
-# AIX cpp loses on an empty file, so make sure it contains at least a newline.
-echo >confdefs.h
-
-# Predefined preprocessor variables.
-
-cat >>confdefs.h <<_ACEOF
-#define PACKAGE_NAME "$PACKAGE_NAME"
-_ACEOF
-
-
-cat >>confdefs.h <<_ACEOF
-#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
-_ACEOF
-
-
-cat >>confdefs.h <<_ACEOF
-#define PACKAGE_VERSION "$PACKAGE_VERSION"
-_ACEOF
-
-
-cat >>confdefs.h <<_ACEOF
-#define PACKAGE_STRING "$PACKAGE_STRING"
-_ACEOF
-
-
-cat >>confdefs.h <<_ACEOF
-#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
-_ACEOF
-
-
-# Let the site file select an alternate cache file if it wants to.
-# Prefer explicitly selected file to automatically selected ones.
-if test -z "$CONFIG_SITE"; then
- if test "x$prefix" != xNONE; then
- CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
- else
- CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
- fi
-fi
-for ac_site_file in $CONFIG_SITE; do
- if test -r "$ac_site_file"; then
- { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5
-echo "$as_me: loading site script $ac_site_file" >&6;}
- sed 's/^/| /' "$ac_site_file" >&5
- . "$ac_site_file"
- fi
-done
-
-if test -r "$cache_file"; then
- # Some versions of bash will fail to source /dev/null (special
- # files actually), so we avoid doing that.
- if test -f "$cache_file"; then
- { echo "$as_me:$LINENO: loading cache $cache_file" >&5
-echo "$as_me: loading cache $cache_file" >&6;}
- case $cache_file in
- [\\/]* | ?:[\\/]* ) . $cache_file;;
- *) . ./$cache_file;;
- esac
- fi
-else
- { echo "$as_me:$LINENO: creating cache $cache_file" >&5
-echo "$as_me: creating cache $cache_file" >&6;}
- >$cache_file
-fi
-
-# Check that the precious variables saved in the cache have kept the same
-# value.
-ac_cache_corrupted=false
-for ac_var in `(set) 2>&1 |
- sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do
- eval ac_old_set=\$ac_cv_env_${ac_var}_set
- eval ac_new_set=\$ac_env_${ac_var}_set
- eval ac_old_val="\$ac_cv_env_${ac_var}_value"
- eval ac_new_val="\$ac_env_${ac_var}_value"
- case $ac_old_set,$ac_new_set in
- set,)
- { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
-echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
- ac_cache_corrupted=: ;;
- ,set)
- { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5
-echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
- ac_cache_corrupted=: ;;
- ,);;
- *)
- if test "x$ac_old_val" != "x$ac_new_val"; then
- { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5
-echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
- { echo "$as_me:$LINENO: former value: $ac_old_val" >&5
-echo "$as_me: former value: $ac_old_val" >&2;}
- { echo "$as_me:$LINENO: current value: $ac_new_val" >&5
-echo "$as_me: current value: $ac_new_val" >&2;}
- ac_cache_corrupted=:
- fi;;
- esac
- # Pass precious variables to config.status.
- if test "$ac_new_set" = set; then
- case $ac_new_val in
- *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
- ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
- *) ac_arg=$ac_var=$ac_new_val ;;
- esac
- case " $ac_configure_args " in
- *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy.
- *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;
- esac
- fi
-done
-if $ac_cache_corrupted; then
- { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5
-echo "$as_me: error: changes in the environment can compromise the build" >&2;}
- { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5
-echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}
- { (exit 1); exit 1; }; }
-fi
-
-ac_ext=c
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
-ac_compiler_gnu=$ac_cv_c_compiler_gnu
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- ac_config_headers="$ac_config_headers config.h"
-
-
-# sm: require a late-enough autoconf; this is the version number
-# that's on manju, so I assume it's ok
-
-
-#
-# Assign here the CIL version numbers
-CIL_VERSION_MAJOR=1
-CIL_VERSION_MINOR=3
-CIL_VERSION_REV=5
-CIL_VERSION=$CIL_VERSION_MAJOR.$CIL_VERSION_MINOR.$CIL_VERSION_REV
-
-
-# make sure I haven't forgotten to run autoconf
-if test configure -ot configure.in; then
- { { echo "$as_me:$LINENO: error: configure is older than configure.in; you forgot to run autoconf" >&5
-echo "$as_me: error: configure is older than configure.in; you forgot to run autoconf" >&2;}
- { (exit 1); exit 1; }; }
-fi
-
-# check for C compiler; this typically finds gcc; it sets the
-# variable CC to whatever it finds, which then gets substituted
-# for @CC@ in output files; you have to do this even if you don't
-# care about @CC@, because system feature tests later on in
-# the ./configure script will expect $CC to be set right
-ac_ext=c
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
-ac_compiler_gnu=$ac_cv_c_compiler_gnu
-if test -n "$ac_tool_prefix"; then
- # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
-set dummy ${ac_tool_prefix}gcc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- if test -n "$CC"; then
- ac_cv_prog_CC="$CC" # Let the user override the test.
-else
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
- ac_cv_prog_CC="${ac_tool_prefix}gcc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
-done
-
-fi
-fi
-CC=$ac_cv_prog_CC
-if test -n "$CC"; then
- echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6
-else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
-fi
-
-fi
-if test -z "$ac_cv_prog_CC"; then
- ac_ct_CC=$CC
- # Extract the first word of "gcc", so it can be a program name with args.
-set dummy gcc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- if test -n "$ac_ct_CC"; then
- ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
-else
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
- ac_cv_prog_ac_ct_CC="gcc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
-done
-
-fi
-fi
-ac_ct_CC=$ac_cv_prog_ac_ct_CC
-if test -n "$ac_ct_CC"; then
- echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
-echo "${ECHO_T}$ac_ct_CC" >&6
-else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
-fi
-
- CC=$ac_ct_CC
-else
- CC="$ac_cv_prog_CC"
-fi
-
-if test -z "$CC"; then
- if test -n "$ac_tool_prefix"; then
- # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
-set dummy ${ac_tool_prefix}cc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- if test -n "$CC"; then
- ac_cv_prog_CC="$CC" # Let the user override the test.
-else
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
- ac_cv_prog_CC="${ac_tool_prefix}cc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
-done
-
-fi
-fi
-CC=$ac_cv_prog_CC
-if test -n "$CC"; then
- echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6
-else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
-fi
-
-fi
-if test -z "$ac_cv_prog_CC"; then
- ac_ct_CC=$CC
- # Extract the first word of "cc", so it can be a program name with args.
-set dummy cc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- if test -n "$ac_ct_CC"; then
- ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
-else
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
- ac_cv_prog_ac_ct_CC="cc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
-done
-
-fi
-fi
-ac_ct_CC=$ac_cv_prog_ac_ct_CC
-if test -n "$ac_ct_CC"; then
- echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
-echo "${ECHO_T}$ac_ct_CC" >&6
-else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
-fi
-
- CC=$ac_ct_CC
-else
- CC="$ac_cv_prog_CC"
-fi
-
-fi
-if test -z "$CC"; then
- # Extract the first word of "cc", so it can be a program name with args.
-set dummy cc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- if test -n "$CC"; then
- ac_cv_prog_CC="$CC" # Let the user override the test.
-else
- ac_prog_rejected=no
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
- if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
- ac_prog_rejected=yes
- continue
- fi
- ac_cv_prog_CC="cc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
-done
-
-if test $ac_prog_rejected = yes; then
- # We found a bogon in the path, so make sure we never use it.
- set dummy $ac_cv_prog_CC
- shift
- if test $# != 0; then
- # We chose a different compiler from the bogus one.
- # However, it has the same basename, so the bogon will be chosen
- # first if we set CC to just the basename; use the full file name.
- shift
- ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"
- fi
-fi
-fi
-fi
-CC=$ac_cv_prog_CC
-if test -n "$CC"; then
- echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6
-else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
-fi
-
-fi
-if test -z "$CC"; then
- if test -n "$ac_tool_prefix"; then
- for ac_prog in cl
- do
- # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
-set dummy $ac_tool_prefix$ac_prog; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- if test -n "$CC"; then
- ac_cv_prog_CC="$CC" # Let the user override the test.
-else
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
- ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
-done
-
-fi
-fi
-CC=$ac_cv_prog_CC
-if test -n "$CC"; then
- echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6
-else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
-fi
-
- test -n "$CC" && break
- done
-fi
-if test -z "$CC"; then
- ac_ct_CC=$CC
- for ac_prog in cl
-do
- # Extract the first word of "$ac_prog", so it can be a program name with args.
-set dummy $ac_prog; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- if test -n "$ac_ct_CC"; then
- ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
-else
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
- ac_cv_prog_ac_ct_CC="$ac_prog"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
-done
-
-fi
-fi
-ac_ct_CC=$ac_cv_prog_ac_ct_CC
-if test -n "$ac_ct_CC"; then
- echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
-echo "${ECHO_T}$ac_ct_CC" >&6
-else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
-fi
-
- test -n "$ac_ct_CC" && break
-done
-
- CC=$ac_ct_CC
-fi
-
-fi
-
-
-test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH
-See \`config.log' for more details." >&5
-echo "$as_me: error: no acceptable C compiler found in \$PATH
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
-
-# Provide some information about the compiler.
-echo "$as_me:$LINENO:" \
- "checking for C compiler version" >&5
-ac_compiler=`set X $ac_compile; echo $2`
-{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5
- (eval $ac_compiler --version </dev/null >&5) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
-{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5
- (eval $ac_compiler -v </dev/null >&5) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
-{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5
- (eval $ac_compiler -V </dev/null >&5) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
-
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-ac_clean_files_save=$ac_clean_files
-ac_clean_files="$ac_clean_files a.out a.exe b.out"
-# Try to create an executable without -o first, disregard a.out.
-# It will help us diagnose broken compilers, and finding out an intuition
-# of exeext.
-echo "$as_me:$LINENO: checking for C compiler default output file name" >&5
-echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6
-ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
-if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5
- (eval $ac_link_default) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; then
- # Find the output, starting from the most likely. This scheme is
-# not robust to junk in `.', hence go to wildcards (a.*) only as a last
-# resort.
-
-# Be careful to initialize this variable, since it used to be cached.
-# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile.
-ac_cv_exeext=
-# b.out is created by i960 compilers.
-for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out
-do
- test -f "$ac_file" || continue
- case $ac_file in
- *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj )
- ;;
- conftest.$ac_ext )
- # This is the source file.
- ;;
- [ab].out )
- # We found the default executable, but exeext='' is most
- # certainly right.
- break;;
- *.* )
- ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
- # FIXME: I believe we export ac_cv_exeext for Libtool,
- # but it would be cool to find out if it's true. Does anybody
- # maintain Libtool? --akim.
- export ac_cv_exeext
- break;;
- * )
- break;;
- esac
-done
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-{ { echo "$as_me:$LINENO: error: C compiler cannot create executables
-See \`config.log' for more details." >&5
-echo "$as_me: error: C compiler cannot create executables
-See \`config.log' for more details." >&2;}
- { (exit 77); exit 77; }; }
-fi
-
-ac_exeext=$ac_cv_exeext
-echo "$as_me:$LINENO: result: $ac_file" >&5
-echo "${ECHO_T}$ac_file" >&6
-
-# Check the compiler produces executables we can run. If not, either
-# the compiler is broken, or we cross compile.
-echo "$as_me:$LINENO: checking whether the C compiler works" >&5
-echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6
-# FIXME: These cross compiler hacks should be removed for Autoconf 3.0
-# If not cross compiling, check that we can run a simple program.
-if test "$cross_compiling" != yes; then
- if { ac_try='./$ac_file'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- cross_compiling=no
- else
- if test "$cross_compiling" = maybe; then
- cross_compiling=yes
- else
- { { echo "$as_me:$LINENO: error: cannot run C compiled programs.
-If you meant to cross compile, use \`--host'.
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot run C compiled programs.
-If you meant to cross compile, use \`--host'.
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
- fi
- fi
-fi
-echo "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6
-
-rm -f a.out a.exe conftest$ac_cv_exeext b.out
-ac_clean_files=$ac_clean_files_save
-# Check the compiler produces executables we can run. If not, either
-# the compiler is broken, or we cross compile.
-echo "$as_me:$LINENO: checking whether we are cross compiling" >&5
-echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6
-echo "$as_me:$LINENO: result: $cross_compiling" >&5
-echo "${ECHO_T}$cross_compiling" >&6
-
-echo "$as_me:$LINENO: checking for suffix of executables" >&5
-echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; then
- # If both `conftest.exe' and `conftest' are `present' (well, observable)
-# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will
-# work properly (i.e., refer to `conftest.exe'), while it won't with
-# `rm'.
-for ac_file in conftest.exe conftest conftest.*; do
- test -f "$ac_file" || continue
- case $ac_file in
- *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;;
- *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
- export ac_cv_exeext
- break;;
- * ) break;;
- esac
-done
-else
- { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot compute suffix of executables: cannot compile and link
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
-fi
-
-rm -f conftest$ac_cv_exeext
-echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5
-echo "${ECHO_T}$ac_cv_exeext" >&6
-
-rm -f conftest.$ac_ext
-EXEEXT=$ac_cv_exeext
-ac_exeext=$EXEEXT
-echo "$as_me:$LINENO: checking for suffix of object files" >&5
-echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6
-if test "${ac_cv_objext+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.o conftest.obj
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; then
- for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do
- case $ac_file in
- *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;;
- *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
- break;;
- esac
-done
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot compute suffix of object files: cannot compile
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
-fi
-
-rm -f conftest.$ac_cv_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_objext" >&5
-echo "${ECHO_T}$ac_cv_objext" >&6
-OBJEXT=$ac_cv_objext
-ac_objext=$OBJEXT
-echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5
-echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6
-if test "${ac_cv_c_compiler_gnu+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-int
-main ()
-{
-#ifndef __GNUC__
- choke me
-#endif
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_compiler_gnu=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_compiler_gnu=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-ac_cv_c_compiler_gnu=$ac_compiler_gnu
-
-fi
-echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5
-echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6
-GCC=`test $ac_compiler_gnu = yes && echo yes`
-ac_test_CFLAGS=${CFLAGS+set}
-ac_save_CFLAGS=$CFLAGS
-CFLAGS="-g"
-echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5
-echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6
-if test "${ac_cv_prog_cc_g+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_prog_cc_g=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_prog_cc_g=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5
-echo "${ECHO_T}$ac_cv_prog_cc_g" >&6
-if test "$ac_test_CFLAGS" = set; then
- CFLAGS=$ac_save_CFLAGS
-elif test $ac_cv_prog_cc_g = yes; then
- if test "$GCC" = yes; then
- CFLAGS="-g -O2"
- else
- CFLAGS="-g"
- fi
-else
- if test "$GCC" = yes; then
- CFLAGS="-O2"
- else
- CFLAGS=
- fi
-fi
-echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5
-echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6
-if test "${ac_cv_prog_cc_stdc+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_cv_prog_cc_stdc=no
-ac_save_CC=$CC
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <stdarg.h>
-#include <stdio.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
-struct buf { int x; };
-FILE * (*rcsopen) (struct buf *, struct stat *, int);
-static char *e (p, i)
- char **p;
- int i;
-{
- return p[i];
-}
-static char *f (char * (*g) (char **, int), char **p, ...)
-{
- char *s;
- va_list v;
- va_start (v,p);
- s = g (p, va_arg (v,int));
- va_end (v);
- return s;
-}
-
-/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has
- function prototypes and stuff, but not '\xHH' hex character constants.
- These don't provoke an error unfortunately, instead are silently treated
- as 'x'. The following induces an error, until -std1 is added to get
- proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an
- array size at least. It's necessary to write '\x00'==0 to get something
- that's true only with -std1. */
-int osf4_cc_array ['\x00' == 0 ? 1 : -1];
-
-int test (int i, double x);
-struct s1 {int (*f) (int a);};
-struct s2 {int (*f) (double a);};
-int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
-int argc;
-char **argv;
-int
-main ()
-{
-return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1];
- ;
- return 0;
-}
-_ACEOF
-# Don't try gcc -ansi; that turns off useful extensions and
-# breaks some systems' header files.
-# AIX -qlanglvl=ansi
-# Ultrix and OSF/1 -std1
-# HP-UX 10.20 and later -Ae
-# HP-UX older versions -Aa -D_HPUX_SOURCE
-# SVR4 -Xc -D__EXTENSIONS__
-for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
-do
- CC="$ac_save_CC $ac_arg"
- rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_prog_cc_stdc=$ac_arg
-break
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-fi
-rm -f conftest.err conftest.$ac_objext
-done
-rm -f conftest.$ac_ext conftest.$ac_objext
-CC=$ac_save_CC
-
-fi
-
-case "x$ac_cv_prog_cc_stdc" in
- x|xno)
- echo "$as_me:$LINENO: result: none needed" >&5
-echo "${ECHO_T}none needed" >&6 ;;
- *)
- echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5
-echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6
- CC="$CC $ac_cv_prog_cc_stdc" ;;
-esac
-
-# Some people use a C++ compiler to compile C. Since we use `exit',
-# in C++ we need to declare it. In case someone uses the same compiler
-# for both compiling C and C++ we need to have the C++ compiler decide
-# the declaration of exit, since it's the most demanding environment.
-cat >conftest.$ac_ext <<_ACEOF
-#ifndef __cplusplus
- choke me
-#endif
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- for ac_declaration in \
- '' \
- 'extern "C" void std::exit (int) throw (); using std::exit;' \
- 'extern "C" void std::exit (int); using std::exit;' \
- 'extern "C" void exit (int) throw ();' \
- 'extern "C" void exit (int);' \
- 'void exit (int);'
-do
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_declaration
-#include <stdlib.h>
-int
-main ()
-{
-exit (42);
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- :
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-continue
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_declaration
-int
-main ()
-{
-exit (42);
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- break
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-done
-rm -f conftest*
-if test -n "$ac_declaration"; then
- echo '#ifdef __cplusplus' >>confdefs.h
- echo $ac_declaration >>confdefs.h
- echo '#endif' >>confdefs.h
-fi
-
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-ac_ext=c
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
-ac_compiler_gnu=$ac_cv_c_compiler_gnu
-
-
-ac_aux_dir=
-for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
- if test -f $ac_dir/install-sh; then
- ac_aux_dir=$ac_dir
- ac_install_sh="$ac_aux_dir/install-sh -c"
- break
- elif test -f $ac_dir/install.sh; then
- ac_aux_dir=$ac_dir
- ac_install_sh="$ac_aux_dir/install.sh -c"
- break
- elif test -f $ac_dir/shtool; then
- ac_aux_dir=$ac_dir
- ac_install_sh="$ac_aux_dir/shtool install -c"
- break
- fi
-done
-if test -z "$ac_aux_dir"; then
- { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&5
-echo "$as_me: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&2;}
- { (exit 1); exit 1; }; }
-fi
-ac_config_guess="$SHELL $ac_aux_dir/config.guess"
-ac_config_sub="$SHELL $ac_aux_dir/config.sub"
-ac_configure="$SHELL $ac_aux_dir/configure" # This should be Cygnus configure.
-
-# Find a good install program. We prefer a C program (faster),
-# so one script is as good as another. But avoid the broken or
-# incompatible versions:
-# SysV /etc/install, /usr/sbin/install
-# SunOS /usr/etc/install
-# IRIX /sbin/install
-# AIX /bin/install
-# AmigaOS /C/install, which installs bootblocks on floppy discs
-# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
-# AFS /usr/afsws/bin/install, which mishandles nonexistent args
-# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
-# OS/2's system install, which has a completely different semantic
-# ./install, which can be erroneously created by make from ./install.sh.
-echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5
-echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6
-if test -z "$INSTALL"; then
-if test "${ac_cv_path_install+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- # Account for people who put trailing slashes in PATH elements.
-case $as_dir/ in
- ./ | .// | /cC/* | \
- /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \
- ?:\\/os2\\/install\\/* | ?:\\/OS2\\/INSTALL\\/* | \
- /usr/ucb/* ) ;;
- *)
- # OSF1 and SCO ODT 3.0 have their own names for install.
- # Don't use installbsd from OSF since it installs stuff as root
- # by default.
- for ac_prog in ginstall scoinst install; do
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then
- if test $ac_prog = install &&
- grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
- # AIX install. It has an incompatible calling convention.
- :
- elif test $ac_prog = install &&
- grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
- # program-specific install script used by HP pwplus--don't use.
- :
- else
- ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c"
- break 3
- fi
- fi
- done
- done
- ;;
-esac
-done
-
-
-fi
- if test "${ac_cv_path_install+set}" = set; then
- INSTALL=$ac_cv_path_install
- else
- # As a last resort, use the slow shell script. We don't cache a
- # path for INSTALL within a source directory, because that will
- # break other packages using the cache if that directory is
- # removed, or if the path is relative.
- INSTALL=$ac_install_sh
- fi
-fi
-echo "$as_me:$LINENO: result: $INSTALL" >&5
-echo "${ECHO_T}$INSTALL" >&6
-
-# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
-# It thinks the first close brace ends the variable substitution.
-test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
-
-test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
-
-test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
-
-
-
-# find system type (using this macro means we must include
-# the files install-sh, config.sub, and config.guess (all from
-# the autoconf distribution) in our source tree!)
-# Make sure we can run config.sub.
-$ac_config_sub sun4 >/dev/null 2>&1 ||
- { { echo "$as_me:$LINENO: error: cannot run $ac_config_sub" >&5
-echo "$as_me: error: cannot run $ac_config_sub" >&2;}
- { (exit 1); exit 1; }; }
-
-echo "$as_me:$LINENO: checking build system type" >&5
-echo $ECHO_N "checking build system type... $ECHO_C" >&6
-if test "${ac_cv_build+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_cv_build_alias=$build_alias
-test -z "$ac_cv_build_alias" &&
- ac_cv_build_alias=`$ac_config_guess`
-test -z "$ac_cv_build_alias" &&
- { { echo "$as_me:$LINENO: error: cannot guess build type; you must specify one" >&5
-echo "$as_me: error: cannot guess build type; you must specify one" >&2;}
- { (exit 1); exit 1; }; }
-ac_cv_build=`$ac_config_sub $ac_cv_build_alias` ||
- { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_build_alias failed" >&5
-echo "$as_me: error: $ac_config_sub $ac_cv_build_alias failed" >&2;}
- { (exit 1); exit 1; }; }
-
-fi
-echo "$as_me:$LINENO: result: $ac_cv_build" >&5
-echo "${ECHO_T}$ac_cv_build" >&6
-build=$ac_cv_build
-build_cpu=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
-build_vendor=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
-build_os=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
-
-
-echo "$as_me:$LINENO: checking host system type" >&5
-echo $ECHO_N "checking host system type... $ECHO_C" >&6
-if test "${ac_cv_host+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_cv_host_alias=$host_alias
-test -z "$ac_cv_host_alias" &&
- ac_cv_host_alias=$ac_cv_build_alias
-ac_cv_host=`$ac_config_sub $ac_cv_host_alias` ||
- { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_host_alias failed" >&5
-echo "$as_me: error: $ac_config_sub $ac_cv_host_alias failed" >&2;}
- { (exit 1); exit 1; }; }
-
-fi
-echo "$as_me:$LINENO: result: $ac_cv_host" >&5
-echo "${ECHO_T}$ac_cv_host" >&6
-host=$ac_cv_host
-host_cpu=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
-host_vendor=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
-host_os=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
-
-
-echo "$as_me:$LINENO: checking target system type" >&5
-echo $ECHO_N "checking target system type... $ECHO_C" >&6
-if test "${ac_cv_target+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_cv_target_alias=$target_alias
-test "x$ac_cv_target_alias" = "x" &&
- ac_cv_target_alias=$ac_cv_host_alias
-ac_cv_target=`$ac_config_sub $ac_cv_target_alias` ||
- { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_target_alias failed" >&5
-echo "$as_me: error: $ac_config_sub $ac_cv_target_alias failed" >&2;}
- { (exit 1); exit 1; }; }
-
-fi
-echo "$as_me:$LINENO: result: $ac_cv_target" >&5
-echo "${ECHO_T}$ac_cv_target" >&6
-target=$ac_cv_target
-target_cpu=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
-target_vendor=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
-target_os=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
-
-
-# The aliases save the names the user supplied, while $host etc.
-# will get canonicalized.
-test -n "$target_alias" &&
- test "$program_prefix$program_suffix$program_transform_name" = \
- NONENONEs,x,x, &&
- program_prefix=${target_alias}-
-
-
-# ---------------- generic functions -----------------
-# debugging diagnostic; set to 'echo' to debug or 'true' for production
-# (technically you're not supposed to use shell functions in
-# configure scripts, because some-obscure-sh somewhere doesn't
-# support them.. but they're too convenient to not use)
-diagnostic() {
- #echo "$@"
- true "$@"
-}
-
-# determine if a binary is in the path
-binaryExists() {
- # on cygwin, 'which' always returns success, so use 'type' instead
- if type "$1" >/dev/null 2>&1; then
- return 0
- else
- return 1
- fi
-}
-
-
-# -------------- portable configuration ----------------
-# this specifies the root of the source tree; it's just the
-# directory where ./configure runs, except on cygwin, which
-# overrides this below
-CILHOME=`pwd`
-
-DEFAULT_COMPILER=_GNUCC
-DEFAULT_CIL_MODE=GNUCC
-
-# is the microsoft compiler available?
-# hmm.. I think we should check the version or something, because
-# sometimes people have Common Lisp's interpreter called 'cl' ..
-echo "$as_me:$LINENO: checking for msvc cl.exe (optional)" >&5
-echo $ECHO_N "checking for msvc cl.exe (optional)... $ECHO_C" >&6
-# See if CC points to the MS compiler
-if "$CC" 2>&1 | grep "Microsoft" >/dev/null; then
- echo "$as_me:$LINENO: result: found, set as default" >&5
-echo "${ECHO_T}found, set as default" >&6
- HAS_MSVC=yes
- DEFAULT_COMPILER=_MSVC
- DEFAULT_CIL_MODE=MSVC
-else
- if cl 2>&1 | grep "Microsoft" >/dev/null ;then
- echo "$as_me:$LINENO: result: found" >&5
-echo "${ECHO_T}found" >&6
- HAS_MSVC=yes
- else
- echo "$as_me:$LINENO: result: not found" >&5
-echo "${ECHO_T}not found" >&6
- HAS_MSVC=no
- fi
-fi
-
-# is ocaml available?
-# needed binaries: ocamllex ocamlyacc ocamldep ocamlopt ocamlc
-ocamlDownloadInstructions="
- OCaml can be downloaded from http://caml.inria.fr/ocaml/.
- After downloading and unpacking the source distribution, in the ocaml
- directory, do
- ./configure
- make world
- make opt
- make install
- Then come back here and re-run ./configure."
-
-# required major/minor.
-# required major/minor
-reqMaj=3
-reqMin=08
-knownMaj=3
-knownMin=09
-echo "$as_me:$LINENO: checking ocaml version is at least $reqMaj.$reqMin" >&5
-echo $ECHO_N "checking ocaml version is at least $reqMaj.$reqMin... $ECHO_C" >&6
-if binaryExists ocamlc; then
- # what version?
- ver=`ocamlc -v | grep version | sed 's/^.*version //'`
- diagnostic "ver is $ver"
- # major: anything before the .
- major=`echo $ver | sed 's/\..*$//'`
- diagnostic "major is $major"
- # minor: numbers after the .
- # (the outer level of bracket-quotation protects the inner brackets)
- minor=`echo $ver | sed 's/^[^.]*\.\([0-9][0-9]*\).*$/\1/'`
- diagnostic "minor is $minor"
-
- # I would think autoconf would already have a facility for doing
- # these kinds of major/minor version checks, but I can't find it
- if test $major -gt $reqMaj -o $major -ge $reqMaj -a $minor -ge $reqMin; then
- echo "$as_me:$LINENO: result: version is $ver, ok" >&5
-echo "${ECHO_T}version is $ver, ok" >&6
-
- # sm: added this test when we found that CCured needed to be changed
- # a little when 3.06 came out (it had previously worked with 3.04)
- if test "$major" -gt $knownMaj -o "$major" -ge $knownMaj -a "$minor" -gt $knownMin; then
- { echo "$as_me:$LINENO: WARNING: Your ocaml version is $ver, but the latest version this program
- is known to work with is $knownMaj.$knownMin. If you have
- trouble compiling, please try using an earlier version
- or see if there is a later version of this program." >&5
-echo "$as_me: WARNING: Your ocaml version is $ver, but the latest version this program
- is known to work with is $knownMaj.$knownMin. If you have
- trouble compiling, please try using an earlier version
- or see if there is a later version of this program." >&2;}
- fi
- else
- { { echo "$as_me:$LINENO: error:
- I found OCaml version $ver; this program requires at least $reqMaj.$reqMin.
- Please download a newer OCaml distribution.
- $ocamlDownloadInstructions
- " >&5
-echo "$as_me: error:
- I found OCaml version $ver; this program requires at least $reqMaj.$reqMin.
- Please download a newer OCaml distribution.
- $ocamlDownloadInstructions
- " >&2;}
- { (exit 1); exit 1; }; }
- fi
-
- # check for existence of other binaries
- echo "$as_me:$LINENO: checking existence of related ocaml tools" >&5
-echo $ECHO_N "checking existence of related ocaml tools... $ECHO_C" >&6
- if binaryExists ocamllex && \
- binaryExists ocamlyacc && \
- binaryExists ocamldep && \
- binaryExists ocamlopt; then
- echo "$as_me:$LINENO: result: ok" >&5
-echo "${ECHO_T}ok" >&6
- else
- { { echo "$as_me:$LINENO: error:
- At least one of ocamllex, ocamlyacc, ocamldep or ocamlopt is missing.
- In particular, ocamlopt requires you to \"make opt\" when building
- OCaml from source. Please make sure all these tools are built and
- in the path.
- " >&5
-echo "$as_me: error:
- At least one of ocamllex, ocamlyacc, ocamldep or ocamlopt is missing.
- In particular, ocamlopt requires you to \"make opt\" when building
- OCaml from source. Please make sure all these tools are built and
- in the path.
- " >&2;}
- { (exit 1); exit 1; }; }
- fi
-else
- { { echo "$as_me:$LINENO: error:
- The \"ocamlc\" OCaml compiler was not found in the path: $PATH.
-
- Most of this program is written in the OCaml language, so its compiler
- is required.
- $ocamlDownloadInstructions
- " >&5
-echo "$as_me: error:
- The \"ocamlc\" OCaml compiler was not found in the path: $PATH.
-
- Most of this program is written in the OCaml language, so its compiler
- is required.
- $ocamlDownloadInstructions
- " >&2;}
- { (exit 1); exit 1; }; }
-fi
-
-#
-# ------------------- Perl ----------------
-#
-echo "$as_me:$LINENO: checking for Perl" >&5
-echo $ECHO_N "checking for Perl... $ECHO_C" >&6
- if ! binaryExists perl; then
- { { echo "$as_me:$LINENO: error:
- perl not found.
- You need perl version 5.6.1 or later for CIL.
- You can get perl at http://www.cpan.org/src/index.html .
- " >&5
-echo "$as_me: error:
- perl not found.
- You need perl version 5.6.1 or later for CIL.
- You can get perl at http://www.cpan.org/src/index.html .
- " >&2;}
- { (exit 1); exit 1; }; }
- fi
-
- # sm: oh how nice it would be to just say "use English;
- # print($PERL_VERSION)", but that appears broken on 5.6.1.. so I'm
- # trying to say "caret right-bracket", but then that would run afoul
- # of autoconf's quoting characters, so I use the "quadrigraph" ]
- # to stand for right-bracket. what a mess.
- perlver=`perl -e 'print($]);'`
- if perl -e "exit( $perlver >= 5.006001 );"; then
- { { echo "$as_me:$LINENO: error:
- Found perl version $perlver, but at least 5.6.1 is required.
- You can get a newer perl at http://www.cpan.org/src/index.html .
- " >&5
-echo "$as_me: error:
- Found perl version $perlver, but at least 5.6.1 is required.
- You can get a newer perl at http://www.cpan.org/src/index.html .
- " >&2;}
- { (exit 1); exit 1; }; }
- fi
-
- perlport=`perl -e "print $^O;"`
- case "$perlport" in
- cygwin)
- ;;
- MSWin32) # ActivePerl
- ;;
- linux)
- ;;
- freebsd)
- ;;
- openbsd)
- ;;
- darwin) # Mac OS X
- ;;
- solaris)
- ;;
- *)
- { { echo "$as_me:$LINENO: error:
- Unsupported Perl port $perlport -- sorry.
- cygwin, MSWin32 (ActivePerl), linux, freebsd, openbsd, darwin,
- and solaris are the supported ports.
- " >&5
-echo "$as_me: error:
- Unsupported Perl port $perlport -- sorry.
- cygwin, MSWin32 (ActivePerl), linux, freebsd, openbsd, darwin,
- and solaris are the supported ports.
- " >&2;}
- { (exit 1); exit 1; }; }
- esac
-echo "$as_me:$LINENO: result: found version $perlver, port $perlport" >&5
-echo "${ECHO_T}found version $perlver, port $perlport" >&6
-
- # The cygwin port has some bugs in the File::Spec module
-if test "$perlport" = "cygwin" ;then
- echo "$as_me:$LINENO: checking for known cygwin Perl bug in File::Spec" >&5
-echo $ECHO_N "checking for known cygwin Perl bug in File::Spec... $ECHO_C" >&6
- perlfixres=`perl -e '
- use File::Spec;
- if(File::Spec->file_name_is_absolute("C:/test")) {
- print "no bug found"; exit 0;
- } else {
- print "bug";
- foreach $d (@INC) {
- if(-f "$d/File/Spec/Unix.pm") {
- open(IN, "<$d/File/Spec/Unix.pm");
- open(OUT, ">$d/File/Spec/Unix.pm.fixed")
- || die "Cannot open $d/File/Spec/Unix.pm.fixed";
- while(<IN>) {
- if($_ =~ m|sub file_name_is_absolute|) {
- print OUT $_;
- print OUT scalar(<IN>);
- print OUT <<EOF;
- if(\\$^O eq \"cygwin\") {
- return scalar(\\$file =~ m{^(\\[a-z\\]:)?\\[\\\\\\\\/\\]}is);
-};
-EOF
- next;
- }
- print OUT $_;
- }
- close(OUT);
- close(IN);
- system("mv -f $d/File/Spec/Unix.pm.fixed $d/File/Spec/Unix.pm");
- }
- }
- }
- '`
- # See if it was indeed fixed
- if test "$perlfixres" = "bug" ;then
- perlfixres=`perl -e '
- use File::Spec;
- if(File::Spec->file_name_is_absolute("C:/test")) {
- print "bug fixed"; exit 0;
- } else {
- print "cannot fix bug"; exit 1;
- }'`
- fi
- if test "x$perlfixres" = "x" ;then
- { { echo "$as_me:$LINENO: error:
- Cannot run perl
- " >&5
-echo "$as_me: error:
- Cannot run perl
- " >&2;}
- { (exit 1); exit 1; }; }
- elif test "$perlfixres" = "cannot fix bug" ;then
- { { echo "$as_me:$LINENO: error:
- Found a bug but cannot fix it.
- " >&5
-echo "$as_me: error:
- Found a bug but cannot fix it.
- " >&2;}
- { (exit 1); exit 1; }; }
- else
- echo "$as_me:$LINENO: result: $perlfixres" >&5
-echo "${ECHO_T}$perlfixres" >&6
- fi
-fi
-
-#
-# Now setup the performance counters
-#
-echo "$as_me:$LINENO: checking if performance counters are usable" >&5
-echo $ECHO_N "checking if performance counters are usable... $ECHO_C" >&6
-# Create a C file from src/perfcount.c.in
-rm -f ./cycles.exe
-if gcc -DCONFIGURATION_ONLY \
- -x c ocamlutil/perfcount.c.in -lm -o ./cycles.exe >/dev/null 2>&1; then
-
- if CYCLES_PER_USEC=`./cycles.exe 2>&1` ;then
- echo "$as_me:$LINENO: result: ok ($CYCLES_PER_USEC cycles per us)" >&5
-echo "${ECHO_T}ok ($CYCLES_PER_USEC cycles per us)" >&6
- else
- # Print what we got
- echo "$as_me:$LINENO: result: no ($CYCLES_PER_USEC)" >&5
-echo "${ECHO_T}no ($CYCLES_PER_USEC)" >&6
- CYCLES_PER_USEC=0
- fi
-else
- CYCLES_PER_USEC=0
- echo "$as_me:$LINENO: result: no (cannot compile perfcount.c)" >&5
-echo "${ECHO_T}no (cannot compile perfcount.c)" >&6
-fi
-rm -f ./cycles.exe
-
-# If we are on Linux and we use performance counters try to get
-# the processor speed from /proc/cpuinfo
-if test "$CYCLES_PER_USEC" != "0" ;then
- case "$target" in
- # linux
- *86*linux*)
- echo "$as_me:$LINENO: checking if /proc/cpuinfo has processor speed" >&5
-echo $ECHO_N "checking if /proc/cpuinfo has processor speed... $ECHO_C" >&6
- cpuinfo=`cat /proc/cpuinfo 2>/dev/null | grep "cpu MHz"`
- procspeed=`echo $cpuinfo | sed 's/^.*[^0-9]\([0-9]\+\.[0-9]\+\).*$/\1/g'`
- if test "$procspeed"!="" ;then
- CYCLES_PER_USEC=$procspeed
- echo "$as_me:$LINENO: result: got $CYCLES_PER_USEC cycles per us" >&5
-echo "${ECHO_T}got $CYCLES_PER_USEC cycles per us" >&6
- else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
- fi
- ;;
- *)
- ;;
- esac
- # Now set HAS_PERFCOUNT
- HAS_PERFCOUNT=1
-else
- HAS_PERFCOUNT=0
-fi
-
-# additional tools we might check for:
-# - gnu make
-
-#
-# -------------------- GCC --------------
-#
-
-echo "$as_me:$LINENO: checking for gcc version" >&5
-echo $ECHO_N "checking for gcc version... $ECHO_C" >&6
-
-ac_ext=c
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
-ac_compiler_gnu=$ac_cv_c_compiler_gnu
-echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5
-echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6
-# On Suns, sometimes $CPP names a directory.
-if test -n "$CPP" && test -d "$CPP"; then
- CPP=
-fi
-if test -z "$CPP"; then
- if test "${ac_cv_prog_CPP+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- # Double quotes because CPP needs to be expanded
- for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
- do
- ac_preproc_ok=false
-for ac_c_preproc_warn_flag in '' yes
-do
- # Use a header file that comes with gcc, so configuring glibc
- # with a fresh cross-compiler works.
- # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- # <limits.h> exists even on freestanding compilers.
- # On the NeXT, cc -E runs the code through the compiler's parser,
- # not just through cpp. "Syntax error" is here to catch this case.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
- Syntax error
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- :
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- # Broken: fails on valid input.
-continue
-fi
-rm -f conftest.err conftest.$ac_ext
-
- # OK, works on sane cases. Now check whether non-existent headers
- # can be detected and how.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <ac_nonexistent.h>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- # Broken: success on invalid input.
-continue
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- # Passes both tests.
-ac_preproc_ok=:
-break
-fi
-rm -f conftest.err conftest.$ac_ext
-
-done
-# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
-rm -f conftest.err conftest.$ac_ext
-if $ac_preproc_ok; then
- break
-fi
-
- done
- ac_cv_prog_CPP=$CPP
-
-fi
- CPP=$ac_cv_prog_CPP
-else
- ac_cv_prog_CPP=$CPP
-fi
-echo "$as_me:$LINENO: result: $CPP" >&5
-echo "${ECHO_T}$CPP" >&6
-ac_preproc_ok=false
-for ac_c_preproc_warn_flag in '' yes
-do
- # Use a header file that comes with gcc, so configuring glibc
- # with a fresh cross-compiler works.
- # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- # <limits.h> exists even on freestanding compilers.
- # On the NeXT, cc -E runs the code through the compiler's parser,
- # not just through cpp. "Syntax error" is here to catch this case.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
- Syntax error
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- :
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- # Broken: fails on valid input.
-continue
-fi
-rm -f conftest.err conftest.$ac_ext
-
- # OK, works on sane cases. Now check whether non-existent headers
- # can be detected and how.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <ac_nonexistent.h>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- # Broken: success on invalid input.
-continue
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- # Passes both tests.
-ac_preproc_ok=:
-break
-fi
-rm -f conftest.err conftest.$ac_ext
-
-done
-# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
-rm -f conftest.err conftest.$ac_ext
-if $ac_preproc_ok; then
- :
-else
- { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check
-See \`config.log' for more details." >&5
-echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
-fi
-
-ac_ext=c
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
-ac_compiler_gnu=$ac_cv_c_compiler_gnu
-
-
-echo "$as_me:$LINENO: checking for egrep" >&5
-echo $ECHO_N "checking for egrep... $ECHO_C" >&6
-if test "${ac_cv_prog_egrep+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- if echo a | (grep -E '(a|b)') >/dev/null 2>&1
- then ac_cv_prog_egrep='grep -E'
- else ac_cv_prog_egrep='egrep'
- fi
-fi
-echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5
-echo "${ECHO_T}$ac_cv_prog_egrep" >&6
- EGREP=$ac_cv_prog_egrep
-
-
-echo "$as_me:$LINENO: checking for ANSI C header files" >&5
-echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6
-if test "${ac_cv_header_stdc+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <stdlib.h>
-#include <stdarg.h>
-#include <string.h>
-#include <float.h>
-
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_header_stdc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_header_stdc=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-
-if test $ac_cv_header_stdc = yes; then
- # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <string.h>
-
-_ACEOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "memchr" >/dev/null 2>&1; then
- :
-else
- ac_cv_header_stdc=no
-fi
-rm -f conftest*
-
-fi
-
-if test $ac_cv_header_stdc = yes; then
- # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <stdlib.h>
-
-_ACEOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "free" >/dev/null 2>&1; then
- :
-else
- ac_cv_header_stdc=no
-fi
-rm -f conftest*
-
-fi
-
-if test $ac_cv_header_stdc = yes; then
- # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
- if test "$cross_compiling" = yes; then
- :
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <ctype.h>
-#if ((' ' & 0x0FF) == 0x020)
-# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
-# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
-#else
-# define ISLOWER(c) \
- (('a' <= (c) && (c) <= 'i') \
- || ('j' <= (c) && (c) <= 'r') \
- || ('s' <= (c) && (c) <= 'z'))
-# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
-#endif
-
-#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
-int
-main ()
-{
- int i;
- for (i = 0; i < 256; i++)
- if (XOR (islower (i), ISLOWER (i))
- || toupper (i) != TOUPPER (i))
- exit(2);
- exit (0);
-}
-_ACEOF
-rm -f conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- :
-else
- echo "$as_me: program exited with status $ac_status" >&5
-echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-( exit $ac_status )
-ac_cv_header_stdc=no
-fi
-rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
-fi
-fi
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5
-echo "${ECHO_T}$ac_cv_header_stdc" >&6
-if test $ac_cv_header_stdc = yes; then
-
-cat >>confdefs.h <<\_ACEOF
-#define STDC_HEADERS 1
-_ACEOF
-
-fi
-
-# On IRIX 5.3, sys/types and inttypes.h are conflicting.
-
-
-
-
-
-
-
-
-
-for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
- inttypes.h stdint.h unistd.h
-do
-as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-
-#include <$ac_header>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- eval "$as_ac_Header=yes"
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-eval "$as_ac_Header=no"
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-if test `eval echo '${'$as_ac_Header'}'` = yes; then
- cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-
-done
-
-
-echo "$as_me:$LINENO: checking for __builtin_va_list" >&5
-echo $ECHO_N "checking for __builtin_va_list... $ECHO_C" >&6
-if test "${ac_cv_type___builtin_va_list+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-if ((__builtin_va_list *) 0)
- return 0;
-if (sizeof (__builtin_va_list))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_type___builtin_va_list=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_type___builtin_va_list=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_type___builtin_va_list" >&5
-echo "${ECHO_T}$ac_cv_type___builtin_va_list" >&6
-if test $ac_cv_type___builtin_va_list = yes; then
- HAVE_BUILTIN_VA_LIST=true
-else
- HAVE_BUILTIN_VA_LIST=false
-fi
-
-echo "$as_me:$LINENO: checking if __thread is a keyword" >&5
-echo $ECHO_N "checking if __thread is a keyword... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-int main(int __thread) { return 0; }
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- THREAD_IS_KEYWORD=false
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-THREAD_IS_KEYWORD=true
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $THREAD_IS_KEYWORD" >&5
-echo "${ECHO_T}$THREAD_IS_KEYWORD" >&6
-
-# Does gcc add underscores to identifiers to make assembly labels?
-# (I think MSVC always does)
-echo "$as_me:$LINENO: checking if gcc adds underscores to assembly labels." >&5
-echo $ECHO_N "checking if gcc adds underscores to assembly labels.... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-int main() { __asm__("jmp _main"); }
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- UNDERSCORE_NAME=true
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-UNDERSCORE_NAME=false
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $UNDERSCORE_NAME" >&5
-echo "${ECHO_T}$UNDERSCORE_NAME" >&6
-
-
-# ----------- some stuff 'autoscan' put here --------------
-# (autoscan is part of the autoconf distribution)
-
-# checks for header files
-echo "$as_me:$LINENO: checking for ANSI C header files" >&5
-echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6
-if test "${ac_cv_header_stdc+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <stdlib.h>
-#include <stdarg.h>
-#include <string.h>
-#include <float.h>
-
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_header_stdc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_header_stdc=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-
-if test $ac_cv_header_stdc = yes; then
- # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <string.h>
-
-_ACEOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "memchr" >/dev/null 2>&1; then
- :
-else
- ac_cv_header_stdc=no
-fi
-rm -f conftest*
-
-fi
-
-if test $ac_cv_header_stdc = yes; then
- # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <stdlib.h>
-
-_ACEOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "free" >/dev/null 2>&1; then
- :
-else
- ac_cv_header_stdc=no
-fi
-rm -f conftest*
-
-fi
-
-if test $ac_cv_header_stdc = yes; then
- # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
- if test "$cross_compiling" = yes; then
- :
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <ctype.h>
-#if ((' ' & 0x0FF) == 0x020)
-# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
-# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
-#else
-# define ISLOWER(c) \
- (('a' <= (c) && (c) <= 'i') \
- || ('j' <= (c) && (c) <= 'r') \
- || ('s' <= (c) && (c) <= 'z'))
-# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
-#endif
-
-#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
-int
-main ()
-{
- int i;
- for (i = 0; i < 256; i++)
- if (XOR (islower (i), ISLOWER (i))
- || toupper (i) != TOUPPER (i))
- exit(2);
- exit (0);
-}
-_ACEOF
-rm -f conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- :
-else
- echo "$as_me: program exited with status $ac_status" >&5
-echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-( exit $ac_status )
-ac_cv_header_stdc=no
-fi
-rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
-fi
-fi
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5
-echo "${ECHO_T}$ac_cv_header_stdc" >&6
-if test $ac_cv_header_stdc = yes; then
-
-cat >>confdefs.h <<\_ACEOF
-#define STDC_HEADERS 1
-_ACEOF
-
-fi
-
-
-
-
-
-
-for ac_header in stdlib.h strings.h sys/time.h unistd.h wchar.h
-do
-as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking $ac_header usability" >&5
-echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <$ac_header>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking $ac_header presence" >&5
-echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <$ac_header>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5
-echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------------------ ##
-## Report this to the AC_PACKAGE_NAME lists. ##
-## ------------------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- eval "$as_ac_Header=\$ac_header_preproc"
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-
-fi
-if test `eval echo '${'$as_ac_Header'}'` = yes; then
- cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-
-done
-
-
-# checks for typedefs, structures, and compiler characteristics
-echo "$as_me:$LINENO: checking for an ANSI C-conforming const" >&5
-echo $ECHO_N "checking for an ANSI C-conforming const... $ECHO_C" >&6
-if test "${ac_cv_c_const+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-int
-main ()
-{
-/* FIXME: Include the comments suggested by Paul. */
-#ifndef __cplusplus
- /* Ultrix mips cc rejects this. */
- typedef int charset[2];
- const charset x;
- /* SunOS 4.1.1 cc rejects this. */
- char const *const *ccp;
- char **p;
- /* NEC SVR4.0.2 mips cc rejects this. */
- struct point {int x, y;};
- static struct point const zero = {0,0};
- /* AIX XL C 1.02.0.0 rejects this.
- It does not let you subtract one const X* pointer from another in
- an arm of an if-expression whose if-part is not a constant
- expression */
- const char *g = "string";
- ccp = &g + (g ? g-g : 0);
- /* HPUX 7.0 cc rejects these. */
- ++ccp;
- p = (char**) ccp;
- ccp = (char const *const *) p;
- { /* SCO 3.2v4 cc rejects this. */
- char *t;
- char const *s = 0 ? (char *) 0 : (char const *) 0;
-
- *t++ = 0;
- }
- { /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */
- int x[] = {25, 17};
- const int *foo = &x[0];
- ++foo;
- }
- { /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */
- typedef const int *iptr;
- iptr p = 0;
- ++p;
- }
- { /* AIX XL C 1.02.0.0 rejects this saying
- "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */
- struct s { int j; const int *ap[3]; };
- struct s *b; b->j = 5;
- }
- { /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */
- const int foo = 10;
- }
-#endif
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_c_const=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_c_const=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_c_const" >&5
-echo "${ECHO_T}$ac_cv_c_const" >&6
-if test $ac_cv_c_const = no; then
-
-cat >>confdefs.h <<\_ACEOF
-#define const
-_ACEOF
-
-fi
-
-echo "$as_me:$LINENO: checking for inline" >&5
-echo $ECHO_N "checking for inline... $ECHO_C" >&6
-if test "${ac_cv_c_inline+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_cv_c_inline=no
-for ac_kw in inline __inline__ __inline; do
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#ifndef __cplusplus
-typedef int foo_t;
-static $ac_kw foo_t static_foo () {return 0; }
-$ac_kw foo_t foo () {return 0; }
-#endif
-
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_c_inline=$ac_kw; break
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-done
-
-fi
-echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5
-echo "${ECHO_T}$ac_cv_c_inline" >&6
-
-
-case $ac_cv_c_inline in
- inline | yes) ;;
- *)
- case $ac_cv_c_inline in
- no) ac_val=;;
- *) ac_val=$ac_cv_c_inline;;
- esac
- cat >>confdefs.h <<_ACEOF
-#ifndef __cplusplus
-#define inline $ac_val
-#endif
-_ACEOF
- ;;
-esac
-
-echo "$as_me:$LINENO: checking whether time.h and sys/time.h may both be included" >&5
-echo $ECHO_N "checking whether time.h and sys/time.h may both be included... $ECHO_C" >&6
-if test "${ac_cv_header_time+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <sys/types.h>
-#include <sys/time.h>
-#include <time.h>
-
-int
-main ()
-{
-if ((struct tm *) 0)
-return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_header_time=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_header_time=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_time" >&5
-echo "${ECHO_T}$ac_cv_header_time" >&6
-if test $ac_cv_header_time = yes; then
-
-cat >>confdefs.h <<\_ACEOF
-#define TIME_WITH_SYS_TIME 1
-_ACEOF
-
-fi
-
-
-# checks for library functions; more autoscan stuff
-echo "$as_me:$LINENO: checking for working memcmp" >&5
-echo $ECHO_N "checking for working memcmp... $ECHO_C" >&6
-if test "${ac_cv_func_memcmp_working+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- if test "$cross_compiling" = yes; then
- ac_cv_func_memcmp_working=no
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-
- /* Some versions of memcmp are not 8-bit clean. */
- char c0 = 0x40, c1 = 0x80, c2 = 0x81;
- if (memcmp(&c0, &c2, 1) >= 0 || memcmp(&c1, &c2, 1) >= 0)
- exit (1);
-
- /* The Next x86 OpenStep bug shows up only when comparing 16 bytes
- or more and with at least one buffer not starting on a 4-byte boundary.
- William Lewis provided this test program. */
- {
- char foo[21];
- char bar[21];
- int i;
- for (i = 0; i < 4; i++)
- {
- char *a = foo + i;
- char *b = bar + i;
- strcpy (a, "--------01111111");
- strcpy (b, "--------10000000");
- if (memcmp (a, b, 16) >= 0)
- exit (1);
- }
- exit (0);
- }
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_memcmp_working=yes
-else
- echo "$as_me: program exited with status $ac_status" >&5
-echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-( exit $ac_status )
-ac_cv_func_memcmp_working=no
-fi
-rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
-fi
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_memcmp_working" >&5
-echo "${ECHO_T}$ac_cv_func_memcmp_working" >&6
-test $ac_cv_func_memcmp_working = no && case $LIBOBJS in
- "memcmp.$ac_objext" | \
- *" memcmp.$ac_objext" | \
- "memcmp.$ac_objext "* | \
- *" memcmp.$ac_objext "* ) ;;
- *) LIBOBJS="$LIBOBJS memcmp.$ac_objext" ;;
-esac
-
-
-
-
-
-
-for ac_func in mkdir select socket __sysv_signal
-do
-as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_func" >&5
-echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
-if eval "test \"\${$as_ac_var+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define $ac_func innocuous_$ac_func
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char $ac_func (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef $ac_func
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char $ac_func ();
-/* The GNU C library defines this for functions which it implements
- to always fail with ENOSYS. Some functions are actually named
- something starting with __ and the normal name is an alias. */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
-choke me
-#else
-char (*f) () = $ac_func;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != $ac_func;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- eval "$as_ac_var=yes"
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-eval "$as_ac_var=no"
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
-if test `eval echo '${'$as_ac_var'}'` = yes; then
- cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-done
-
-
-
-
-# ----------- platform-specific code -------------
-# $target is typically processor-vendor-os
-case "$target" in
- # linux
- *86*linux*|*86*freebsd*|*86*openbsd*|*86*darwin*)
- echo "$as_me:$LINENO: result: configuring for linux/x86" >&5
-echo "${ECHO_T}configuring for linux/x86" >&6
-
- ARCHOS=x86_LINUX
- ;;
-
- # Mac OS X
- *powerpc*darwin*)
- echo "$as_me:$LINENO: result: configuring for powerpc/darwin" >&5
-echo "${ECHO_T}configuring for powerpc/darwin" >&6
-
- ARCHOS=ppc_DARWIN
- ;;
-
- # cygwin
- *86*cygwin*)
- echo "$as_me:$LINENO: result: configuring for Cygwin on win32/x86" >&5
-echo "${ECHO_T}configuring for Cygwin on win32/x86" >&6
-
- ARCHOS=x86_WIN32
-
- # override CILHOME; even on cygwin we want forward slashes
- # sm: I folded this into what I hope will be the only
- # case-analysis of machine type
- CILHOME=`cygpath -wa "$CILHOME" | sed -e "s/\\\\\/\\//g"`
- CC=`which $CC`
- CC=`cygpath -wa "$CC" | sed -e "s/\\\\\/\\//g"`
- ;;
-
- # Solaris
- *sparc*solaris*)
- echo "$as_me:$LINENO: result: configuring for SPARC/Solaris" >&5
-echo "${ECHO_T}configuring for SPARC/Solaris" >&6
-
- ARCHOS=sparc_SOLARIS
- ;;
-
- *)
- { { echo "$as_me:$LINENO: error:
- Unsupported platform $target -- sorry.
- ./configure supports these platforms:
- on x86: Linux, Win32(with Cygwin), freeBSD, openBSD, and Mac OS X
- on PowerPC: Mac OS X
- on SPARC: Solaris
- " >&5
-echo "$as_me: error:
- Unsupported platform $target -- sorry.
- ./configure supports these platforms:
- on x86: Linux, Win32(with Cygwin), freeBSD, openBSD, and Mac OS X
- on PowerPC: Mac OS X
- on SPARC: Solaris
- " >&2;}
- { (exit 1); exit 1; }; }
- ;;
-esac
-
-# Make the object directory if not already present
-as_ac_File=`echo "ac_cv_file_obj/$ARCHOS" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for obj/$ARCHOS" >&5
-echo $ECHO_N "checking for obj/$ARCHOS... $ECHO_C" >&6
-if eval "test \"\${$as_ac_File+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- test "$cross_compiling" = yes &&
- { { echo "$as_me:$LINENO: error: cannot check for file existence when cross compiling" >&5
-echo "$as_me: error: cannot check for file existence when cross compiling" >&2;}
- { (exit 1); exit 1; }; }
-if test -r "obj/$ARCHOS"; then
- eval "$as_ac_File=yes"
-else
- eval "$as_ac_File=no"
-fi
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_File'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_File'}'`" >&6
-if test `eval echo '${'$as_ac_File'}'` = yes; then
- :
-else
- echo "$as_me:$LINENO: result: creating obj/$ARCHOS" >&5
-echo "${ECHO_T}creating obj/$ARCHOS" >&6;
- mkdir -p obj/$ARCHOS
-fi
-
-
-echo "$as_me:$LINENO: checking delete the obj/$ARCHOS/feature_config.ml and obj/$ARCHOS/machdep.ml file" >&5
-echo $ECHO_N "checking delete the obj/$ARCHOS/feature_config.ml and obj/$ARCHOS/machdep.ml file... $ECHO_C" >&6
-rm -f obj/$ARCHOS/machdep.ml
-rm -f obj/.depend/machdep.d
-rm -f obj/$ARCHOS/feature_config.ml
-rm -f obj/.depend/feature_config.d
-echo "$as_me:$LINENO: result: done" >&5
-echo "${ECHO_T}done" >&6
-
-# We will use substitution variables whose definition contains newlines. The
-# problem is that when config.status runs, it wants to break the series of
-# substitution commands for sed into fragments based on line count. We could
-# be unlucky and have config.status break the series of substitution in the
-# middle of a variable that contains newlines. So, we first create a single
-# variable called NEWLINE whose definition is a carriage return. This means
-# that there will be exactly one opportunity for this error to happen (in the
-# definition of NEWLINE). The occurrence of AC_SUBST for NEWLINE must occur
-# after those of the variables that use it! And we want to put all of these
-# very early on, to make sure that they are not around the place when the file
-# bets broken.
-
-NEWLINE="\\
-"
-
-
-#
-# CIL/CCured features
-#
-#
-
-# Set the defaults
-
-
-# Give a space-separated list of features with the defaults
-features="blockinggraph=no rand=no arithabs=no zrapp=no"
-
-
-# Check whether --with-blockinggraph or --without-blockinggraph was given.
-if test "${with_blockinggraph+set}" = set; then
- withval="$with_blockinggraph"
-
-fi;
-
-# Check whether --with-rand or --without-rand was given.
-if test "${with_rand+set}" = set; then
- withval="$with_rand"
-
-fi;
-
-# Check whether --with-arithabs or --without-arithabs was given.
-if test "${with_arithabs+set}" = set; then
- withval="$with_arithabs"
-
-fi;
-
-# Check whether --with-zrapp or --without-zrapp was given.
-if test "${with_zrapp+set}" = set; then
- withval="$with_zrapp"
-
-fi;
-
-# Smalloc.ml is distributed by {matth,nks}@cs.berkeley.edu as part of Scrash.
-features="$features smalloc=no"
-
-# cqualann.ml is used by Matt Harren. Please ignore.
-features="$features cqualann=no"
-
-# Now add any features specified in the command-line
-
-features="$features $EXTRAFEATURES"
-
-for f_val in $features
-do
- # If there is no =, then we default to yes
- if ! (echo $f_val | grep "=" >/dev/null) ;then f_val="$f_val=yes"; fi
- # echo "Testing feature $f_val"
- f=`echo $f_val | sed -e s%=.*$%%`
- echo "$as_me:$LINENO: checking whether to use CIL feature $f" >&5
-echo $ECHO_N "checking whether to use CIL feature $f... $ECHO_C" >&6
- # default value from "features"
- defval=`echo $f_val | sed -e s%^.*=%%`
- # current value
- getcurval="echo \${with_$f:=$defval}"
- curval=`eval $getcurval`
- echo "$as_me:$LINENO: result: $curval" >&5
-echo "${ECHO_T}$curval" >&6
- if test $curval = yes ;then
- CIL_FEATURES="$CIL_FEATURES $f"
- fi
-done
-
-## Now produce the CIL_FEATURES_DEFINES
-CIL_FEATURES_DEFINES=""
-# Convert to upper case
-for f in `echo $CIL_FEATURES | tr a-z A-Z`
-do
- CIL_FEATURES_DEFINES="${CIL_FEATURES_DEFINES}@NEWLINE@export USE_$f=yes"
-done
-
-
-# ----------------- finish up -------------------
-# names of the variables that get substituted in files; for example,
-# write @ARCHOS@ somewhere in a written file to get it substituted
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-# finish the configure script and generate various files; ./configure
-# will apply variable substitutions to <filename>.in to generate <filename>;
-# I find it useful to mark generated files as read-only so I don't
-# accidentally edit them (and them lose my changes when ./configure
-# runs again); I had originally done the chmod after AC_OUTPUT, but
-# the problem is then the chmod doesn't run inside ./config.status
-
-# MY_AC_CONFIG_FILES(filename)
-# do AC_CONFIG_FILES(filename, chmod a-w filename)
-
-
-
-{
- if test -f Makefile.in; then
- ac_config_files="$ac_config_files Makefile"
-
- else
- true
- #echo "skipping [Makefile] because it's not in this distribution"
- fi
-}
-{
- if test -f cil.spec.in; then
- ac_config_files="$ac_config_files cil.spec"
-
- else
- true
- #echo "skipping [cil.spec] because it's not in this distribution"
- fi
-}
-{
- if test -f config.mk.in; then
- ac_config_files="$ac_config_files config.mk"
-
- else
- true
- #echo "skipping [config.mk] because it's not in this distribution"
- fi
-}
-{
- if test -f test/Makefile.in; then
- ac_config_files="$ac_config_files test/Makefile"
-
- else
- true
- #echo "skipping [test/Makefile] because it's not in this distribution"
- fi
-}
-{
- if test -f bin/cilly.bat.in; then
- ac_config_files="$ac_config_files bin/cilly.bat"
-
- else
- true
- #echo "skipping [bin/cilly.bat] because it's not in this distribution"
- fi
-}
-{
- if test -f bin/patcher.bat.in; then
- ac_config_files="$ac_config_files bin/patcher.bat"
-
- else
- true
- #echo "skipping [bin/patcher.bat] because it's not in this distribution"
- fi
-}
-{
- if test -f bin/CilConfig.pm.in; then
- ac_config_files="$ac_config_files bin/CilConfig.pm"
-
- else
- true
- #echo "skipping [bin/CilConfig.pm] because it's not in this distribution"
- fi
-}
-{
- if test -f doc/index.html.in; then
- ac_config_files="$ac_config_files doc/index.html"
-
- else
- true
- #echo "skipping [doc/index.html] because it's not in this distribution"
- fi
-}
-{
- if test -f doc/header.html.in; then
- ac_config_files="$ac_config_files doc/header.html"
-
- else
- true
- #echo "skipping [doc/header.html] because it's not in this distribution"
- fi
-}
-{
- if test -f ocamlutil/perfcount.c.in; then
- ac_config_files="$ac_config_files ocamlutil/perfcount.c"
-
- else
- true
- #echo "skipping [ocamlutil/perfcount.c] because it's not in this distribution"
- fi
-}
-
-cat >confcache <<\_ACEOF
-# This file is a shell script that caches the results of configure
-# tests run on this system so they can be shared between configure
-# scripts and configure runs, see configure's option --config-cache.
-# It is not useful on other systems. If it contains results you don't
-# want to keep, you may remove or edit it.
-#
-# config.status only pays attention to the cache file if you give it
-# the --recheck option to rerun configure.
-#
-# `ac_cv_env_foo' variables (set or unset) will be overridden when
-# loading this file, other *unset* `ac_cv_foo' will be assigned the
-# following values.
-
-_ACEOF
-
-# The following way of writing the cache mishandles newlines in values,
-# but we know of no workaround that is simple, portable, and efficient.
-# So, don't put newlines in cache variables' values.
-# Ultrix sh set writes to stderr and can't be redirected directly,
-# and sets the high bit in the cache file unless we assign to the vars.
-{
- (set) 2>&1 |
- case `(ac_space=' '; set | grep ac_space) 2>&1` in
- *ac_space=\ *)
- # `set' does not quote correctly, so add quotes (double-quote
- # substitution turns \\\\ into \\, and sed turns \\ into \).
- sed -n \
- "s/'/'\\\\''/g;
- s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
- ;;
- *)
- # `set' quotes correctly as required by POSIX, so do not add quotes.
- sed -n \
- "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
- ;;
- esac;
-} |
- sed '
- t clear
- : clear
- s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
- t end
- /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
- : end' >>confcache
-if diff $cache_file confcache >/dev/null 2>&1; then :; else
- if test -w $cache_file; then
- test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file"
- cat confcache >$cache_file
- else
- echo "not updating unwritable cache $cache_file"
- fi
-fi
-rm -f confcache
-
-test "x$prefix" = xNONE && prefix=$ac_default_prefix
-# Let make expand exec_prefix.
-test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
-
-# VPATH may cause trouble with some makes, so we remove $(srcdir),
-# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
-# trailing colons and then remove the whole line if VPATH becomes empty
-# (actually we leave an empty line to preserve line numbers).
-if test "x$srcdir" = x.; then
- ac_vpsub='/^[ ]*VPATH[ ]*=/{
-s/:*\$(srcdir):*/:/;
-s/:*\${srcdir}:*/:/;
-s/:*@srcdir@:*/:/;
-s/^\([^=]*=[ ]*\):*/\1/;
-s/:*$//;
-s/^[^=]*=[ ]*$//;
-}'
-fi
-
-DEFS=-DHAVE_CONFIG_H
-
-ac_libobjs=
-ac_ltlibobjs=
-for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
- # 1. Remove the extension, and $U if already installed.
- ac_i=`echo "$ac_i" |
- sed 's/\$U\././;s/\.o$//;s/\.obj$//'`
- # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR
- # will be set to the directory where LIBOBJS objects are built.
- ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext"
- ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo'
-done
-LIBOBJS=$ac_libobjs
-
-LTLIBOBJS=$ac_ltlibobjs
-
-
-
-: ${CONFIG_STATUS=./config.status}
-ac_clean_files_save=$ac_clean_files
-ac_clean_files="$ac_clean_files $CONFIG_STATUS"
-{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5
-echo "$as_me: creating $CONFIG_STATUS" >&6;}
-cat >$CONFIG_STATUS <<_ACEOF
-#! $SHELL
-# Generated by $as_me.
-# Run this file to recreate the current configuration.
-# Compiler output produced by configure, useful for debugging
-# configure, is in config.log if it exists.
-
-debug=false
-ac_cs_recheck=false
-ac_cs_silent=false
-SHELL=\${CONFIG_SHELL-$SHELL}
-_ACEOF
-
-cat >>$CONFIG_STATUS <<\_ACEOF
-## --------------------- ##
-## M4sh Initialization. ##
-## --------------------- ##
-
-# Be Bourne compatible
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
- emulate sh
- NULLCMD=:
- # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
- # is contrary to our usage. Disable this feature.
- alias -g '${1+"$@"}'='"$@"'
-elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
- set -o posix
-fi
-DUALCASE=1; export DUALCASE # for MKS sh
-
-# Support unset when possible.
-if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
- as_unset=unset
-else
- as_unset=false
-fi
-
-
-# Work around bugs in pre-3.0 UWIN ksh.
-$as_unset ENV MAIL MAILPATH
-PS1='$ '
-PS2='> '
-PS4='+ '
-
-# NLS nuisances.
-for as_var in \
- LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
- LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
- LC_TELEPHONE LC_TIME
-do
- if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
- eval $as_var=C; export $as_var
- else
- $as_unset $as_var
- fi
-done
-
-# Required to use basename.
-if expr a : '\(a\)' >/dev/null 2>&1; then
- as_expr=expr
-else
- as_expr=false
-fi
-
-if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
- as_basename=basename
-else
- as_basename=false
-fi
-
-
-# Name of the executable.
-as_me=`$as_basename "$0" ||
-$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
- X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)$' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X/"$0" |
- sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
- /^X\/\(\/\/\)$/{ s//\1/; q; }
- /^X\/\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
-
-
-# PATH needs CR, and LINENO needs CR and PATH.
-# Avoid depending upon Character Ranges.
-as_cr_letters='abcdefghijklmnopqrstuvwxyz'
-as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
-as_cr_Letters=$as_cr_letters$as_cr_LETTERS
-as_cr_digits='0123456789'
-as_cr_alnum=$as_cr_Letters$as_cr_digits
-
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- echo "#! /bin/sh" >conf$$.sh
- echo "exit 0" >>conf$$.sh
- chmod +x conf$$.sh
- if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
- PATH_SEPARATOR=';'
- else
- PATH_SEPARATOR=:
- fi
- rm -f conf$$.sh
-fi
-
-
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" || {
- # Find who we are. Look in the path if we contain no path at all
- # relative or not.
- case $0 in
- *[\\/]* ) as_myself=$0 ;;
- *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
-done
-
- ;;
- esac
- # We did not find ourselves, most probably we were run as `sh COMMAND'
- # in which case we are not to be found in the path.
- if test "x$as_myself" = x; then
- as_myself=$0
- fi
- if test ! -f "$as_myself"; then
- { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5
-echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;}
- { (exit 1); exit 1; }; }
- fi
- case $CONFIG_SHELL in
- '')
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for as_base in sh bash ksh sh5; do
- case $as_dir in
- /*)
- if ("$as_dir/$as_base" -c '
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
- $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
- $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
- CONFIG_SHELL=$as_dir/$as_base
- export CONFIG_SHELL
- exec "$CONFIG_SHELL" "$0" ${1+"$@"}
- fi;;
- esac
- done
-done
-;;
- esac
-
- # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
- # uniformly replaced by the line number. The first 'sed' inserts a
- # line-number line before each line; the second 'sed' does the real
- # work. The second script uses 'N' to pair each line-number line
- # with the numbered line, and appends trailing '-' during
- # substitution so that $LINENO is not a special case at line end.
- # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
- # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
- sed '=' <$as_myself |
- sed '
- N
- s,$,-,
- : loop
- s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
- t loop
- s,-$,,
- s,^['$as_cr_digits']*\n,,
- ' >$as_me.lineno &&
- chmod +x $as_me.lineno ||
- { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5
-echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;}
- { (exit 1); exit 1; }; }
-
- # Don't try to exec as it changes $[0], causing all sort of problems
- # (the dirname of $[0] is not the place where we might find the
- # original and so on. Autoconf is especially sensible to this).
- . ./$as_me.lineno
- # Exit status is that of the last command.
- exit
-}
-
-
-case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
- *c*,-n*) ECHO_N= ECHO_C='
-' ECHO_T=' ' ;;
- *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
- *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
-esac
-
-if expr a : '\(a\)' >/dev/null 2>&1; then
- as_expr=expr
-else
- as_expr=false
-fi
-
-rm -f conf$$ conf$$.exe conf$$.file
-echo >conf$$.file
-if ln -s conf$$.file conf$$ 2>/dev/null; then
- # We could just check for DJGPP; but this test a) works b) is more generic
- # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
- if test -f conf$$.exe; then
- # Don't use ln at all; we don't have any links
- as_ln_s='cp -p'
- else
- as_ln_s='ln -s'
- fi
-elif ln conf$$.file conf$$ 2>/dev/null; then
- as_ln_s=ln
-else
- as_ln_s='cp -p'
-fi
-rm -f conf$$ conf$$.exe conf$$.file
-
-if mkdir -p . 2>/dev/null; then
- as_mkdir_p=:
-else
- test -d ./-p && rmdir ./-p
- as_mkdir_p=false
-fi
-
-as_executable_p="test -f"
-
-# Sed expression to map a string onto a valid CPP name.
-as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
-
-# Sed expression to map a string onto a valid variable name.
-as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
-
-
-# IFS
-# We need space, tab and new line, in precisely that order.
-as_nl='
-'
-IFS=" $as_nl"
-
-# CDPATH.
-$as_unset CDPATH
-
-exec 6>&1
-
-# Open the log real soon, to keep \$[0] and so on meaningful, and to
-# report actual input values of CONFIG_FILES etc. instead of their
-# values after options handling. Logging --version etc. is OK.
-exec 5>>config.log
-{
- echo
- sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
-## Running $as_me. ##
-_ASBOX
-} >&5
-cat >&5 <<_CSEOF
-
-This file was extended by $as_me, which was
-generated by GNU Autoconf 2.59. Invocation command line was
-
- CONFIG_FILES = $CONFIG_FILES
- CONFIG_HEADERS = $CONFIG_HEADERS
- CONFIG_LINKS = $CONFIG_LINKS
- CONFIG_COMMANDS = $CONFIG_COMMANDS
- $ $0 $@
-
-_CSEOF
-echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
-echo >&5
-_ACEOF
-
-# Files that config.status was made for.
-if test -n "$ac_config_files"; then
- echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS
-fi
-
-if test -n "$ac_config_headers"; then
- echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS
-fi
-
-if test -n "$ac_config_links"; then
- echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS
-fi
-
-if test -n "$ac_config_commands"; then
- echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS
-fi
-
-cat >>$CONFIG_STATUS <<\_ACEOF
-
-ac_cs_usage="\
-\`$as_me' instantiates files from templates according to the
-current configuration.
-
-Usage: $0 [OPTIONS] [FILE]...
-
- -h, --help print this help, then exit
- -V, --version print version number, then exit
- -q, --quiet do not print progress messages
- -d, --debug don't remove temporary files
- --recheck update $as_me by reconfiguring in the same conditions
- --file=FILE[:TEMPLATE]
- instantiate the configuration file FILE
- --header=FILE[:TEMPLATE]
- instantiate the configuration header FILE
-
-Configuration files:
-$config_files
-
-Configuration headers:
-$config_headers
-
-Report bugs to <bug-autoconf@gnu.org>."
-_ACEOF
-
-cat >>$CONFIG_STATUS <<_ACEOF
-ac_cs_version="\\
-config.status
-configured by $0, generated by GNU Autoconf 2.59,
- with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"
-
-Copyright (C) 2003 Free Software Foundation, Inc.
-This config.status script is free software; the Free Software Foundation
-gives unlimited permission to copy, distribute and modify it."
-srcdir=$srcdir
-INSTALL="$INSTALL"
-_ACEOF
-
-cat >>$CONFIG_STATUS <<\_ACEOF
-# If no file are specified by the user, then we need to provide default
-# value. By we need to know if files were specified by the user.
-ac_need_defaults=:
-while test $# != 0
-do
- case $1 in
- --*=*)
- ac_option=`expr "x$1" : 'x\([^=]*\)='`
- ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'`
- ac_shift=:
- ;;
- -*)
- ac_option=$1
- ac_optarg=$2
- ac_shift=shift
- ;;
- *) # This is not an option, so the user has probably given explicit
- # arguments.
- ac_option=$1
- ac_need_defaults=false;;
- esac
-
- case $ac_option in
- # Handling of the options.
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
- -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
- ac_cs_recheck=: ;;
- --version | --vers* | -V )
- echo "$ac_cs_version"; exit 0 ;;
- --he | --h)
- # Conflict between --help and --header
- { { echo "$as_me:$LINENO: error: ambiguous option: $1
-Try \`$0 --help' for more information." >&5
-echo "$as_me: error: ambiguous option: $1
-Try \`$0 --help' for more information." >&2;}
- { (exit 1); exit 1; }; };;
- --help | --hel | -h )
- echo "$ac_cs_usage"; exit 0 ;;
- --debug | --d* | -d )
- debug=: ;;
- --file | --fil | --fi | --f )
- $ac_shift
- CONFIG_FILES="$CONFIG_FILES $ac_optarg"
- ac_need_defaults=false;;
- --header | --heade | --head | --hea )
- $ac_shift
- CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"
- ac_need_defaults=false;;
- -q | -quiet | --quiet | --quie | --qui | --qu | --q \
- | -silent | --silent | --silen | --sile | --sil | --si | --s)
- ac_cs_silent=: ;;
-
- # This is an error.
- -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1
-Try \`$0 --help' for more information." >&5
-echo "$as_me: error: unrecognized option: $1
-Try \`$0 --help' for more information." >&2;}
- { (exit 1); exit 1; }; } ;;
-
- *) ac_config_targets="$ac_config_targets $1" ;;
-
- esac
- shift
-done
-
-ac_configure_extra_args=
-
-if $ac_cs_silent; then
- exec 6>/dev/null
- ac_configure_extra_args="$ac_configure_extra_args --silent"
-fi
-
-_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF
-if \$ac_cs_recheck; then
- echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6
- exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
-fi
-
-_ACEOF
-
-
-
-
-
-cat >>$CONFIG_STATUS <<\_ACEOF
-for ac_config_target in $ac_config_targets
-do
- case "$ac_config_target" in
- # Handling of arguments.
- "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;
- "cil.spec" ) CONFIG_FILES="$CONFIG_FILES cil.spec" ;;
- "config.mk" ) CONFIG_FILES="$CONFIG_FILES config.mk" ;;
- "test/Makefile" ) CONFIG_FILES="$CONFIG_FILES test/Makefile" ;;
- "bin/cilly.bat" ) CONFIG_FILES="$CONFIG_FILES bin/cilly.bat" ;;
- "bin/patcher.bat" ) CONFIG_FILES="$CONFIG_FILES bin/patcher.bat" ;;
- "bin/CilConfig.pm" ) CONFIG_FILES="$CONFIG_FILES bin/CilConfig.pm" ;;
- "doc/index.html" ) CONFIG_FILES="$CONFIG_FILES doc/index.html" ;;
- "doc/header.html" ) CONFIG_FILES="$CONFIG_FILES doc/header.html" ;;
- "ocamlutil/perfcount.c" ) CONFIG_FILES="$CONFIG_FILES ocamlutil/perfcount.c" ;;
- "config.h" ) CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;;
- *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
-echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
- { (exit 1); exit 1; }; };;
- esac
-done
-
-# If the user did not use the arguments to specify the items to instantiate,
-# then the envvar interface is used. Set only those that are not.
-# We use the long form for the default assignment because of an extremely
-# bizarre bug on SunOS 4.1.3.
-if $ac_need_defaults; then
- test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
- test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers
-fi
-
-# Have a temporary directory for convenience. Make it in the build tree
-# simply because there is no reason to put it here, and in addition,
-# creating and moving files from /tmp can sometimes cause problems.
-# Create a temporary directory, and hook for its removal unless debugging.
-$debug ||
-{
- trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0
- trap '{ (exit 1); exit 1; }' 1 2 13 15
-}
-
-# Create a (secure) tmp directory for tmp files.
-
-{
- tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` &&
- test -n "$tmp" && test -d "$tmp"
-} ||
-{
- tmp=./confstat$$-$RANDOM
- (umask 077 && mkdir $tmp)
-} ||
-{
- echo "$me: cannot create a temporary directory in ." >&2
- { (exit 1); exit 1; }
-}
-
-_ACEOF
-
-cat >>$CONFIG_STATUS <<_ACEOF
-
-#
-# CONFIG_FILES section.
-#
-
-# No need to generate the scripts if there are no CONFIG_FILES.
-# This happens for instance when ./config.status config.h
-if test -n "\$CONFIG_FILES"; then
- # Protect against being on the right side of a sed subst in config.status.
- sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g;
- s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF
-s,@CIL_FEATURES_DEFINES@,$CIL_FEATURES_DEFINES,;t t
-s,@NEWLINE@,$NEWLINE,;t t
-s,@SHELL@,$SHELL,;t t
-s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t
-s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t
-s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t
-s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t
-s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t
-s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t
-s,@exec_prefix@,$exec_prefix,;t t
-s,@prefix@,$prefix,;t t
-s,@program_transform_name@,$program_transform_name,;t t
-s,@bindir@,$bindir,;t t
-s,@sbindir@,$sbindir,;t t
-s,@libexecdir@,$libexecdir,;t t
-s,@datadir@,$datadir,;t t
-s,@sysconfdir@,$sysconfdir,;t t
-s,@sharedstatedir@,$sharedstatedir,;t t
-s,@localstatedir@,$localstatedir,;t t
-s,@libdir@,$libdir,;t t
-s,@includedir@,$includedir,;t t
-s,@oldincludedir@,$oldincludedir,;t t
-s,@infodir@,$infodir,;t t
-s,@mandir@,$mandir,;t t
-s,@build_alias@,$build_alias,;t t
-s,@host_alias@,$host_alias,;t t
-s,@target_alias@,$target_alias,;t t
-s,@DEFS@,$DEFS,;t t
-s,@ECHO_C@,$ECHO_C,;t t
-s,@ECHO_N@,$ECHO_N,;t t
-s,@ECHO_T@,$ECHO_T,;t t
-s,@LIBS@,$LIBS,;t t
-s,@CC@,$CC,;t t
-s,@CFLAGS@,$CFLAGS,;t t
-s,@LDFLAGS@,$LDFLAGS,;t t
-s,@CPPFLAGS@,$CPPFLAGS,;t t
-s,@ac_ct_CC@,$ac_ct_CC,;t t
-s,@EXEEXT@,$EXEEXT,;t t
-s,@OBJEXT@,$OBJEXT,;t t
-s,@INSTALL_PROGRAM@,$INSTALL_PROGRAM,;t t
-s,@INSTALL_SCRIPT@,$INSTALL_SCRIPT,;t t
-s,@INSTALL_DATA@,$INSTALL_DATA,;t t
-s,@build@,$build,;t t
-s,@build_cpu@,$build_cpu,;t t
-s,@build_vendor@,$build_vendor,;t t
-s,@build_os@,$build_os,;t t
-s,@host@,$host,;t t
-s,@host_cpu@,$host_cpu,;t t
-s,@host_vendor@,$host_vendor,;t t
-s,@host_os@,$host_os,;t t
-s,@target@,$target,;t t
-s,@target_cpu@,$target_cpu,;t t
-s,@target_vendor@,$target_vendor,;t t
-s,@target_os@,$target_os,;t t
-s,@CPP@,$CPP,;t t
-s,@EGREP@,$EGREP,;t t
-s,@LIBOBJS@,$LIBOBJS,;t t
-s,@ARCHOS@,$ARCHOS,;t t
-s,@CILHOME@,$CILHOME,;t t
-s,@HAS_MSVC@,$HAS_MSVC,;t t
-s,@DEFAULT_COMPILER@,$DEFAULT_COMPILER,;t t
-s,@DEFAULT_CIL_MODE@,$DEFAULT_CIL_MODE,;t t
-s,@CIL_VERSION_MAJOR@,$CIL_VERSION_MAJOR,;t t
-s,@CIL_VERSION_MINOR@,$CIL_VERSION_MINOR,;t t
-s,@CIL_VERSION_REV@,$CIL_VERSION_REV,;t t
-s,@CIL_VERSION@,$CIL_VERSION,;t t
-s,@CYCLES_PER_USEC@,$CYCLES_PER_USEC,;t t
-s,@HAS_PERFCOUNT@,$HAS_PERFCOUNT,;t t
-s,@HAVE_BUILTIN_VA_LIST@,$HAVE_BUILTIN_VA_LIST,;t t
-s,@THREAD_IS_KEYWORD@,$THREAD_IS_KEYWORD,;t t
-s,@UNDERSCORE_NAME@,$UNDERSCORE_NAME,;t t
-s,@EXTRAFEATURES@,$EXTRAFEATURES,;t t
-s,@EXTRASRCDIRS@,$EXTRASRCDIRS,;t t
-s,@LTLIBOBJS@,$LTLIBOBJS,;t t
-CEOF
-
-_ACEOF
-
- cat >>$CONFIG_STATUS <<\_ACEOF
- # Split the substitutions into bite-sized pieces for seds with
- # small command number limits, like on Digital OSF/1 and HP-UX.
- ac_max_sed_lines=48
- ac_sed_frag=1 # Number of current file.
- ac_beg=1 # First line for current file.
- ac_end=$ac_max_sed_lines # Line after last line for current file.
- ac_more_lines=:
- ac_sed_cmds=
- while $ac_more_lines; do
- if test $ac_beg -gt 1; then
- sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
- else
- sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
- fi
- if test ! -s $tmp/subs.frag; then
- ac_more_lines=false
- else
- # The purpose of the label and of the branching condition is to
- # speed up the sed processing (if there are no `@' at all, there
- # is no need to browse any of the substitutions).
- # These are the two extra sed commands mentioned above.
- (echo ':t
- /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed
- if test -z "$ac_sed_cmds"; then
- ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed"
- else
- ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed"
- fi
- ac_sed_frag=`expr $ac_sed_frag + 1`
- ac_beg=$ac_end
- ac_end=`expr $ac_end + $ac_max_sed_lines`
- fi
- done
- if test -z "$ac_sed_cmds"; then
- ac_sed_cmds=cat
- fi
-fi # test -n "$CONFIG_FILES"
-
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue
- # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
- case $ac_file in
- - | *:- | *:-:* ) # input from stdin
- cat >$tmp/stdin
- ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
- ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
- *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
- ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
- * ) ac_file_in=$ac_file.in ;;
- esac
-
- # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
- ac_dir=`(dirname "$ac_file") 2>/dev/null ||
-$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$ac_file" : 'X\(//\)[^/]' \| \
- X"$ac_file" : 'X\(//\)$' \| \
- X"$ac_file" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$ac_file" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- { if $as_mkdir_p; then
- mkdir -p "$ac_dir"
- else
- as_dir="$ac_dir"
- as_dirs=
- while test ! -d "$as_dir"; do
- as_dirs="$as_dir $as_dirs"
- as_dir=`(dirname "$as_dir") 2>/dev/null ||
-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$as_dir" : 'X\(//\)[^/]' \| \
- X"$as_dir" : 'X\(//\)$' \| \
- X"$as_dir" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$as_dir" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- done
- test ! -n "$as_dirs" || mkdir $as_dirs
- fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
-echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
- { (exit 1); exit 1; }; }; }
-
- ac_builddir=.
-
-if test "$ac_dir" != .; then
- ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
- # A "../" for each directory in $ac_dir_suffix.
- ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
-else
- ac_dir_suffix= ac_top_builddir=
-fi
-
-case $srcdir in
- .) # No --srcdir option. We are building in place.
- ac_srcdir=.
- if test -z "$ac_top_builddir"; then
- ac_top_srcdir=.
- else
- ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
- fi ;;
- [\\/]* | ?:[\\/]* ) # Absolute path.
- ac_srcdir=$srcdir$ac_dir_suffix;
- ac_top_srcdir=$srcdir ;;
- *) # Relative path.
- ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
- ac_top_srcdir=$ac_top_builddir$srcdir ;;
-esac
-
-# Do not use `cd foo && pwd` to compute absolute paths, because
-# the directories may not exist.
-case `pwd` in
-.) ac_abs_builddir="$ac_dir";;
-*)
- case "$ac_dir" in
- .) ac_abs_builddir=`pwd`;;
- [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
- *) ac_abs_builddir=`pwd`/"$ac_dir";;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_builddir=${ac_top_builddir}.;;
-*)
- case ${ac_top_builddir}. in
- .) ac_abs_top_builddir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
- *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_srcdir=$ac_srcdir;;
-*)
- case $ac_srcdir in
- .) ac_abs_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
- *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_srcdir=$ac_top_srcdir;;
-*)
- case $ac_top_srcdir in
- .) ac_abs_top_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
- *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
- esac;;
-esac
-
-
- case $INSTALL in
- [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;;
- *) ac_INSTALL=$ac_top_builddir$INSTALL ;;
- esac
-
- if test x"$ac_file" != x-; then
- { echo "$as_me:$LINENO: creating $ac_file" >&5
-echo "$as_me: creating $ac_file" >&6;}
- rm -f "$ac_file"
- fi
- # Let's still pretend it is `configure' which instantiates (i.e., don't
- # use $as_me), people would be surprised to read:
- # /* config.h. Generated by config.status. */
- if test x"$ac_file" = x-; then
- configure_input=
- else
- configure_input="$ac_file. "
- fi
- configure_input=$configure_input"Generated from `echo $ac_file_in |
- sed 's,.*/,,'` by configure."
-
- # First look for the input files in the build tree, otherwise in the
- # src tree.
- ac_file_inputs=`IFS=:
- for f in $ac_file_in; do
- case $f in
- -) echo $tmp/stdin ;;
- [\\/$]*)
- # Absolute (can't be DOS-style, as IFS=:)
- test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
-echo "$as_me: error: cannot find input file: $f" >&2;}
- { (exit 1); exit 1; }; }
- echo "$f";;
- *) # Relative
- if test -f "$f"; then
- # Build tree
- echo "$f"
- elif test -f "$srcdir/$f"; then
- # Source tree
- echo "$srcdir/$f"
- else
- # /dev/null tree
- { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
-echo "$as_me: error: cannot find input file: $f" >&2;}
- { (exit 1); exit 1; }; }
- fi;;
- esac
- done` || { (exit 1); exit 1; }
-_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF
- sed "$ac_vpsub
-$extrasub
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-:t
-/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
-s,@configure_input@,$configure_input,;t t
-s,@srcdir@,$ac_srcdir,;t t
-s,@abs_srcdir@,$ac_abs_srcdir,;t t
-s,@top_srcdir@,$ac_top_srcdir,;t t
-s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t
-s,@builddir@,$ac_builddir,;t t
-s,@abs_builddir@,$ac_abs_builddir,;t t
-s,@top_builddir@,$ac_top_builddir,;t t
-s,@abs_top_builddir@,$ac_abs_top_builddir,;t t
-s,@INSTALL@,$ac_INSTALL,;t t
-" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out
- rm -f $tmp/stdin
- if test x"$ac_file" != x-; then
- mv $tmp/out $ac_file
- else
- cat $tmp/out
- rm -f $tmp/out
- fi
-
- # Run the commands associated with the file.
- case $ac_file in
- Makefile ) chmod a-w Makefile ;;
- cil.spec ) chmod a-w cil.spec ;;
- config.mk ) chmod a-w config.mk ;;
- test/Makefile ) chmod a-w test/Makefile ;;
- bin/cilly.bat ) chmod a-w,a+x bin/cilly.bat ;;
- bin/patcher.bat ) chmod a-w,a+x bin/patcher.bat ;;
- bin/CilConfig.pm ) chmod a-w bin/CilConfig.pm ;;
- doc/index.html ) chmod a-w doc/index.html ;;
- doc/header.html ) chmod a-w doc/header.html ;;
- ocamlutil/perfcount.c ) chmod a-w ocamlutil/perfcount.c ;;
- esac
-done
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-
-#
-# CONFIG_HEADER section.
-#
-
-# These sed commands are passed to sed as "A NAME B NAME C VALUE D", where
-# NAME is the cpp macro being defined and VALUE is the value it is being given.
-#
-# ac_d sets the value in "#define NAME VALUE" lines.
-ac_dA='s,^\([ ]*\)#\([ ]*define[ ][ ]*\)'
-ac_dB='[ ].*$,\1#\2'
-ac_dC=' '
-ac_dD=',;t'
-# ac_u turns "#undef NAME" without trailing blanks into "#define NAME VALUE".
-ac_uA='s,^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)'
-ac_uB='$,\1#\2define\3'
-ac_uC=' '
-ac_uD=',;t'
-
-for ac_file in : $CONFIG_HEADERS; do test "x$ac_file" = x: && continue
- # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
- case $ac_file in
- - | *:- | *:-:* ) # input from stdin
- cat >$tmp/stdin
- ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
- ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
- *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
- ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
- * ) ac_file_in=$ac_file.in ;;
- esac
-
- test x"$ac_file" != x- && { echo "$as_me:$LINENO: creating $ac_file" >&5
-echo "$as_me: creating $ac_file" >&6;}
-
- # First look for the input files in the build tree, otherwise in the
- # src tree.
- ac_file_inputs=`IFS=:
- for f in $ac_file_in; do
- case $f in
- -) echo $tmp/stdin ;;
- [\\/$]*)
- # Absolute (can't be DOS-style, as IFS=:)
- test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
-echo "$as_me: error: cannot find input file: $f" >&2;}
- { (exit 1); exit 1; }; }
- # Do quote $f, to prevent DOS paths from being IFS'd.
- echo "$f";;
- *) # Relative
- if test -f "$f"; then
- # Build tree
- echo "$f"
- elif test -f "$srcdir/$f"; then
- # Source tree
- echo "$srcdir/$f"
- else
- # /dev/null tree
- { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
-echo "$as_me: error: cannot find input file: $f" >&2;}
- { (exit 1); exit 1; }; }
- fi;;
- esac
- done` || { (exit 1); exit 1; }
- # Remove the trailing spaces.
- sed 's/[ ]*$//' $ac_file_inputs >$tmp/in
-
-_ACEOF
-
-# Transform confdefs.h into two sed scripts, `conftest.defines' and
-# `conftest.undefs', that substitutes the proper values into
-# config.h.in to produce config.h. The first handles `#define'
-# templates, and the second `#undef' templates.
-# And first: Protect against being on the right side of a sed subst in
-# config.status. Protect against being in an unquoted here document
-# in config.status.
-rm -f conftest.defines conftest.undefs
-# Using a here document instead of a string reduces the quoting nightmare.
-# Putting comments in sed scripts is not portable.
-#
-# `end' is used to avoid that the second main sed command (meant for
-# 0-ary CPP macros) applies to n-ary macro definitions.
-# See the Autoconf documentation for `clear'.
-cat >confdef2sed.sed <<\_ACEOF
-s/[\\&,]/\\&/g
-s,[\\$`],\\&,g
-t clear
-: clear
-s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*\)\(([^)]*)\)[ ]*\(.*\)$,${ac_dA}\1${ac_dB}\1\2${ac_dC}\3${ac_dD},gp
-t end
-s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)$,${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD},gp
-: end
-_ACEOF
-# If some macros were called several times there might be several times
-# the same #defines, which is useless. Nevertheless, we may not want to
-# sort them, since we want the *last* AC-DEFINE to be honored.
-uniq confdefs.h | sed -n -f confdef2sed.sed >conftest.defines
-sed 's/ac_d/ac_u/g' conftest.defines >conftest.undefs
-rm -f confdef2sed.sed
-
-# This sed command replaces #undef with comments. This is necessary, for
-# example, in the case of _POSIX_SOURCE, which is predefined and required
-# on some systems where configure will not decide to define it.
-cat >>conftest.undefs <<\_ACEOF
-s,^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*,/* & */,
-_ACEOF
-
-# Break up conftest.defines because some shells have a limit on the size
-# of here documents, and old seds have small limits too (100 cmds).
-echo ' # Handle all the #define templates only if necessary.' >>$CONFIG_STATUS
-echo ' if grep "^[ ]*#[ ]*define" $tmp/in >/dev/null; then' >>$CONFIG_STATUS
-echo ' # If there are no defines, we may have an empty if/fi' >>$CONFIG_STATUS
-echo ' :' >>$CONFIG_STATUS
-rm -f conftest.tail
-while grep . conftest.defines >/dev/null
-do
- # Write a limited-size here document to $tmp/defines.sed.
- echo ' cat >$tmp/defines.sed <<CEOF' >>$CONFIG_STATUS
- # Speed up: don't consider the non `#define' lines.
- echo '/^[ ]*#[ ]*define/!b' >>$CONFIG_STATUS
- # Work around the forget-to-reset-the-flag bug.
- echo 't clr' >>$CONFIG_STATUS
- echo ': clr' >>$CONFIG_STATUS
- sed ${ac_max_here_lines}q conftest.defines >>$CONFIG_STATUS
- echo 'CEOF
- sed -f $tmp/defines.sed $tmp/in >$tmp/out
- rm -f $tmp/in
- mv $tmp/out $tmp/in
-' >>$CONFIG_STATUS
- sed 1,${ac_max_here_lines}d conftest.defines >conftest.tail
- rm -f conftest.defines
- mv conftest.tail conftest.defines
-done
-rm -f conftest.defines
-echo ' fi # grep' >>$CONFIG_STATUS
-echo >>$CONFIG_STATUS
-
-# Break up conftest.undefs because some shells have a limit on the size
-# of here documents, and old seds have small limits too (100 cmds).
-echo ' # Handle all the #undef templates' >>$CONFIG_STATUS
-rm -f conftest.tail
-while grep . conftest.undefs >/dev/null
-do
- # Write a limited-size here document to $tmp/undefs.sed.
- echo ' cat >$tmp/undefs.sed <<CEOF' >>$CONFIG_STATUS
- # Speed up: don't consider the non `#undef'
- echo '/^[ ]*#[ ]*undef/!b' >>$CONFIG_STATUS
- # Work around the forget-to-reset-the-flag bug.
- echo 't clr' >>$CONFIG_STATUS
- echo ': clr' >>$CONFIG_STATUS
- sed ${ac_max_here_lines}q conftest.undefs >>$CONFIG_STATUS
- echo 'CEOF
- sed -f $tmp/undefs.sed $tmp/in >$tmp/out
- rm -f $tmp/in
- mv $tmp/out $tmp/in
-' >>$CONFIG_STATUS
- sed 1,${ac_max_here_lines}d conftest.undefs >conftest.tail
- rm -f conftest.undefs
- mv conftest.tail conftest.undefs
-done
-rm -f conftest.undefs
-
-cat >>$CONFIG_STATUS <<\_ACEOF
- # Let's still pretend it is `configure' which instantiates (i.e., don't
- # use $as_me), people would be surprised to read:
- # /* config.h. Generated by config.status. */
- if test x"$ac_file" = x-; then
- echo "/* Generated by configure. */" >$tmp/config.h
- else
- echo "/* $ac_file. Generated by configure. */" >$tmp/config.h
- fi
- cat $tmp/in >>$tmp/config.h
- rm -f $tmp/in
- if test x"$ac_file" != x-; then
- if diff $ac_file $tmp/config.h >/dev/null 2>&1; then
- { echo "$as_me:$LINENO: $ac_file is unchanged" >&5
-echo "$as_me: $ac_file is unchanged" >&6;}
- else
- ac_dir=`(dirname "$ac_file") 2>/dev/null ||
-$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$ac_file" : 'X\(//\)[^/]' \| \
- X"$ac_file" : 'X\(//\)$' \| \
- X"$ac_file" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$ac_file" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- { if $as_mkdir_p; then
- mkdir -p "$ac_dir"
- else
- as_dir="$ac_dir"
- as_dirs=
- while test ! -d "$as_dir"; do
- as_dirs="$as_dir $as_dirs"
- as_dir=`(dirname "$as_dir") 2>/dev/null ||
-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$as_dir" : 'X\(//\)[^/]' \| \
- X"$as_dir" : 'X\(//\)$' \| \
- X"$as_dir" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$as_dir" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- done
- test ! -n "$as_dirs" || mkdir $as_dirs
- fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
-echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
- { (exit 1); exit 1; }; }; }
-
- rm -f $ac_file
- mv $tmp/config.h $ac_file
- fi
- else
- cat $tmp/config.h
- rm -f $tmp/config.h
- fi
-done
-_ACEOF
-
-cat >>$CONFIG_STATUS <<\_ACEOF
-
-{ (exit 0); exit 0; }
-_ACEOF
-chmod +x $CONFIG_STATUS
-ac_clean_files=$ac_clean_files_save
-
-
-# configure is writing to config.log, and then calls config.status.
-# config.status does its own redirection, appending to config.log.
-# Unfortunately, on DOS this fails, as config.log is still kept open
-# by configure, so config.status won't be able to write to it; its
-# output is simply discarded. So we exec the FD to /dev/null,
-# effectively closing config.log, so it can be properly (re)opened and
-# appended to by config.status. When coming back to configure, we
-# need to make the FD available again.
-if test "$no_create" != yes; then
- ac_cs_success=:
- ac_config_status_args=
- test "$silent" = yes &&
- ac_config_status_args="$ac_config_status_args --quiet"
- exec 5>/dev/null
- $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
- exec 5>>config.log
- # Use ||, not &&, to avoid exiting from the if with $? = 1, which
- # would make configure fail if this is the last instruction.
- $ac_cs_success || { (exit 1); exit 1; }
-fi
-
-
-# show the user what the variables have been set to
-cat <<EOF
-
-CIL configuration:
- architecture/OS: ARCHOS $ARCHOS
- source tree root: CILHOME $CILHOME
- (optional) cl.exe found: HAS_MSVC $HAS_MSVC
- gcc to use CC $CC
- default compiler DEFAULT_COMPILER $DEFAULT_COMPILER
- CIL version CIL_VERSION $CIL_VERSION
- CIL features CIL_FEATURES $CIL_FEATURES
- Extra source directories EXTRASRCDIRS $EXTRASRCDIRS
- Cycles per microsecond CYCLES_PER_USEC $CYCLES_PER_USEC
-EOF
-
diff --git a/cil/configure.in b/cil/configure.in
deleted file mode 100644
index aee7ac73de3af4fe6964180153f6f0a50931b143..0000000000000000000000000000000000000000
--- a/cil/configure.in
+++ /dev/null
@@ -1,600 +0,0 @@
-# configure.in for CIL -*- sh -*-
-# Process this file with autoconf to produce a configure script.
-
-# Autoconf runs this through the M4 macroprocessor first; lines
-# starting with "dnl" are comments to M4. The result is a bash
-# script; any text which isn't an M4/autoconf directive gets
-# copied verbatim to that script.
-
-# also, in general, watch out: the M4 quoting charactes are
-# the square brackets: [ and ]. if you want to pass brackets
-# to something, you can quote the brackets with more brackets.
-# I don't know how to pass a single (unbalanced) bracket ..
-
-# sm: changed this file to use '#' for comments, since that's
-# just as good (since this becomes an 'sh' script)
-
-
-# We must put these AC_SUBST very early, and in this order. See below where we
-# define NEWLINE
-AC_SUBST(CIL_FEATURES_DEFINES)
-AC_SUBST(NEWLINE)
-
-
-# -------------- usual initial stuff -------------
-# this simply names a file somewhere in the source tree to verify
-# we're in the right directory
-AC_INIT(src/cil.mli)
-AC_CONFIG_HEADERS(config.h)
-
-# sm: require a late-enough autoconf; this is the version number
-# that's on manju, so I assume it's ok
-AC_PREREQ(2.50)
-
-#
-# Assign here the CIL version numbers
-CIL_VERSION_MAJOR=1
-CIL_VERSION_MINOR=3
-CIL_VERSION_REV=5
-CIL_VERSION=$CIL_VERSION_MAJOR.$CIL_VERSION_MINOR.$CIL_VERSION_REV
-
-
-# make sure I haven't forgotten to run autoconf
-if test configure -ot configure.in; then
- AC_MSG_ERROR(configure is older than configure.in; you forgot to run autoconf)
-fi
-
-# check for C compiler; this typically finds gcc; it sets the
-# variable CC to whatever it finds, which then gets substituted
-# for @CC@ in output files; you have to do this even if you don't
-# care about @CC@, because system feature tests later on in
-# the ./configure script will expect $CC to be set right
-AC_PROG_CC
-
-AC_PROG_INSTALL
-
-
-# find system type (using this macro means we must include
-# the files install-sh, config.sub, and config.guess (all from
-# the autoconf distribution) in our source tree!)
-AC_CANONICAL_SYSTEM
-
-
-# ---------------- generic functions -----------------
-# debugging diagnostic; set to 'echo' to debug or 'true' for production
-# (technically you're not supposed to use shell functions in
-# configure scripts, because some-obscure-sh somewhere doesn't
-# support them.. but they're too convenient to not use)
-diagnostic() {
- #echo "$@"
- true "$@"
-}
-
-# determine if a binary is in the path
-binaryExists() {
- # on cygwin, 'which' always returns success, so use 'type' instead
- if type "$1" >/dev/null 2>&1; then
- return 0
- else
- return 1
- fi
-}
-
-
-# -------------- portable configuration ----------------
-# this specifies the root of the source tree; it's just the
-# directory where ./configure runs, except on cygwin, which
-# overrides this below
-CILHOME=`pwd`
-
-DEFAULT_COMPILER=_GNUCC
-DEFAULT_CIL_MODE=GNUCC
-
-# is the microsoft compiler available?
-# hmm.. I think we should check the version or something, because
-# sometimes people have Common Lisp's interpreter called 'cl' ..
-AC_MSG_CHECKING(for msvc cl.exe (optional))
-# See if CC points to the MS compiler
-if "$CC" 2>&1 | grep "Microsoft" >/dev/null; then
- AC_MSG_RESULT([found, set as default])
- HAS_MSVC=yes
- DEFAULT_COMPILER=_MSVC
- DEFAULT_CIL_MODE=MSVC
-else
- if cl 2>&1 | grep "Microsoft" >/dev/null ;then
- AC_MSG_RESULT(found)
- HAS_MSVC=yes
- else
- AC_MSG_RESULT(not found)
- HAS_MSVC=no
- fi
-fi
-
-# is ocaml available?
-# needed binaries: ocamllex ocamlyacc ocamldep ocamlopt ocamlc
-ocamlDownloadInstructions="
- OCaml can be downloaded from http://caml.inria.fr/ocaml/.
- After downloading and unpacking the source distribution, in the ocaml
- directory, do
- ./configure
- make world
- make opt
- make install
- Then come back here and re-run ./configure."
-
-# required major/minor.
-# required major/minor
-reqMaj=3
-reqMin=08
-knownMaj=3
-knownMin=09
-AC_MSG_CHECKING(ocaml version is at least $reqMaj.$reqMin)
-if binaryExists ocamlc; then
- # what version?
- ver=`ocamlc -v | grep version | sed 's/^.*version //'`
- diagnostic "ver is $ver"
- # major: anything before the .
- major=`echo $ver | sed 's/\..*$//'`
- diagnostic "major is $major"
- # minor: numbers after the .
- # (the outer level of bracket-quotation protects the inner brackets)
- [minor=`echo $ver | sed 's/^[^.]*\.\([0-9][0-9]*\).*$/\1/'`]
- diagnostic "minor is $minor"
-
- # I would think autoconf would already have a facility for doing
- # these kinds of major/minor version checks, but I can't find it
- if test $major -gt $reqMaj -o $major -ge $reqMaj -a $minor -ge $reqMin; then
- AC_MSG_RESULT([version is $ver, ok])
-
- # sm: added this test when we found that CCured needed to be changed
- # a little when 3.06 came out (it had previously worked with 3.04)
- if test "$major" -gt $knownMaj -o "$major" -ge $knownMaj -a "$minor" -gt $knownMin; then
- AC_MSG_WARN([Your ocaml version is $ver, but the latest version this program
- is known to work with is $knownMaj.$knownMin. If you have
- trouble compiling, please try using an earlier version
- or see if there is a later version of this program.])
- fi
- else
- AC_MSG_ERROR([
- I found OCaml version $ver; this program requires at least $reqMaj.$reqMin.
- Please download a newer OCaml distribution.
- $ocamlDownloadInstructions
- ])
- fi
-
- # check for existence of other binaries
- AC_MSG_CHECKING(existence of related ocaml tools)
- if binaryExists ocamllex && \
- binaryExists ocamlyacc && \
- binaryExists ocamldep && \
- binaryExists ocamlopt; then
- AC_MSG_RESULT(ok)
- else
- AC_MSG_ERROR([
- At least one of ocamllex, ocamlyacc, ocamldep or ocamlopt is missing.
- In particular, ocamlopt requires you to "make opt" when building
- OCaml from source. Please make sure all these tools are built and
- in the path.
- ])
- fi
-else
- AC_MSG_ERROR([
- The "ocamlc" OCaml compiler was not found in the path: $PATH.
-
- Most of this program is written in the OCaml language, so its compiler
- is required.
- $ocamlDownloadInstructions
- ])
-fi
-
-#
-# ------------------- Perl ----------------
-#
-AC_MSG_CHECKING([for Perl])
- if ! binaryExists perl; then
- AC_MSG_ERROR([
- perl not found.
- You need perl version 5.6.1 or later for CIL.
- You can get perl at http://www.cpan.org/src/index.html .
- ])
- fi
-
- # sm: oh how nice it would be to just say "use English;
- # print($PERL_VERSION)", but that appears broken on 5.6.1.. so I'm
- # trying to say "caret right-bracket", but then that would run afoul
- # of autoconf's quoting characters, so I use the "quadrigraph" @:>@
- # to stand for right-bracket. what a mess.
- perlver=`perl -e 'print($@:>@);'`
- if perl -e "exit( $perlver >= 5.006001 );"; then
- AC_MSG_ERROR([
- Found perl version $perlver, but at least 5.6.1 is required.
- You can get a newer perl at http://www.cpan.org/src/index.html .
- ])
- fi
-
- perlport=`perl -e "print $^O;"`
- case "$perlport" in
- cygwin)
- ;;
- MSWin32) # ActivePerl
- ;;
- linux)
- ;;
- freebsd)
- ;;
- openbsd)
- ;;
- darwin) # Mac OS X
- ;;
- solaris)
- ;;
- *)
- AC_MSG_ERROR([
- Unsupported Perl port $perlport -- sorry.
- cygwin, MSWin32 (ActivePerl), linux, freebsd, openbsd, darwin,
- and solaris are the supported ports.
- ])
- esac
-AC_MSG_RESULT([found version $perlver, port $perlport])
-
- # The cygwin port has some bugs in the File::Spec module
-if test "$perlport" = "cygwin" ;then
- AC_MSG_CHECKING([for known cygwin Perl bug in File::Spec])
- perlfixres=[`perl -e '
- use File::Spec;
- if(File::Spec->file_name_is_absolute("C:/test")) {
- print "no bug found"; exit 0;
- } else {
- print "bug";
- foreach $d (@INC) {
- if(-f "$d/File/Spec/Unix.pm") {
- open(IN, "<$d/File/Spec/Unix.pm");
- open(OUT, ">$d/File/Spec/Unix.pm.fixed")
- || die "Cannot open $d/File/Spec/Unix.pm.fixed";
- while(<IN>) {
- if($_ =~ m|sub file_name_is_absolute|) {
- print OUT $_;
- print OUT scalar(<IN>);
- print OUT <<EOF;
- if(\\$^O eq \"cygwin\") {
- return scalar(\\$file =~ m{^(\\[a-z\\]:)?\\[\\\\\\\\/\\]}is);
-};
-EOF
- next;
- }
- print OUT $_;
- }
- close(OUT);
- close(IN);
- system("mv -f $d/File/Spec/Unix.pm.fixed $d/File/Spec/Unix.pm");
- }
- }
- }
- '`]
- # See if it was indeed fixed
- if test "$perlfixres" = "bug" ;then
- perlfixres=`perl -e '
- use File::Spec;
- if(File::Spec->file_name_is_absolute("C:/test")) {
- print "bug fixed"; exit 0;
- } else {
- print "cannot fix bug"; exit 1;
- }'`
- fi
- if test "x$perlfixres" = "x" ;then
- AC_MSG_ERROR([
- Cannot run perl
- ])
- elif test "$perlfixres" = "cannot fix bug" ;then
- AC_MSG_ERROR([
- Found a bug but cannot fix it.
- ])
- else
- AC_MSG_RESULT([$perlfixres])
- fi
-fi
-
-#
-# Now setup the performance counters
-#
-AC_MSG_CHECKING(if performance counters are usable)
-# Create a C file from src/perfcount.c.in
-rm -f ./cycles.exe
-if gcc -DCONFIGURATION_ONLY \
- -x c ocamlutil/perfcount.c.in -lm -o ./cycles.exe >/dev/null 2>&1; then
-
- if CYCLES_PER_USEC=`./cycles.exe 2>&1` ;then
- AC_MSG_RESULT([ok ($CYCLES_PER_USEC cycles per us)])
- else
- # Print what we got
- AC_MSG_RESULT([no ($CYCLES_PER_USEC)])
- CYCLES_PER_USEC=0
- fi
-else
- CYCLES_PER_USEC=0
- AC_MSG_RESULT([no (cannot compile perfcount.c)])
-fi
-rm -f ./cycles.exe
-
-# If we are on Linux and we use performance counters try to get
-# the processor speed from /proc/cpuinfo
-if test "$CYCLES_PER_USEC" != "0" ;then
- case "$target" in
- # linux
- *86*linux*)
- AC_MSG_CHECKING(if /proc/cpuinfo has processor speed)
- cpuinfo=`cat /proc/cpuinfo 2>/dev/null | grep "cpu MHz"`
- [procspeed=`echo $cpuinfo | sed 's/^.*[^0-9]\([0-9]\+\.[0-9]\+\).*$/\1/g'`]
- if test "$procspeed"!="" ;then
- CYCLES_PER_USEC=$procspeed
- AC_MSG_RESULT([got $CYCLES_PER_USEC cycles per us])
- else
- AC_MSG_RESULT(no)
- fi
- ;;
- *)
- ;;
- esac
- # Now set HAS_PERFCOUNT
- HAS_PERFCOUNT=1
-else
- HAS_PERFCOUNT=0
-fi
-
-# additional tools we might check for:
-# - gnu make
-
-#
-# -------------------- GCC --------------
-#
-
-AC_MSG_CHECKING([for gcc version])
-AC_CHECK_TYPE(__builtin_va_list,
- HAVE_BUILTIN_VA_LIST=true,
- HAVE_BUILTIN_VA_LIST=false)
-AC_MSG_CHECKING([if __thread is a keyword])
-AC_COMPILE_IFELSE([int main(int __thread) { return 0; }],
- THREAD_IS_KEYWORD=false,
- THREAD_IS_KEYWORD=true)
-AC_MSG_RESULT($THREAD_IS_KEYWORD)
-
-# Does gcc add underscores to identifiers to make assembly labels?
-# (I think MSVC always does)
-AC_MSG_CHECKING([if gcc adds underscores to assembly labels.])
-AC_LINK_IFELSE([int main() { __asm__("jmp _main"); }],
- UNDERSCORE_NAME=true,
- UNDERSCORE_NAME=false)
-AC_MSG_RESULT($UNDERSCORE_NAME)
-
-
-# ----------- some stuff 'autoscan' put here --------------
-# (autoscan is part of the autoconf distribution)
-
-# checks for header files
-AC_HEADER_STDC
-AC_CHECK_HEADERS(stdlib.h strings.h sys/time.h unistd.h wchar.h)
-
-# checks for typedefs, structures, and compiler characteristics
-AC_C_CONST
-AC_C_INLINE
-AC_HEADER_TIME
-
-# checks for library functions; more autoscan stuff
-AC_FUNC_MEMCMP
-AC_CHECK_FUNCS(mkdir select socket __sysv_signal)
-
-
-
-# ----------- platform-specific code -------------
-# $target is typically processor-vendor-os
-case "$target" in
- # linux
- *86*linux*|*86*freebsd*|*86*openbsd*|*86*darwin*)
- AC_MSG_RESULT(configuring for linux/x86)
-
- ARCHOS=x86_LINUX
- ;;
-
- # Mac OS X
- *powerpc*darwin*)
- AC_MSG_RESULT(configuring for powerpc/darwin, which we treat like linux/x86)
-
- ARCHOS=ppc_DARWIN
- ;;
-
- # cygwin
- *86*cygwin*)
- AC_MSG_RESULT(configuring for Cygwin on win32/x86)
-
- ARCHOS=x86_WIN32
-
- # override CILHOME; even on cygwin we want forward slashes
- # sm: I folded this into what I hope will be the only
- # case-analysis of machine type
- CILHOME=`cygpath -wa "$CILHOME" | sed -e "s/\\\\\/\\//g"`
- CC=`which $CC`
- CC=`cygpath -wa "$CC" | sed -e "s/\\\\\/\\//g"`
- ;;
-
- # Solaris
- *sparc*solaris*)
- AC_MSG_RESULT(configuring for SPARC/Solaris)
-
- ARCHOS=sparc_SOLARIS
- ;;
-
- *)
- AC_MSG_ERROR([
- Unsupported platform $target -- sorry.
- ./configure supports these platforms:
- on x86: Linux, Win32(with Cygwin), freeBSD, openBSD, and Mac OS X
- on PowerPC: Mac OS X
- on SPARC: Solaris
- ])
- ;;
-esac
-
-# Make the object directory if not already present
-AC_CHECK_FILE(obj/$ARCHOS,, AC_MSG_RESULT(creating obj/$ARCHOS);
- mkdir -p obj/$ARCHOS)
-
-AC_MSG_CHECKING([delete the obj/$ARCHOS/feature_config.ml and obj/$ARCHOS/machdep.ml file])
-rm -f obj/$ARCHOS/machdep.ml
-rm -f obj/.depend/machdep.d
-rm -f obj/$ARCHOS/feature_config.ml
-rm -f obj/.depend/feature_config.d
-AC_MSG_RESULT([done])
-
-# We will use substitution variables whose definition contains newlines. The
-# problem is that when config.status runs, it wants to break the series of
-# substitution commands for sed into fragments based on line count. We could
-# be unlucky and have config.status break the series of substitution in the
-# middle of a variable that contains newlines. So, we first create a single
-# variable called NEWLINE whose definition is a carriage return. This means
-# that there will be exactly one opportunity for this error to happen (in the
-# definition of NEWLINE). The occurrence of AC_SUBST for NEWLINE must occur
-# after those of the variables that use it! And we want to put all of these
-# very early on, to make sure that they are not around the place when the file
-# bets broken.
-
-NEWLINE="\\
-"
-
-
-#
-# CIL/CCured features
-#
-#
-
-# Set the defaults
-
-
-# Give a space-separated list of features with the defaults
-features="blockinggraph=no rand=no arithabs=no zrapp=no"
-
-AC_ARG_WITH(blockinggraph,
- AC_HELP_STRING([--with-blockinggraph],
- [enable the blocking graph feature]))
-AC_ARG_WITH(rand,
- AC_HELP_STRING([--with-rand],
- [enable the randomized value numbering]))
-AC_ARG_WITH(arithabs,
- AC_HELP_STRING([--with-arithabs],
- [enable the arithmetic abstraction]))
-AC_ARG_WITH(zrapp,
- AC_HELP_STRING([--with-zrapp],
- [enable the zrapp pretty-printer]))
-
-# Smalloc.ml is distributed by {matth,nks}@cs.berkeley.edu as part of Scrash.
-features="$features smalloc=no"
-
-# cqualann.ml is used by Matt Harren. Please ignore.
-features="$features cqualann=no"
-
-# Now add any features specified in the command-line
-
-features="$features $EXTRAFEATURES"
-
-for f_val in $features
-do
- # If there is no =, then we default to yes
- if ! (echo $f_val | grep "=" >/dev/null) ;then f_val="$f_val=yes"; fi
- # echo "Testing feature $f_val"
- f=`echo $f_val | sed -e s%=.*$%%`
- AC_MSG_CHECKING(whether to use CIL feature $f)
- # default value from "features"
- defval=`echo $f_val | sed -e s%^.*=%%`
- # current value
- getcurval="echo \${with_$f:=$defval}"
- curval=`eval $getcurval`
- AC_MSG_RESULT($curval)
- if test $curval = yes ;then
- CIL_FEATURES="$CIL_FEATURES $f"
- fi
-done
-
-## Now produce the CIL_FEATURES_DEFINES
-CIL_FEATURES_DEFINES=""
-# Convert to upper case
-for f in `echo $CIL_FEATURES | tr a-z A-Z`
-do
- CIL_FEATURES_DEFINES="${CIL_FEATURES_DEFINES}@NEWLINE@export USE_$f=yes"
-done
-
-
-# ----------------- finish up -------------------
-# names of the variables that get substituted in files; for example,
-# write @ARCHOS@ somewhere in a written file to get it substituted
-AC_SUBST(ARCHOS)
-AC_SUBST(CILHOME)
-AC_SUBST(HAS_MSVC)
-AC_SUBST(DEFAULT_COMPILER)
-AC_SUBST(DEFAULT_CIL_MODE)
-AC_SUBST(CIL_VERSION_MAJOR)
-AC_SUBST(CIL_VERSION_MINOR)
-AC_SUBST(CIL_VERSION_REV)
-AC_SUBST(CIL_VERSION)
-AC_SUBST(CYCLES_PER_USEC)
-AC_SUBST(HAS_PERFCOUNT)
-AC_SUBST(HAVE_BUILTIN_VA_LIST)
-AC_SUBST(THREAD_IS_KEYWORD)
-AC_SUBST(UNDERSCORE_NAME)
-AC_SUBST(EXTRAFEATURES)
-AC_SUBST(EXTRASRCDIRS)
-
-# finish the configure script and generate various files; ./configure
-# will apply variable substitutions to <filename>.in to generate <filename>;
-# I find it useful to mark generated files as read-only so I don't
-# accidentally edit them (and them lose my changes when ./configure
-# runs again); I had originally done the chmod after AC_OUTPUT, but
-# the problem is then the chmod doesn't run inside ./config.status
-
-# MY_AC_CONFIG_FILES(filename)
-# do AC_CONFIG_FILES(filename, chmod a-w filename)
-define([MY_AC_CONFIG_FILES],
-[{
- if test -f [$1].in; then
- AC_CONFIG_FILES([$1], chmod a-w [$1])
- else
- true
- #echo "skipping [$1] because it's not in this distribution"
- fi
-}])
-define([MY_AC_CONFIG_EXE_FILES],
-[{
- if test -f [$1].in; then
- AC_CONFIG_FILES([$1], [chmod a-w,a+x $1])
- else
- true
- #echo "skipping [$1] because it's not in this distribution"
- fi
-}])
-
-MY_AC_CONFIG_FILES(Makefile)
-MY_AC_CONFIG_FILES(cil.spec)
-MY_AC_CONFIG_FILES(config.mk)
-MY_AC_CONFIG_FILES(test/Makefile)
-MY_AC_CONFIG_EXE_FILES(bin/cilly.bat)
-MY_AC_CONFIG_EXE_FILES(bin/patcher.bat)
-MY_AC_CONFIG_FILES(bin/CilConfig.pm)
-MY_AC_CONFIG_FILES(doc/index.html)
-MY_AC_CONFIG_FILES(doc/header.html)
-MY_AC_CONFIG_FILES(ocamlutil/perfcount.c)
-
-AC_OUTPUT()
-
-# show the user what the variables have been set to
-cat <<EOF
-
-CIL configuration:
- architecture/OS: ARCHOS $ARCHOS
- source tree root: CILHOME $CILHOME
- (optional) cl.exe found: HAS_MSVC $HAS_MSVC
- gcc to use CC $CC
- default compiler DEFAULT_COMPILER $DEFAULT_COMPILER
- CIL version CIL_VERSION $CIL_VERSION
- CIL features CIL_FEATURES $CIL_FEATURES
- Extra source directories EXTRASRCDIRS $EXTRASRCDIRS
- Cycles per microsecond CYCLES_PER_USEC $CYCLES_PER_USEC
-EOF
-
diff --git a/cil/doc/CIL-API.pdf b/cil/doc/CIL-API.pdf
deleted file mode 100644
index 240ff49104c9dbad0bfe2c3753d29c2050316f9a..0000000000000000000000000000000000000000
Binary files a/cil/doc/CIL-API.pdf and /dev/null differ
diff --git a/cil/doc/CIL.pdf b/cil/doc/CIL.pdf
deleted file mode 100644
index 34554fa69bf4297900ba175c2464caa7af62179f..0000000000000000000000000000000000000000
Binary files a/cil/doc/CIL.pdf and /dev/null differ
diff --git a/cil/doc/api/Alpha.html b/cil/doc/api/Alpha.html
deleted file mode 100644
index 699fac0996ddd49519535683401b5889fc335bbc..0000000000000000000000000000000000000000
--- a/cil/doc/api/Alpha.html
+++ /dev/null
@@ -1,79 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="previous" href="Formatcil.html">
-<link rel="next" href="Cillower.html">
-<link rel="Up" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Alpha</title>
-</head>
-<body>
-<div class="navbar"><a href="Formatcil.html">Previous</a>
- <a href="index.html">Up</a>
- <a href="Cillower.html">Next</a>
-</div>
-<center><h1>Module <a href="type_Alpha.html">Alpha</a></h1></center>
-<br>
-<pre><span class="keyword">module</span> Alpha: <code class="code">sig</code> <a href="Alpha.html">..</a> <code class="code">end</code></pre><b>ALPHA conversion</b><br>
-<hr width="100%">
-<pre><span class="keyword">type</span> <a name="TYPEundoAlphaElement"></a><code class="type">'a</code> undoAlphaElement </pre>
-<div class="info">
-This is the type of the elements that are recorded by the alpha
- conversion functions in order to be able to undo changes to the tables
- they modify. Useful for implementing
- scoping<br>
-</div>
-
-<pre><span class="keyword">type</span> <a name="TYPEalphaTableData"></a><code class="type">'a</code> alphaTableData </pre>
-<div class="info">
-This is the type of the elements of the alpha renaming table. These
- elements can carry some data associated with each occurrence of the name.<br>
-</div>
-
-<pre><span class="keyword">val</span> <a name="VALnewAlphaName"></a>newAlphaName : <code class="type">alphaTable:(string, 'a <a href="Alpha.html#TYPEalphaTableData">alphaTableData</a> Pervasives.ref) Hashtbl.t -><br> undolist:'a <a href="Alpha.html#TYPEundoAlphaElement">undoAlphaElement</a> list Pervasives.ref option -><br> lookupname:string -> data:'a -> string * 'a</code></pre><div class="info">
-Create a new name based on a given name. The new name is formed from a
- prefix (obtained from the given name by stripping a suffix consisting of _
- followed by only digits), followed by a special separator and then by a
- positive integer suffix. The first argument is a table mapping name
- prefixes to some data that specifies what suffixes have been used and how
- to create the new one. This function updates the table with the new
- largest suffix generated. The "undolist" argument, when present, will be
- used by the function to record information that can be used by
- <a href="Alpha.html#VALundoAlphaChanges"><code class="code">Alpha.undoAlphaChanges</code></a> to undo those changes. Note that the undo
- information will be in reverse order in which the action occurred. Returns
- the new name and, if different from the lookupname, the location of the
- previous occurrence. This function knows about the location implicitly
- from the <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a>.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALregisterAlphaName"></a>registerAlphaName : <code class="type">alphaTable:(string, 'a <a href="Alpha.html#TYPEalphaTableData">alphaTableData</a> Pervasives.ref) Hashtbl.t -><br> undolist:'a <a href="Alpha.html#TYPEundoAlphaElement">undoAlphaElement</a> list Pervasives.ref option -><br> lookupname:string -> data:'a -> unit</code></pre><div class="info">
-Register a name with an alpha conversion table to ensure that when later
- we call newAlphaName we do not end up generating this one<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdocAlphaTable"></a>docAlphaTable : <code class="type">unit -><br> (string, 'a <a href="Alpha.html#TYPEalphaTableData">alphaTableData</a> Pervasives.ref) Hashtbl.t -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Split the name in preparation for newAlphaName. The prefix returned is
- used to index into the hashtable. The next result value is a separator
- (either empty or the separator chosen to separate the original name from
- the index)<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALgetAlphaPrefix"></a>getAlphaPrefix : <code class="type">lookupname:string -> string</code></pre><pre><span class="keyword">val</span> <a name="VALundoAlphaChanges"></a>undoAlphaChanges : <code class="type">alphaTable:(string, 'a <a href="Alpha.html#TYPEalphaTableData">alphaTableData</a> Pervasives.ref) Hashtbl.t -><br> undolist:'a <a href="Alpha.html#TYPEundoAlphaElement">undoAlphaElement</a> list -> unit</code></pre><div class="info">
-Undo the changes to a table<br>
-</div>
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Cfg.html b/cil/doc/api/Cfg.html
deleted file mode 100644
index 142de8ae7ad3850cdbbea04c0b61c72f183d633c..0000000000000000000000000000000000000000
--- a/cil/doc/api/Cfg.html
+++ /dev/null
@@ -1,69 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="previous" href="Cillower.html">
-<link rel="next" href="Dataflow.html">
-<link rel="Up" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cfg</title>
-</head>
-<body>
-<div class="navbar"><a href="Cillower.html">Previous</a>
- <a href="index.html">Up</a>
- <a href="Dataflow.html">Next</a>
-</div>
-<center><h1>Module <a href="type_Cfg.html">Cfg</a></h1></center>
-<br>
-<pre><span class="keyword">module</span> Cfg: <code class="code">sig</code> <a href="Cfg.html">..</a> <code class="code">end</code></pre>Code to compute the control-flow graph of a function or file.
- This will fill in the <code class="code">preds</code> and <code class="code">succs</code> fields of <a href="Cil.html#TYPEstmt"><code class="code">Cil.stmt</code></a>
-<p>
-
- This is required for several other extensions, such as <a href="Dataflow.html"><code class="code">Dataflow</code></a>.<br>
-<hr width="100%">
-<pre><span class="keyword">val</span> <a name="VALcomputeFileCFG"></a>computeFileCFG : <code class="type"><a href="Cil.html#TYPEfile">Cil.file</a> -> unit</code></pre><div class="info">
-Compute the CFG for an entire file, by calling cfgFun on each function.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALclearFileCFG"></a>clearFileCFG : <code class="type"><a href="Cil.html#TYPEfile">Cil.file</a> -> unit</code></pre><div class="info">
-clear the sid, succs, and preds fields of each statement.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcfgFun"></a>cfgFun : <code class="type"><a href="Cil.html#TYPEfundec">Cil.fundec</a> -> int</code></pre><div class="info">
-Compute a control flow graph for fd. Stmts in fd have preds and succs
- filled in<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALclearCFGinfo"></a>clearCFGinfo : <code class="type"><a href="Cil.html#TYPEfundec">Cil.fundec</a> -> unit</code></pre><div class="info">
-clear the sid, succs, and preds fields of each statment in a function<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALprintCfgChannel"></a>printCfgChannel : <code class="type">Pervasives.out_channel -> <a href="Cil.html#TYPEfundec">Cil.fundec</a> -> unit</code></pre><div class="info">
-print control flow graph (in dot form) for fundec to channel<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALprintCfgFilename"></a>printCfgFilename : <code class="type">string -> <a href="Cil.html#TYPEfundec">Cil.fundec</a> -> unit</code></pre><div class="info">
-Print control flow graph (in dot form) for fundec to file<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALstart_id"></a>start_id : <code class="type">int Pervasives.ref</code></pre><div class="info">
-Next statement id that will be assigned.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALnodeList"></a>nodeList : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> list Pervasives.ref</code></pre><div class="info">
-All of the nodes in a file.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALnumNodes"></a>numNodes : <code class="type">int Pervasives.ref</code></pre><div class="info">
-number of nodes in the CFG<br>
-</div>
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Cil.cilPrinter.html b/cil/doc/api/Cil.cilPrinter.html
deleted file mode 100644
index 1b9511f6d50ab3b5e8ec4082002d6e66f5dfe758..0000000000000000000000000000000000000000
--- a/cil/doc/api/Cil.cilPrinter.html
+++ /dev/null
@@ -1,118 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="previous" href="Cil.cilVisitor.html">
-<link rel="Up" href="Cil.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.cilPrinter</title>
-</head>
-<body>
-<div class="navbar"><a href="Cil.cilVisitor.html">Previous</a>
- <a href="Cil.html">Up</a>
- </div>
-<center><h1>Class type <a href="type_Cil.cilPrinter.html">Cil.cilPrinter</a></h1></center>
-<br>
-<pre><span class="keyword">class type</span> <a name="TYPEcilPrinter"></a>cilPrinter = <code class="code">object</code> <a href="Cil.cilPrinter.html">..</a> <code class="code">end</code></pre>A printer interface for CIL trees. Create instantiations of
- this type by specializing the class <a href="Cil.defaultCilPrinterClass.html"><code class="code">Cil.defaultCilPrinterClass</code></a>.<br>
-<hr width="100%">
-<pre><span class="keyword">method</span> <a name="METHODpVDecl"></a>pVDecl : <code class="type">unit -> <a href="Cil.html#TYPEvarinfo">varinfo</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Invoked for each variable declaration. Note that variable
- declarations are all the <code class="code">GVar</code>, <code class="code">GVarDecl</code>, <code class="code">GFun</code>, all the <code class="code">varinfo</code>
- in formals of function types, and the formals and locals for function
- definitions.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODpVar"></a>pVar : <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Invoked on each variable use.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODpLval"></a>pLval : <code class="type">unit -> <a href="Cil.html#TYPElval">lval</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Invoked on each lvalue occurrence<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODpOffset"></a>pOffset : <code class="type"><a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> <a href="Cil.html#TYPEoffset">offset</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Invoked on each offset occurrence. The second argument is the base.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODpInstr"></a>pInstr : <code class="type">unit -> <a href="Cil.html#TYPEinstr">instr</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Invoked on each instruction occurrence.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODpLabel"></a>pLabel : <code class="type">unit -> <a href="Cil.html#TYPElabel">label</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Print a label.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODpStmt"></a>pStmt : <code class="type">unit -> <a href="Cil.html#TYPEstmt">stmt</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Control-flow statement. This is used by
- <a href="Cil.html#VALprintGlobal"><code class="code">Cil.printGlobal</code></a> and by <a href="Cil.html#VALdumpGlobal"><code class="code">Cil.dumpGlobal</code></a>.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODdStmt"></a>dStmt : <code class="type">Pervasives.out_channel -> int -> <a href="Cil.html#TYPEstmt">stmt</a> -> unit</code></pre><div class="info">
-Dump a control-flow statement to a file with a given indentation.
- This is used by <a href="Cil.html#VALdumpGlobal"><code class="code">Cil.dumpGlobal</code></a>.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODdBlock"></a>dBlock : <code class="type">Pervasives.out_channel -> int -> <a href="Cil.html#TYPEblock">block</a> -> unit</code></pre><div class="info">
-Dump a control-flow block to a file with a given indentation.
- This is used by <a href="Cil.html#VALdumpGlobal"><code class="code">Cil.dumpGlobal</code></a>.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODpBlock"></a>pBlock : <code class="type">unit -> <a href="Cil.html#TYPEblock">block</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">method</span> <a name="METHODpBlock"></a>pBlock : <code class="type">unit -> <a href="Cil.html#TYPEblock">block</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Print a block.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODpGlobal"></a>pGlobal : <code class="type">unit -> <a href="Cil.html#TYPEglobal">global</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Global (vars, types, etc.). This can be slow and is used only by
- <a href="Cil.html#VALprintGlobal"><code class="code">Cil.printGlobal</code></a> but not by <a href="Cil.html#VALdumpGlobal"><code class="code">Cil.dumpGlobal</code></a>.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODdGlobal"></a>dGlobal : <code class="type">Pervasives.out_channel -> <a href="Cil.html#TYPEglobal">global</a> -> unit</code></pre><div class="info">
-Dump a global to a file with a given indentation. This is used by
- <a href="Cil.html#VALdumpGlobal"><code class="code">Cil.dumpGlobal</code></a><br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODpFieldDecl"></a>pFieldDecl : <code class="type">unit -> <a href="Cil.html#TYPEfieldinfo">fieldinfo</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-A field declaration<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODpType"></a>pType : <code class="type"><a href="Pretty.html#TYPEdoc">Pretty.doc</a> option -> unit -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">method</span> <a name="METHODpAttr"></a>pAttr : <code class="type"><a href="Cil.html#TYPEattribute">attribute</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a> * bool</code></pre><div class="info">
-Attribute. Also return an indication whether this attribute must be
- printed inside the __attribute__ list or not.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODpAttrParam"></a>pAttrParam : <code class="type">unit -> <a href="Cil.html#TYPEattrparam">attrparam</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Attribute parameter<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODpAttrs"></a>pAttrs : <code class="type">unit -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Attribute lists<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODpLineDirective"></a>pLineDirective : <code class="type">?forcefile:bool -> <a href="Cil.html#TYPElocation">location</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Print a line-number. This is assumed to come always on an empty line.
- If the forcefile argument is present and is true then the file name
- will be printed always. Otherwise the file name is printed only if it
- is different from the last time time this function is called. The last
- file name is stored in a private field inside the cilPrinter object.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODpStmtKind"></a>pStmtKind : <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> -> unit -> <a href="Cil.html#TYPEstmtkind">stmtkind</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Print a statement kind. The code to be printed is given in the
- <a href="Cil.html#TYPEstmtkind"><code class="code">Cil.stmtkind</code></a> argument. The initial <a href="Cil.html#TYPEstmt"><code class="code">Cil.stmt</code></a> argument
- records the statement which follows the one being printed;
- <a href="Cil.defaultCilPrinterClass.html"><code class="code">Cil.defaultCilPrinterClass</code></a> uses this information to prettify
- statement printing in certain special cases.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODpExp"></a>pExp : <code class="type">unit -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Print expressions<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODpInit"></a>pInit : <code class="type">unit -> <a href="Cil.html#TYPEinit">init</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Print initializers. This can be slow and is used by
- <a href="Cil.html#VALprintGlobal"><code class="code">Cil.printGlobal</code></a> but not by <a href="Cil.html#VALdumpGlobal"><code class="code">Cil.dumpGlobal</code></a>.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODdInit"></a>dInit : <code class="type">Pervasives.out_channel -> int -> <a href="Cil.html#TYPEinit">init</a> -> unit</code></pre><div class="info">
-Dump a global to a file with a given indentation. This is used by
- <a href="Cil.html#VALdumpGlobal"><code class="code">Cil.dumpGlobal</code></a><br>
-</div>
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Cil.cilVisitor.html b/cil/doc/api/Cil.cilVisitor.html
deleted file mode 100644
index f8c6496371c9125ffbe8b555535ecc241b6af39d..0000000000000000000000000000000000000000
--- a/cil/doc/api/Cil.cilVisitor.html
+++ /dev/null
@@ -1,125 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="next" href="Cil.cilPrinter.html">
-<link rel="Up" href="Cil.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.cilVisitor</title>
-</head>
-<body>
-<div class="navbar"> <a href="Cil.html">Up</a>
- <a href="Cil.cilPrinter.html">Next</a>
-</div>
-<center><h1>Class type <a href="type_Cil.cilVisitor.html">Cil.cilVisitor</a></h1></center>
-<br>
-<pre><span class="keyword">class type</span> <a name="TYPEcilVisitor"></a>cilVisitor = <code class="code">object</code> <a href="Cil.cilVisitor.html">..</a> <code class="code">end</code></pre>A visitor interface for traversing CIL trees. Create instantiations of
- this type by specializing the class <a href="Cil.nopCilVisitor.html"><code class="code">Cil.nopCilVisitor</code></a>. Each of the
- specialized visiting functions can also call the <code class="code">queueInstr</code> to specify
- that some instructions should be inserted before the current instruction
- or statement. Use syntax like <code class="code">self#queueInstr</code> to call a method
- associated with the current object.<br>
-<hr width="100%">
-<pre><span class="keyword">method</span> <a name="METHODvvdec"></a>vvdec : <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
-Invoked for each variable declaration. The subtrees to be traversed
- are those corresponding to the type and attributes of the variable.
- Note that variable declarations are all the <code class="code">GVar</code>, <code class="code">GVarDecl</code>, <code class="code">GFun</code>,
- all the <code class="code">varinfo</code> in formals of function types, and the formals and
- locals for function definitions. This means that the list of formals
- in a function definition will be traversed twice, once as part of the
- function type and second as part of the formals in a function
- definition.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODvvrbl"></a>vvrbl : <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
-Invoked on each variable use. Here only the <code class="code">SkipChildren</code> and
- <code class="code">ChangeTo</code> actions make sense since there are no subtrees. Note that
- the type and attributes of the variable are not traversed for a
- variable use<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODvexpr"></a>vexpr : <code class="type"><a href="Cil.html#TYPEexp">exp</a> -> <a href="Cil.html#TYPEexp">exp</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
-Invoked on each expression occurrence. The subtrees are the
- subexpressions, the types (for a <code class="code">Cast</code> or <code class="code">SizeOf</code> expression) or the
- variable use.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODvlval"></a>vlval : <code class="type"><a href="Cil.html#TYPElval">lval</a> -> <a href="Cil.html#TYPElval">lval</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
-Invoked on each lvalue occurrence<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODvoffs"></a>voffs : <code class="type"><a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEoffset">offset</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
-Invoked on each offset occurrence that is *not* as part
- of an initializer list specification, i.e. in an lval or
- recursively inside an offset.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODvinitoffs"></a>vinitoffs : <code class="type"><a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEoffset">offset</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
-Invoked on each offset appearing in the list of a
- CompoundInit initializer.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODvinst"></a>vinst : <code class="type"><a href="Cil.html#TYPEinstr">instr</a> -> <a href="Cil.html#TYPEinstr">instr</a> list <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
-Invoked on each instruction occurrence. The <code class="code">ChangeTo</code> action can
- replace this instruction with a list of instructions<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODvstmt"></a>vstmt : <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> -> <a href="Cil.html#TYPEstmt">stmt</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
-Control-flow statement. The default <code class="code">DoChildren</code> action does not
- create a new statement when the components change. Instead it updates
- the contents of the original statement. This is done to preserve the
- sharing with <code class="code">Goto</code> and <code class="code">Case</code> statements that point to the original
- statement. If you use the <code class="code">ChangeTo</code> action then you should take care
- of preserving that sharing yourself.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODvblock"></a>vblock : <code class="type"><a href="Cil.html#TYPEblock">block</a> -> <a href="Cil.html#TYPEblock">block</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
-Block.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODvfunc"></a>vfunc : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> <a href="Cil.html#TYPEfundec">fundec</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
-Function definition.
- Replaced in place.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODvglob"></a>vglob : <code class="type"><a href="Cil.html#TYPEglobal">global</a> -> <a href="Cil.html#TYPEglobal">global</a> list <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
-Global (vars, types,
- etc.)<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODvinit"></a>vinit : <code class="type"><a href="Cil.html#TYPEinit">init</a> -> <a href="Cil.html#TYPEinit">init</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
-Initializers for globals<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODvtype"></a>vtype : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEtyp">typ</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
-Use of some type. Note
- that for structure/union
- and enumeration types the
- definition of the
- composite type is not
- visited. Use <code class="code">vglob</code> to
- visit it.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODvattr"></a>vattr : <code class="type"><a href="Cil.html#TYPEattribute">attribute</a> -> <a href="Cil.html#TYPEattribute">attribute</a> list <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
-Attribute. Each attribute can be replaced by a list<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODvattrparam"></a>vattrparam : <code class="type"><a href="Cil.html#TYPEattrparam">attrparam</a> -> <a href="Cil.html#TYPEattrparam">attrparam</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
-Attribute parameters.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODqueueInstr"></a>queueInstr : <code class="type"><a href="Cil.html#TYPEinstr">instr</a> list -> unit</code></pre><div class="info">
-Add here instructions while visiting to queue them to preceede the
- current statement or instruction being processed. Use this method only
- when you are visiting an expression that is inside a function body, or
- a statement, because otherwise there will no place for the visitor to
- place your instructions.<br>
-</div>
-<pre><span class="keyword">method</span> <a name="METHODunqueueInstr"></a>unqueueInstr : <code class="type">unit -> <a href="Cil.html#TYPEinstr">instr</a> list</code></pre><div class="info">
-Gets the queue of instructions and resets the queue. This is done
- automatically for you when you visit statments.<br>
-</div>
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Cil.defaultCilPrinterClass.html b/cil/doc/api/Cil.defaultCilPrinterClass.html
deleted file mode 100644
index d85955953b8f8baedb05a54b985a070f356747de..0000000000000000000000000000000000000000
--- a/cil/doc/api/Cil.defaultCilPrinterClass.html
+++ /dev/null
@@ -1,36 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="previous" href="Cil.nopCilVisitor.html">
-<link rel="next" href="Cil.plainCilPrinterClass.html">
-<link rel="Up" href="Cil.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.defaultCilPrinterClass</title>
-</head>
-<body>
-<div class="navbar"><a href="Cil.nopCilVisitor.html">Previous</a>
- <a href="Cil.html">Up</a>
- <a href="Cil.plainCilPrinterClass.html">Next</a>
-</div>
-<center><h1>Class <a href="type_Cil.defaultCilPrinterClass.html">Cil.defaultCilPrinterClass</a></h1></center>
-<br>
-<pre><span class="keyword">class</span> <a name="TYPEdefaultCilPrinterClass"></a>defaultCilPrinterClass : <code class="type"></code><code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a></code></pre><hr width="100%">
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Cil.html b/cil/doc/api/Cil.html
deleted file mode 100644
index f2e09c270e4f668f6471a086b02f2f01e6cfe2fe..0000000000000000000000000000000000000000
--- a/cil/doc/api/Cil.html
+++ /dev/null
@@ -1,3337 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="previous" href="Stats.html">
-<link rel="next" href="Formatcil.html">
-<link rel="Up" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil</title>
-</head>
-<body>
-<div class="navbar"><a href="Stats.html">Previous</a>
- <a href="index.html">Up</a>
- <a href="Formatcil.html">Next</a>
-</div>
-<center><h1>Module <a href="type_Cil.html">Cil</a></h1></center>
-<br>
-<pre><span class="keyword">module</span> Cil: <code class="code">sig</code> <a href="Cil.html">..</a> <code class="code">end</code></pre>CIL API Documentation. An html version of this document can be found at
- http://manju.cs.berkeley.edu/cil.<br>
-<hr width="100%">
-<pre><span class="keyword">val</span> <a name="VALinitCIL"></a>initCIL : <code class="type">unit -> unit</code></pre><div class="info">
-Call this function to perform some initialization. Call if after you have
- set <a href="Cil.html#VALmsvcMode"><code class="code">Cil.msvcMode</code></a>.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcilVersion"></a>cilVersion : <code class="type">string</code></pre><div class="info">
-This are the CIL version numbers. A CIL version is a number of the form
- M.m.r (major, minor and release)<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcilVersionMajor"></a>cilVersionMajor : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALcilVersionMinor"></a>cilVersionMinor : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALcilVersionRevision"></a>cilVersionRevision : <code class="type">int</code></pre><br>
-This module defines the abstract syntax of CIL. It also provides utility
- functions for traversing the CIL data structures, and pretty-printing
- them. The parser for both the GCC and MSVC front-ends can be invoked as
- <code class="code">Frontc.parse: string -> unit -></code> <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a>. This function must be given
- the name of a preprocessed C file and will return the top-level data
- structure that describes a whole source file. By default the parsing and
- elaboration into CIL is done as for GCC source. If you want to use MSVC
- source you must set the <a href="Cil.html#VALmsvcMode"><code class="code">Cil.msvcMode</code></a> to <code class="code">true</code> and must also invoke the
- function <code class="code">Frontc.setMSVCMode: unit -> unit</code>.<br>
-<br>
-<b>The Abstract Syntax of CIL</b><br>
-<br>
-The top-level representation of a CIL source file (and the result of the
- parsing and elaboration). Its main contents is the list of global
- declarations and definitions. You can iterate over the globals in a
- <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a> using the following iterators: <a href="Cil.html#VALmapGlobals"><code class="code">Cil.mapGlobals</code></a>,
- <a href="Cil.html#VALiterGlobals"><code class="code">Cil.iterGlobals</code></a> and <a href="Cil.html#VALfoldGlobals"><code class="code">Cil.foldGlobals</code></a>. You can also use the
- <a href="Cil.html#VALdummyFile"><code class="code">Cil.dummyFile</code></a> when you need a <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a> as a placeholder. For each
- global item CIL stores the source location where it appears (using the
- type <a href="Cil.html#TYPElocation"><code class="code">Cil.location</code></a>)<br>
-<br><code><span class="keyword">type</span> <a name="TYPEfile"></a><code class="type"></code>file = {</code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>fileName : <code class="type">string</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The complete file name</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>globals : <code class="type"><a href="Cil.html#TYPEglobal">global</a> list</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>List of globals as they will appear
- in the printed file</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>globinit : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> option</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>An optional global initializer function. This is a function where
- you can put stuff that must be executed before the program is
- started. This function, is conceptually at the end of the file,
- although it is not part of the globals list. Use <a href="Cil.html#VALgetGlobInit"><code class="code">Cil.getGlobInit</code></a>
- to create/get one.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>globinitcalled : <code class="type">bool</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Whether the global initialization function is called in main. This
- should always be false if there is no global initializer. When you
- create a global initialization CIL will try to insert code in main
- to call it. This will not happen if your file does not contain a
- function called "main"</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-}
-
-<div class="info">
-Top-level representation of a C source file<br>
-</div>
-
-<pre><span class="keyword">type</span> <a name="TYPEcomment"></a><code class="type"></code>comment = <code class="type"><a href="Cil.html#TYPElocation">location</a> * string</code> </pre>
-
-<br>
-<b>Globals</b>. The main type for representing global declarations and
- definitions. A list of these form a CIL file. The order of globals in the
- file is generally important.<br>
-<br><code><span class="keyword">type</span> <a name="TYPEglobal"></a><code class="type"></code>global = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">GType</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtypeinfo">typeinfo</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A typedef. All uses of type names (through the <code class="code">TNamed</code> constructor)
- must be preceded in the file by a definition of the name. The string
- is the defined name and always not-empty.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">GCompTag</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEcompinfo">compinfo</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Defines a struct/union tag with some fields. There must be one of
- these for each struct/union tag that you use (through the <code class="code">TComp</code>
- constructor) since this is the only context in which the fields are
- printed. Consequently nested structure tag definitions must be
- broken into individual definitions with the innermost structure
- defined first.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">GCompTagDecl</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEcompinfo">compinfo</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Declares a struct/union tag. Use as a forward declaration. This is
- printed without the fields.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">GEnumTag</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEenuminfo">enuminfo</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Declares an enumeration tag with some fields. There must be one of
- these for each enumeration tag that you use (through the <code class="code">TEnum</code>
- constructor) since this is the only context in which the items are
- printed.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">GEnumTagDecl</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEenuminfo">enuminfo</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Declares an enumeration tag. Use as a forward declaration. This is
- printed without the items.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">GVarDecl</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A variable declaration (not a definition). If the variable has a
- function type then this is a prototype. There can be several
- declarations and at most one definition for a given variable. If both
- forms appear then they must share the same varinfo structure. A
- prototype shares the varinfo with the fundec of the definition. Either
- has storage Extern or there must be a definition in this file</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">GVar</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> * <a href="Cil.html#TYPEinitinfo">initinfo</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A variable definition. Can have an initializer. The initializer is
- updateable so that you can change it without requiring to recreate
- the list of globals. There can be at most one definition for a
- variable in an entire program. Cannot have storage Extern or function
- type.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">GFun</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A function definition.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">GAsm</span> <span class="keyword">of</span> <code class="type">string * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Global asm statement. These ones
- can contain only a template</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">GPragma</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattribute">attribute</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Pragmas at top level. Use the same
- syntax as attributes</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">GText</span> <span class="keyword">of</span> <code class="type">string</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Some text (printed verbatim) at
- top level. E.g., this way you can
- put comments in the output.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-<div class="info">
-A global declaration or definition<br>
-</div>
-
-<br>
-<b>Types</b>. A C type is represented in CIL using the type <a href="Cil.html#TYPEtyp"><code class="code">Cil.typ</code></a>.
- Among types we differentiate the integral types (with different kinds
- denoting the sign and precision), floating point types, enumeration types,
- array and pointer types, and function types. Every type is associated with
- a list of attributes, which are always kept in sorted order. Use
- <a href="Cil.html#VALaddAttribute"><code class="code">Cil.addAttribute</code></a> and <a href="Cil.html#VALaddAttributes"><code class="code">Cil.addAttributes</code></a> to construct list of
- attributes. If you want to inspect a type, you should use
- <a href="Cil.html#VALunrollType"><code class="code">Cil.unrollType</code></a> or <a href="Cil.html#VALunrollTypeDeep"><code class="code">Cil.unrollTypeDeep</code></a> to see through the uses of
- named types.<br>
-<br>
-CIL is configured at build-time with the sizes and alignments of the
- underlying compiler (GCC or MSVC). CIL contains functions that can compute
- the size of a type (in bits) <a href="Cil.html#VALbitsSizeOf"><code class="code">Cil.bitsSizeOf</code></a>, the alignment of a type
- (in bytes) <a href="Cil.html#VALalignOf_int"><code class="code">Cil.alignOf_int</code></a>, and can convert an offset into a start and
- width (both in bits) using the function <a href="Cil.html#VALbitsOffset"><code class="code">Cil.bitsOffset</code></a>. At the moment
- these functions do not take into account the <code class="code">packed</code> attributes and
- pragmas.<br>
-<br><code><span class="keyword">type</span> <a name="TYPEtyp"></a><code class="type"></code>typ = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TVoid</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Void type. Also predefined as <a href="Cil.html#VALvoidType"><code class="code">Cil.voidType</code></a></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TInt</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEikind">ikind</a> * <a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>An integer type. The kind specifies the sign and width. Several
- useful variants are predefined as <a href="Cil.html#VALintType"><code class="code">Cil.intType</code></a>, <a href="Cil.html#VALuintType"><code class="code">Cil.uintType</code></a>,
- <a href="Cil.html#VALlongType"><code class="code">Cil.longType</code></a>, <a href="Cil.html#VALcharType"><code class="code">Cil.charType</code></a>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TFloat</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEfkind">fkind</a> * <a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A floating-point type. The kind specifies the precision. You can
- also use the predefined constant <a href="Cil.html#VALdoubleType"><code class="code">Cil.doubleType</code></a>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TPtr</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Pointer type. Several useful variants are predefined as
- <a href="Cil.html#VALcharPtrType"><code class="code">Cil.charPtrType</code></a>, <a href="Cil.html#VALcharConstPtrType"><code class="code">Cil.charConstPtrType</code></a> (pointer to a
- constant character), <a href="Cil.html#VALvoidPtrType"><code class="code">Cil.voidPtrType</code></a>,
- <a href="Cil.html#VALintPtrType"><code class="code">Cil.intPtrType</code></a></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TArray</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEexp">exp</a> option * <a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Array type. It indicates the base type and the array length.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TFun</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a> * (string * <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEattributes">attributes</a>) list option * bool<br> * <a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Function type. Indicates the type of the result, the name, type
- and name attributes of the formal arguments (<code class="code">None</code> if no
- arguments were specified, as in a function whose definition or
- prototype we have not seen; <code class="code">Some []</code> means void). Use
- <a href="Cil.html#VALargsToList"><code class="code">Cil.argsToList</code></a> to obtain a list of arguments. The boolean
- indicates if it is a variable-argument function. If this is the
- type of a varinfo for which we have a function declaration then
- the information for the formals must match that in the
- function's sformals. Use <a href="Cil.html#VALsetFormals"><code class="code">Cil.setFormals</code></a>, or
- <a href="Cil.html#VALsetFunctionType"><code class="code">Cil.setFunctionType</code></a>, or <a href="Cil.html#VALmakeFormalVar"><code class="code">Cil.makeFormalVar</code></a> for this
- purpose.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TNamed</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtypeinfo">typeinfo</a> * <a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TComp</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEcompinfo">compinfo</a> * <a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The most delicate issue for C types is that recursion that is possible by
- using structures and pointers. To address this issue we have a more
- complex representation for structured types (struct and union). Each such
- type is represented using the <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> type. For each composite
- type the <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> structure must be declared at top level using
- <code class="code">GCompTag</code> and all references to it must share the same copy of the
- structure. The attributes given are those pertaining to this use of the
- type and are in addition to the attributes that were given at the
- definition of the type and which are stored in the <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TEnum</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEenuminfo">enuminfo</a> * <a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A reference to an enumeration type. All such references must
- share the enuminfo among them and with a <code class="code">GEnumTag</code> global that
- precedes all uses. The attributes refer to this use of the
- enumeration and are in addition to the attributes of the
- enumeration itself, which are stored inside the enuminfo</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TBuiltin_va_list</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>This is the same as the gcc's type with the same name</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-
-<br>
-There are a number of functions for querying the kind of a type. These are
- <a href="Cil.html#VALisIntegralType"><code class="code">Cil.isIntegralType</code></a>,
- <a href="Cil.html#VALisArithmeticType"><code class="code">Cil.isArithmeticType</code></a>,
- <a href="Cil.html#VALisPointerType"><code class="code">Cil.isPointerType</code></a>,
- <a href="Cil.html#VALisFunctionType"><code class="code">Cil.isFunctionType</code></a>,
- <a href="Cil.html#VALisArrayType"><code class="code">Cil.isArrayType</code></a>.
-<p>
-
- There are two easy ways to scan a type. First, you can use the
-<a href="Cil.html#VALexistsType"><code class="code">Cil.existsType</code></a> to return a boolean answer about a type. This function
-is controlled by a user-provided function that is queried for each type that is
-used to construct the current type. The function can specify whether to
-terminate the scan with a boolean result or to continue the scan for the
-nested types.
-<p>
-
- The other method for scanning types is provided by the visitor interface (see
- <a href="Cil.cilVisitor.html"><code class="code">Cil.cilVisitor</code></a>).
-<p>
-
- If you want to compare types (or to use them as hash-values) then you should
-use instead type signatures (represented as <a href="Cil.html#TYPEtypsig"><code class="code">Cil.typsig</code></a>). These
-contain the same information as types but canonicalized such that simple Ocaml
-structural equality will tell whether two types are equal. Use
-<a href="Cil.html#VALtypeSig"><code class="code">Cil.typeSig</code></a> to compute the signature of a type. If you want to ignore
-certain type attributes then use <a href="Cil.html#VALtypeSigWithAttrs"><code class="code">Cil.typeSigWithAttrs</code></a>.<br>
-<br><code><span class="keyword">type</span> <a name="TYPEikind"></a><code class="type"></code>ikind = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">IChar</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">char</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">ISChar</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">signed char</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">IUChar</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">unsigned char</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">IInt</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">int</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">IUInt</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">unsigned int</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">IShort</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">short</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">IUShort</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">unsigned short</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">ILong</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">long</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">IULong</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">unsigned long</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">ILongLong</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">long long</code> (or <code class="code">_int64</code> on Microsoft Visual C)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">IULongLong</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">unsigned long long</code> (or <code class="code">unsigned _int64</code> on Microsoft
- Visual C)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-<div class="info">
-Various kinds of integers<br>
-</div>
-
-<br><code><span class="keyword">type</span> <a name="TYPEfkind"></a><code class="type"></code>fkind = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">FFloat</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">float</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">FDouble</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">double</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">FLongDouble</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">long double</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-<div class="info">
-Various kinds of floating-point numbers<br>
-</div>
-
-<br>
-<b>Attributes.</b><br>
-<br><code><span class="keyword">type</span> <a name="TYPEattribute"></a><code class="type"></code>attribute = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Attr</span> <span class="keyword">of</span> <code class="type">string * <a href="Cil.html#TYPEattrparam">attrparam</a> list</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>An attribute has a name and some optional parameters. The name should not
- start or end with underscore. When CIL parses attribute names it will
- strip leading and ending underscores (to ensure that the multitude of GCC
- attributes such as const, __const and __const__ all mean the same thing.)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-
-<pre><span class="keyword">type</span> <a name="TYPEattributes"></a><code class="type"></code>attributes = <code class="type"><a href="Cil.html#TYPEattribute">attribute</a> list</code> </pre>
-<div class="info">
-Attributes are lists sorted by the attribute name. Use the functions
- <a href="Cil.html#VALaddAttribute"><code class="code">Cil.addAttribute</code></a> and <a href="Cil.html#VALaddAttributes"><code class="code">Cil.addAttributes</code></a> to insert attributes in an
- attribute list and maintain the sortedness.<br>
-</div>
-
-<br><code><span class="keyword">type</span> <a name="TYPEattrparam"></a><code class="type"></code>attrparam = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">AInt</span> <span class="keyword">of</span> <code class="type">int</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>An integer constant</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">AStr</span> <span class="keyword">of</span> <code class="type">string</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A string constant</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">ACons</span> <span class="keyword">of</span> <code class="type">string * <a href="Cil.html#TYPEattrparam">attrparam</a> list</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Constructed attributes. These
- are printed <code class="code">foo(a1,a2,...,an)</code>.
- The list of parameters can be
- empty and in that case the
- parentheses are not printed.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">ASizeOf</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A way to talk about types</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">ASizeOfE</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattrparam">attrparam</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">ASizeOfS</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtypsig">typsig</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Replacement for ASizeOf in type
- signatures. Only used for
- attributes inside typsigs.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">AAlignOf</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">AAlignOfE</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattrparam">attrparam</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">AAlignOfS</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtypsig">typsig</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">AUnOp</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEunop">unop</a> * <a href="Cil.html#TYPEattrparam">attrparam</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">ABinOp</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEbinop">binop</a> * <a href="Cil.html#TYPEattrparam">attrparam</a> * <a href="Cil.html#TYPEattrparam">attrparam</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">ADot</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattrparam">attrparam</a> * string</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>a.foo *</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-<div class="info">
-The type of parameters of attributes<br>
-</div>
-
-<br>
-<b>Structures.</b> The <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> describes the definition of a
- structure or union type. Each such <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> must be defined at the
- top-level using the <code class="code">GCompTag</code> constructor and must be shared by all
- references to this type (using either the <code class="code">TComp</code> type constructor or from
- the definition of the fields.
-<p>
-
- If all you need is to scan the definition of each
- composite type once, you can do that by scanning all top-level <code class="code">GCompTag</code>.
-<p>
-
- Constructing a <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> can be tricky since it must contain fields
- that might refer to the host <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> and furthermore the type of
- the field might need to refer to the <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> for recursive types.
- Use the <a href="Cil.html#VALmkCompInfo"><code class="code">Cil.mkCompInfo</code></a> function to create a <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a>. You can
- easily fetch the <a href="Cil.html#TYPEfieldinfo"><code class="code">Cil.fieldinfo</code></a> for a given field in a structure with
- <a href="Cil.html#VALgetCompField"><code class="code">Cil.getCompField</code></a>.<br>
-<br><code><span class="keyword">type</span> <a name="TYPEcompinfo"></a><code class="type"></code>compinfo = {</code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>cstruct : <code class="type">bool</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>True if struct, False if union</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>cname : <code class="type">string</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The name. Always non-empty. Use <a href="Cil.html#VALcompFullName"><code class="code">Cil.compFullName</code></a> to get the full
- name of a comp (along with the struct or union)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>ckey : <code class="type">int</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A unique integer. This is assigned by <a href="Cil.html#VALmkCompInfo"><code class="code">Cil.mkCompInfo</code></a> using a
- global variable in the Cil module. Thus two identical structs in two
- different files might have different keys. Use <a href="Cil.html#VALcopyCompInfo"><code class="code">Cil.copyCompInfo</code></a> to
- copy structures so that a new key is assigned.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>cfields : <code class="type"><a href="Cil.html#TYPEfieldinfo">fieldinfo</a> list</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Information about the fields. Notice that each fieldinfo has a
- pointer back to the host compinfo. This means that you should not
- share fieldinfo's between two compinfo's</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>cattr : <code class="type"><a href="Cil.html#TYPEattributes">attributes</a></code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The attributes that are defined at the same time as the composite
- type. These attributes can be supplemented individually at each
- reference to this <code class="code">compinfo</code> using the <code class="code">TComp</code> type constructor.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>cdefined : <code class="type">bool</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>This boolean flag can be used to distinguish between structures
- that have not been defined and those that have been defined but have
- no fields (such things are allowed in gcc).</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>creferenced : <code class="type">bool</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>True if used. Initially set to false.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-}
-
-<div class="info">
-The definition of a structure or union type. Use <a href="Cil.html#VALmkCompInfo"><code class="code">Cil.mkCompInfo</code></a> to
- make one and use <a href="Cil.html#VALcopyCompInfo"><code class="code">Cil.copyCompInfo</code></a> to copy one (this ensures that a new
- key is assigned and that the fields have the right pointers to parents.).<br>
-</div>
-
-<br>
-<b>Structure fields.</b> The <a href="Cil.html#TYPEfieldinfo"><code class="code">Cil.fieldinfo</code></a> structure is used to describe
- a structure or union field. Fields, just like variables, can have
- attributes associated with the field itself or associated with the type of
- the field (stored along with the type of the field).<br>
-<br><code><span class="keyword">type</span> <a name="TYPEfieldinfo"></a><code class="type"></code>fieldinfo = {</code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>fcomp : <code class="type"><a href="Cil.html#TYPEcompinfo">compinfo</a></code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The host structure that contains this field. There can be only one
- <code class="code">compinfo</code> that contains the field.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>fname : <code class="type">string</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The name of the field. Might be the value of <a href="Cil.html#VALmissingFieldName"><code class="code">Cil.missingFieldName</code></a>
- in which case it must be a bitfield and is not printed and it does not
- participate in initialization</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>ftype : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The type</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>fbitfield : <code class="type">int option</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>If a bitfield then ftype should be an integer type and the width of
- the bitfield must be 0 or a positive integer smaller or equal to the
- width of the integer type. A field of width 0 is used in C to control
- the alignment of fields.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>fattr : <code class="type"><a href="Cil.html#TYPEattributes">attributes</a></code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The attributes for this field (not for its type)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>floc : <code class="type"><a href="Cil.html#TYPElocation">location</a></code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The location where this field is defined</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-}
-
-<div class="info">
-Information about a struct/union field<br>
-</div>
-
-<br>
-<b>Enumerations.</b> Information about an enumeration. This is shared by all
- references to an enumeration. Make sure you have a <code class="code">GEnumTag</code> for each of
- of these.<br>
-<br><code><span class="keyword">type</span> <a name="TYPEenuminfo"></a><code class="type"></code>enuminfo = {</code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>ename : <code class="type">string</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The name. Always non-empty.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>eitems : <code class="type">(string * <a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPElocation">location</a>) list</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Items with names and values. This list should be non-empty. The item
- values must be compile-time constants.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>eattr : <code class="type"><a href="Cil.html#TYPEattributes">attributes</a></code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The attributes that are defined at the same time as the enumeration
- type. These attributes can be supplemented individually at each
- reference to this <code class="code">enuminfo</code> using the <code class="code">TEnum</code> type constructor.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>ereferenced : <code class="type">bool</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>True if used. Initially set to false</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-}
-
-<div class="info">
-Information about an enumeration<br>
-</div>
-
-<br>
-<b>Enumerations.</b> Information about an enumeration. This is shared by all
- references to an enumeration. Make sure you have a <code class="code">GEnumTag</code> for each of
- of these.<br>
-<br><code><span class="keyword">type</span> <a name="TYPEtypeinfo"></a><code class="type"></code>typeinfo = {</code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>tname : <code class="type">string</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The name. Can be empty only in a <code class="code">GType</code> when introducing a composite
- or enumeration tag. If empty cannot be referred to from the file</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>ttype : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The actual type. This includes the attributes that were present in
- the typedef</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>treferenced : <code class="type">bool</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>True if used. Initially set to false</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-}
-
-<div class="info">
-Information about a defined type<br>
-</div>
-
-<br>
-<b>Variables.</b>
- Each local or global variable is represented by a unique <a href="Cil.html#TYPEvarinfo"><code class="code">Cil.varinfo</code></a>
-structure. A global <a href="Cil.html#TYPEvarinfo"><code class="code">Cil.varinfo</code></a> can be introduced with the <code class="code">GVarDecl</code> or
-<code class="code">GVar</code> or <code class="code">GFun</code> globals. A local varinfo can be introduced as part of a
-function definition <a href="Cil.html#TYPEfundec"><code class="code">Cil.fundec</code></a>.
-<p>
-
- All references to a given global or local variable must refer to the same
-copy of the <code class="code">varinfo</code>. Each <code class="code">varinfo</code> has a globally unique identifier that
-can be used to index maps and hashtables (the name can also be used for this
-purpose, except for locals from different functions). This identifier is
-constructor using a global counter.
-<p>
-
- It is very important that you construct <code class="code">varinfo</code> structures using only one
- of the following functions:<ul>
-<li><a href="Cil.html#VALmakeGlobalVar"><code class="code">Cil.makeGlobalVar</code></a> : to make a global variable</li>
-<li><a href="Cil.html#VALmakeTempVar"><code class="code">Cil.makeTempVar</code></a> : to make a temporary local variable whose name
-will be generated so that to avoid conflict with other locals. </li>
-<li><a href="Cil.html#VALmakeLocalVar"><code class="code">Cil.makeLocalVar</code></a> : like <a href="Cil.html#VALmakeTempVar"><code class="code">Cil.makeTempVar</code></a> but you can specify the
-exact name to be used. </li>
-<li><a href="Cil.html#VALcopyVarinfo"><code class="code">Cil.copyVarinfo</code></a>: make a shallow copy of a varinfo assigning a new name
-and a new unique identifier</li>
-</ul>
-
- A <code class="code">varinfo</code> is also used in a function type to denote the list of formals.<br>
-<br><code><span class="keyword">type</span> <a name="TYPEvarinfo"></a><code class="type"></code>varinfo = {</code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>vname : <code class="type">string</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The name of the variable. Cannot be empty. It is primarily your
- responsibility to ensure the uniqueness of a variable name. For local
- variables <a href="Cil.html#VALmakeTempVar"><code class="code">Cil.makeTempVar</code></a> helps you ensure that the name is unique.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>vtype : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The declared type of the variable.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>vattr : <code class="type"><a href="Cil.html#TYPEattributes">attributes</a></code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A list of attributes associated with the variable.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>vstorage : <code class="type"><a href="Cil.html#TYPEstorage">storage</a></code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The storage-class</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>vglob : <code class="type">bool</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>True if this is a global variable</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>vinline : <code class="type">bool</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Whether this varinfo is for an inline function.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>vdecl : <code class="type"><a href="Cil.html#TYPElocation">location</a></code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Location of variable declaration.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>vid : <code class="type">int</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A unique integer identifier. This field will be
- set for you if you use one of the <a href="Cil.html#VALmakeFormalVar"><code class="code">Cil.makeFormalVar</code></a>,
- <a href="Cil.html#VALmakeLocalVar"><code class="code">Cil.makeLocalVar</code></a>, <a href="Cil.html#VALmakeTempVar"><code class="code">Cil.makeTempVar</code></a>, <a href="Cil.html#VALmakeGlobalVar"><code class="code">Cil.makeGlobalVar</code></a>, or
- <a href="Cil.html#VALcopyVarinfo"><code class="code">Cil.copyVarinfo</code></a>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>vaddrof : <code class="type">bool</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>True if the address of this variable is taken. CIL will set these
- flags when it parses C, but you should make sure to set the flag
- whenever your transformation create <code class="code">AddrOf</code> expression.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>vreferenced : <code class="type">bool</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>True if this variable is ever referenced. This is computed by
- <code class="code">removeUnusedVars</code>. It is safe to just initialize this to False</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-}
-
-<div class="info">
-Information about a variable.<br>
-</div>
-
-<br><code><span class="keyword">type</span> <a name="TYPEstorage"></a><code class="type"></code>storage = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">NoStorage</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The default storage. Nothing is printed</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Static</span></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Register</span></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Extern</span></code></td>
-
-</tr></table>
-
-<div class="info">
-Storage-class information<br>
-</div>
-
-<br>
-<b>Expressions.</b> The CIL expression language contains only the side-effect free expressions of
-C. They are represented as the type <a href="Cil.html#TYPEexp"><code class="code">Cil.exp</code></a>. There are several
-interesting aspects of CIL expressions:
-<p>
-
- Integer and floating point constants can carry their textual representation.
-This way the integer 15 can be printed as 0xF if that is how it occurred in the
-source.
-<p>
-
- CIL uses 64 bits to represent the integer constants and also stores the width
-of the integer type. Care must be taken to ensure that the constant is
-representable with the given width. Use the functions <a href="Cil.html#VALkinteger"><code class="code">Cil.kinteger</code></a>,
-<a href="Cil.html#VALkinteger64"><code class="code">Cil.kinteger64</code></a> and <a href="Cil.html#VALinteger"><code class="code">Cil.integer</code></a> to construct constant
-expressions. CIL predefines the constants <a href="Cil.html#VALzero"><code class="code">Cil.zero</code></a>,
-<a href="Cil.html#VALone"><code class="code">Cil.one</code></a> and <a href="Cil.html#VALmone"><code class="code">Cil.mone</code></a> (for -1).
-<p>
-
- Use the functions <a href="Cil.html#VALisConstant"><code class="code">Cil.isConstant</code></a> and <a href="Cil.html#VALisInteger"><code class="code">Cil.isInteger</code></a> to test if
-an expression is a constant and a constant integer respectively.
-<p>
-
- CIL keeps the type of all unary and binary expressions. You can think of that
-type qualifying the operator. Furthermore there are different operators for
-arithmetic and comparisons on arithmetic types and on pointers.
-<p>
-
- Another unusual aspect of CIL is that the implicit conversion between an
-expression of array type and one of pointer type is made explicit, using the
-<code class="code">StartOf</code> expression constructor (which is not printed). If you apply the
-<code class="code">AddrOf}</code>constructor to an lvalue of type <code class="code">T</code> then you will be getting an
-expression of type <code class="code">TPtr(T)</code>.
-<p>
-
- You can find the type of an expression with <a href="Cil.html#VALtypeOf"><code class="code">Cil.typeOf</code></a>.
-<p>
-
- You can perform constant folding on expressions using the function
-<a href="Cil.html#VALconstFold"><code class="code">Cil.constFold</code></a>.<br>
-<br><code><span class="keyword">type</span> <a name="TYPEexp"></a><code class="type"></code>exp = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Const</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEconstant">constant</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Constant</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Lval</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElval">lval</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Lvalue</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">SizeOf</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>sizeof(<type>). Has <code class="code">unsigned int</code> type (ISO 6.5.3.4). This is not
- turned into a constant because some transformations might want to
- change types</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">SizeOfE</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>sizeof(<expression>)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">SizeOfStr</span> <span class="keyword">of</span> <code class="type">string</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>sizeof(string_literal). We separate this case out because this is the
- only instance in which a string literal should not be treated as
- having type pointer to character.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">AlignOf</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>This corresponds to the GCC __alignof_. Has <code class="code">unsigned int</code> type</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">AlignOfE</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">UnOp</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEunop">unop</a> * <a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPEtyp">typ</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Unary operation. Includes the type of the result.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">BinOp</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEbinop">binop</a> * <a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPEtyp">typ</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Binary operation. Includes the type of the result. The arithmetic
- conversions are made explicit for the arguments.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">CastE</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEexp">exp</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Use <a href="Cil.html#VALmkCast"><code class="code">Cil.mkCast</code></a> to make casts.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">AddrOf</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElval">lval</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Always use <a href="Cil.html#VALmkAddrOf"><code class="code">Cil.mkAddrOf</code></a> to construct one of these. Apply to an
- lvalue of type <code class="code">T</code> yields an expression of type <code class="code">TPtr(T)</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">StartOf</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElval">lval</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Conversion from an array to a pointer to the beginning of the array.
- Given an lval of type <code class="code">TArray(T)</code> produces an expression of type
- <code class="code">TPtr(T)</code>. In C this operation is implicit, the <code class="code">StartOf</code> operator is
- not printed. We have it in CIL because it makes the typing rules
- simpler.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-<div class="info">
-Expressions (Side-effect free)<br>
-</div>
-
-<br>
-<b>Constants.</b><br>
-<br><code><span class="keyword">type</span> <a name="TYPEconstant"></a><code class="type"></code>constant = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">CInt64</span> <span class="keyword">of</span> <code class="type">int64 * <a href="Cil.html#TYPEikind">ikind</a> * string option</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Integer constant. Give the ikind (see ISO9899 6.1.3.2) and the
- textual representation, if available. (This allows us to print a
- constant as, for example, 0xF instead of 15.) Use <a href="Cil.html#VALinteger"><code class="code">Cil.integer</code></a> or
- <a href="Cil.html#VALkinteger"><code class="code">Cil.kinteger</code></a> to create these. Watch out for integers that cannot be
- represented on 64 bits. OCAML does not give Overflow exceptions.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">CStr</span> <span class="keyword">of</span> <code class="type">string</code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">CWStr</span> <span class="keyword">of</span> <code class="type">int64 list</code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">CChr</span> <span class="keyword">of</span> <code class="type">char</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Character constant. This has type int, so use charConstToInt
- to read the value in case sign-extension is needed.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">CReal</span> <span class="keyword">of</span> <code class="type">float * <a href="Cil.html#TYPEfkind">fkind</a> * string option</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Floating point constant. Give the fkind (see ISO 6.4.4.2) and also
- the textual representation, if available.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">CEnum</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a> * string * <a href="Cil.html#TYPEenuminfo">enuminfo</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>An enumeration constant with the given value, name, from the given
- enuminfo. This is used only if <a href="Cil.html#VALlowerConstants"><code class="code">Cil.lowerConstants</code></a> is true
- (default). Use <a href="Cil.html#VALconstFoldVisitor"><code class="code">Cil.constFoldVisitor</code></a> to replace these with integer
- constants.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-<div class="info">
-Literal constants<br>
-</div>
-
-<br><code><span class="keyword">type</span> <a name="TYPEunop"></a><code class="type"></code>unop = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Neg</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Unary minus</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">BNot</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Bitwise complement (~)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">LNot</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Logical Not (!)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-<div class="info">
-Unary operators<br>
-</div>
-
-<br><code><span class="keyword">type</span> <a name="TYPEbinop"></a><code class="type"></code>binop = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">PlusA</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>arithmetic +</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">PlusPI</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>pointer + integer</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">IndexPI</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>pointer + integer but only when
- it arises from an expression
- <code class="code">e[i]</code> when <code class="code">e</code> is a pointer and
- not an array. This is semantically
- the same as PlusPI but CCured uses
- this as a hint that the integer is
- probably positive.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">MinusA</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>arithmetic -</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">MinusPI</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>pointer - integer</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">MinusPP</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>pointer - pointer</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Mult</span></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Div</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>/</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Mod</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>%</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Shiftlt</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>shift left</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Shiftrt</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>shift right</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Lt</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>< (arithmetic comparison)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Gt</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>> (arithmetic comparison)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Le</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><= (arithmetic comparison)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Ge</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>> (arithmetic comparison)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Eq</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>== (arithmetic comparison)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Ne</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>!= (arithmetic comparison)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">BAnd</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>bitwise and</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">BXor</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>exclusive-or</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">BOr</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>inclusive-or</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">LAnd</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>logical and. Unlike other
- expressions this one does not
- always evaluate both operands. If
- you want to use these, you must
- set <a href="Cil.html#VALuseLogicalOperators"><code class="code">Cil.useLogicalOperators</code></a>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">LOr</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>logical or. Unlike other
- expressions this one does not
- always evaluate both operands. If
- you want to use these, you must
- set <a href="Cil.html#VALuseLogicalOperators"><code class="code">Cil.useLogicalOperators</code></a>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-<div class="info">
-Binary operations<br>
-</div>
-
-<br>
-<b>Lvalues.</b> Lvalues are the sublanguage of expressions that can appear at the left of an assignment or as operand to the address-of operator.
-In C the syntax for lvalues is not always a good indication of the meaning
-of the lvalue. For example the C value
-<pre>
-a[0][1][2]
-</pre>
- might involve 1, 2 or 3 memory reads when used in an expression context,
-depending on the declared type of the variable <code class="code">a</code>. If <code class="code">a</code> has type <code class="code">int
-[4][4][4]</code> then we have one memory read from somewhere inside the area
-that stores the array <code class="code">a</code>. On the other hand if <code class="code">a</code> has type <code class="code">int ***</code> then
-the expression really means <code class="code">* ( * ( * (a + 0) + 1) + 2)</code>, in which case it is
-clear that it involves three separate memory operations.
-<p>
-
-An lvalue denotes the contents of a range of memory addresses. This range
-is denoted as a host object along with an offset within the object. The
-host object can be of two kinds: a local or global variable, or an object
-whose address is in a pointer expression. We distinguish the two cases so
-that we can tell quickly whether we are accessing some component of a
-variable directly or we are accessing a memory location through a pointer.
-To make it easy to
-tell what an lvalue means CIL represents lvalues as a host object and an
-offset (see <a href="Cil.html#TYPElval"><code class="code">Cil.lval</code></a>). The host object (represented as
-<a href="Cil.html#TYPElhost"><code class="code">Cil.lhost</code></a>) can be a local or global variable or can be the object
-pointed-to by a pointer expression. The offset (represented as
-<a href="Cil.html#TYPEoffset"><code class="code">Cil.offset</code></a>) is a sequence of field or array index designators.
-<p>
-
- Both the typing rules and the meaning of an lvalue is very precisely
-specified in CIL.
-<p>
-
- The following are a few useful function for operating on lvalues:<ul>
-<li><a href="Cil.html#VALmkMem"><code class="code">Cil.mkMem</code></a> - makes an lvalue of <code class="code">Mem</code> kind. Use this to ensure
-that certain equivalent forms of lvalues are canonized.
-For example, <code class="code">*&x = x</code>. </li>
-<li><a href="Cil.html#VALtypeOfLval"><code class="code">Cil.typeOfLval</code></a> - the type of an lvalue</li>
-<li><a href="Cil.html#VALtypeOffset"><code class="code">Cil.typeOffset</code></a> - the type of an offset, given the type of the
-host. </li>
-<li><a href="Cil.html#VALaddOffset"><code class="code">Cil.addOffset</code></a> and <a href="Cil.html#VALaddOffsetLval"><code class="code">Cil.addOffsetLval</code></a> - extend sequences
-of offsets.</li>
-<li><a href="Cil.html#VALremoveOffset"><code class="code">Cil.removeOffset</code></a> and <a href="Cil.html#VALremoveOffsetLval"><code class="code">Cil.removeOffsetLval</code></a> - shrink sequences
-of offsets.</li>
-</ul>
-
-The following equivalences hold <pre>
-Mem(AddrOf(Mem a, aoff)), off = Mem a, aoff + off
-Mem(AddrOf(Var v, aoff)), off = Var v, aoff + off
-AddrOf (Mem a, NoOffset) = a
-</pre><br>
-<pre><span class="keyword">type</span> <a name="TYPElval"></a><code class="type"></code>lval = <code class="type"><a href="Cil.html#TYPElhost">lhost</a> * <a href="Cil.html#TYPEoffset">offset</a></code> </pre>
-<div class="info">
-An lvalue<br>
-</div>
-
-<br><code><span class="keyword">type</span> <a name="TYPElhost"></a><code class="type"></code>lhost = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Var</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The host is a variable.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Mem</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The host is an object of type <code class="code">T</code> when the expression has pointer
- <code class="code">TPtr(T)</code>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-<div class="info">
-The host part of an <a href="Cil.html#TYPElval"><code class="code">Cil.lval</code></a>.<br>
-</div>
-
-<br><code><span class="keyword">type</span> <a name="TYPEoffset"></a><code class="type"></code>offset = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">NoOffset</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>No offset. Can be applied to any lvalue and does
- not change either the starting address or the type.
- This is used when the lval consists of just a host
- or as a terminator in a list of other kinds of
- offsets.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Field</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEfieldinfo">fieldinfo</a> * <a href="Cil.html#TYPEoffset">offset</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A field offset. Can be applied only to an lvalue
- that denotes a structure or a union that contains
- the mentioned field. This advances the offset to the
- beginning of the mentioned field and changes the
- type to the type of the mentioned field.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Index</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPEoffset">offset</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>An array index offset. Can be applied only to an
- lvalue that denotes an array. This advances the
- starting address of the lval to the beginning of the
- mentioned array element and changes the denoted type
- to be the type of the array element</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-<div class="info">
-The offset part of an <a href="Cil.html#TYPElval"><code class="code">Cil.lval</code></a>. Each offset can be applied to certain
- kinds of lvalues and its effect is that it advances the starting address
- of the lvalue and changes the denoted type, essentially focusing to some
- smaller lvalue that is contained in the original one.<br>
-</div>
-
-<br>
-<b>Initializers.</b>
-A special kind of expressions are those that can appear as initializers for
-global variables (initialization of local variables is turned into
-assignments). The initializers are represented as type <a href="Cil.html#TYPEinit"><code class="code">Cil.init</code></a>. You
-can create initializers with <a href="Cil.html#VALmakeZeroInit"><code class="code">Cil.makeZeroInit</code></a> and you can conveniently
-scan compound initializers them with <a href="Cil.html#VALfoldLeftCompound"><code class="code">Cil.foldLeftCompound</code></a> or with <a href="Cil.html#VALfoldLeftCompoundAll"><code class="code">Cil.foldLeftCompoundAll</code></a>.<br>
-<br><code><span class="keyword">type</span> <a name="TYPEinit"></a><code class="type"></code>init = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">SingleInit</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A single initializer</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">CompoundInit</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a> * (<a href="Cil.html#TYPEoffset">offset</a> * <a href="Cil.html#TYPEinit">init</a>) list</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Used only for initializers of structures, unions and arrays. The
- offsets are all of the form <code class="code">Field(f, NoOffset)</code> or <code class="code">Index(i,
- NoOffset)</code> and specify the field or the index being initialized. For
- structures all fields must have an initializer (except the unnamed
- bitfields), in the proper order. This is necessary since the offsets
- are not printed. For unions there must be exactly one initializer. If
- the initializer is not for the first field then a field designator is
- printed, so you better be on GCC since MSVC does not understand this.
- For arrays, however, we allow you to give only a prefix of the
- initializers. You can scan an initializer list with
- <a href="Cil.html#VALfoldLeftCompound"><code class="code">Cil.foldLeftCompound</code></a> or with <a href="Cil.html#VALfoldLeftCompoundAll"><code class="code">Cil.foldLeftCompoundAll</code></a>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-<div class="info">
-Initializers for global variables.<br>
-</div>
-
-<br><code><span class="keyword">type</span> <a name="TYPEinitinfo"></a><code class="type"></code>initinfo = {</code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>init : <code class="type"><a href="Cil.html#TYPEinit">init</a> option</code>;</code></td>
-
-</tr></table>
-}
-
-<div class="info">
-We want to be able to update an initializer in a global variable, so we
- define it as a mutable field<br>
-</div>
-
-<br>
-<b>Function definitions.</b>
-A function definition is always introduced with a <code class="code">GFun</code> constructor at the
-top level. All the information about the function is stored into a
-<a href="Cil.html#TYPEfundec"><code class="code">Cil.fundec</code></a>. Some of the information (e.g. its name, type,
-storage, attributes) is stored as a <a href="Cil.html#TYPEvarinfo"><code class="code">Cil.varinfo</code></a> that is a field of the
-<code class="code">fundec</code>. To refer to the function from the expression language you must use
-the <code class="code">varinfo</code>.
-<p>
-
- The function definition contains, in addition to the body, a list of all the
-local variables and separately a list of the formals. Both kind of variables
-can be referred to in the body of the function. The formals must also be shared
-with the formals that appear in the function type. For that reason, to
-manipulate formals you should use the provided functions
-<a href="Cil.html#VALmakeFormalVar"><code class="code">Cil.makeFormalVar</code></a> and <a href="Cil.html#VALsetFormals"><code class="code">Cil.setFormals</code></a> and <a href="Cil.html#VALmakeFormalVar"><code class="code">Cil.makeFormalVar</code></a>.<br>
-<br><code><span class="keyword">type</span> <a name="TYPEfundec"></a><code class="type"></code>fundec = {</code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>svar : <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a></code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Holds the name and type as a variable, so we can refer to it
- easily from the program. All references to this function either
- in a function call or in a prototype must point to the same
- <code class="code">varinfo</code>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>sformals : <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> list</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Formals. These must be in the same order and with the same
- information as the formal information in the type of the function.
- Use <a href="Cil.html#VALsetFormals"><code class="code">Cil.setFormals</code></a> or
- <a href="Cil.html#VALsetFunctionType"><code class="code">Cil.setFunctionType</code></a> or <a href="Cil.html#VALmakeFormalVar"><code class="code">Cil.makeFormalVar</code></a>
- to set these formals and ensure that they
- are reflected in the function type. Do not make copies of these
- because the body refers to them.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>slocals : <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> list</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Locals. Does NOT include the sformals. Do not make copies of
- these because the body refers to them.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>smaxid : <code class="type">int</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Max local id. Starts at 0. Used for
- creating the names of new temporary
- variables. Updated by
- <a href="Cil.html#VALmakeLocalVar"><code class="code">Cil.makeLocalVar</code></a> and
- <a href="Cil.html#VALmakeTempVar"><code class="code">Cil.makeTempVar</code></a>. You can also use
- <a href="Cil.html#VALsetMaxId"><code class="code">Cil.setMaxId</code></a> to set it after you
- have added the formals and locals.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>sbody : <code class="type"><a href="Cil.html#TYPEblock">block</a></code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The function body.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>smaxstmtid : <code class="type">int option</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>max id of a (reachable) statement
- in this function, if we have
- computed it. range = 0 ...
- (smaxstmtid-1). This is computed by
- <a href="Cil.html#VALcomputeCFGInfo"><code class="code">Cil.computeCFGInfo</code></a>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>sallstmts : <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> list</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>After you call <a href="Cil.html#VALcomputeCFGInfo"><code class="code">Cil.computeCFGInfo</code></a>
- this field is set to contain all
- statements in the function</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-}
-
-<div class="info">
-Function definitions.<br>
-</div>
-
-<br><code><span class="keyword">type</span> <a name="TYPEblock"></a><code class="type"></code>block = {</code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>battrs : <code class="type"><a href="Cil.html#TYPEattributes">attributes</a></code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Attributes for the block</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>bstmts : <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> list</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The statements comprising the block</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-}
-
-<div class="info">
-A block is a sequence of statements with the control falling through from
- one element to the next<br>
-</div>
-
-<br>
-<b>Statements</b>.
-CIL statements are the structural elements that make the CFG. They are
-represented using the type <a href="Cil.html#TYPEstmt"><code class="code">Cil.stmt</code></a>. Every
-statement has a (possibly empty) list of labels. The
-<a href="Cil.html#TYPEstmtkind"><code class="code">Cil.stmtkind</code></a> field of a statement indicates what kind of statement it
-is.
-<p>
-
- Use <a href="Cil.html#VALmkStmt"><code class="code">Cil.mkStmt</code></a> to make a statement and the fill-in the fields.
-<p>
-
-CIL also comes with support for control-flow graphs. The <code class="code">sid</code> field in
-<code class="code">stmt</code> can be used to give unique numbers to statements, and the <code class="code">succs</code>
-and <code class="code">preds</code> fields can be used to maintain a list of successors and
-predecessors for every statement. The CFG information is not computed by
-default. Instead you must explicitly use the functions
-<a href="Cil.html#VALprepareCFG"><code class="code">Cil.prepareCFG</code></a> and <a href="Cil.html#VALcomputeCFGInfo"><code class="code">Cil.computeCFGInfo</code></a> to do it.<br>
-<br><code><span class="keyword">type</span> <a name="TYPEstmt"></a><code class="type"></code>stmt = {</code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>labels : <code class="type"><a href="Cil.html#TYPElabel">label</a> list</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Whether the statement starts with some labels, case statements or
- default statements.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>skind : <code class="type"><a href="Cil.html#TYPEstmtkind">stmtkind</a></code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The kind of statement</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>sid : <code class="type">int</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A number (>= 0) that is unique in a function. Filled in only after
- the CFG is computed.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>succs : <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> list</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The successor statements. They can always be computed from the skind
- and the context in which this statement appears. Filled in only after
- the CFG is computed.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code><span class="keyword">mutable </span>preds : <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> list</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The inverse of the succs function.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-}
-
-<div class="info">
-Statements.<br>
-</div>
-
-<br><code><span class="keyword">type</span> <a name="TYPElabel"></a><code class="type"></code>label = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Label</span> <span class="keyword">of</span> <code class="type">string * <a href="Cil.html#TYPElocation">location</a> * bool</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A real label. If the bool is "true", the label is from the
- input source program. If the bool is "false", the label was
- created by CIL or some other transformation</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Case</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A case statement. This expression
- is lowered into a constant if
- <a href="Cil.html#VALlowerConstants"><code class="code">Cil.lowerConstants</code></a> is set to
- true.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Default</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A default statement</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-<div class="info">
-Labels<br>
-</div>
-
-<br><code><span class="keyword">type</span> <a name="TYPEstmtkind"></a><code class="type"></code>stmtkind = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Instr</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEinstr">instr</a> list</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A group of instructions that do not contain control flow. Control
- implicitly falls through.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Return</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a> option * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The return statement. This is a leaf in the CFG.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Goto</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> Pervasives.ref * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A goto statement. Appears from actual goto's in the code or from
- goto's that have been inserted during elaboration. The reference
- points to the statement that is the target of the Goto. This means that
- you have to update the reference whenever you replace the target
- statement. The target statement MUST have at least a label.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Break</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A break to the end of the nearest enclosing Loop or Switch</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Continue</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A continue to the start of the nearest enclosing <code class="code">Loop</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">If</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPEblock">block</a> * <a href="Cil.html#TYPEblock">block</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A conditional. Two successors, the "then" and the "else" branches.
- Both branches fall-through to the successor of the If statement.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Switch</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPEblock">block</a> * <a href="Cil.html#TYPEstmt">stmt</a> list * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A switch statement. The statements that implement the cases can be
- reached through the provided list. For each such target you can find
- among its labels what cases it implements. The statements that
- implement the cases are somewhere within the provided <code class="code">block</code>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Loop</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEblock">block</a> * <a href="Cil.html#TYPElocation">location</a> * <a href="Cil.html#TYPEstmt">stmt</a> option * <a href="Cil.html#TYPEstmt">stmt</a> option</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A <code class="code">while(1)</code> loop. The termination test is implemented in the body of
- a loop using a <code class="code">Break</code> statement. If prepareCFG has been called,
- the first stmt option will point to the stmt containing the continue
- label for this loop and the second will point to the stmt containing
- the break label for this loop.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Block</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEblock">block</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Just a block of statements. Use it as a way to keep some block
- attributes local</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TryFinally</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEblock">block</a> * <a href="Cil.html#TYPEblock">block</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TryExcept</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEblock">block</a> * (<a href="Cil.html#TYPEinstr">instr</a> list * <a href="Cil.html#TYPEexp">exp</a>) * <a href="Cil.html#TYPEblock">block</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-
-</tr></table>
-
-<div class="info">
-The various kinds of control-flow statements statements<br>
-</div>
-
-<br>
-<b>Instructions</b>.
- An instruction <a href="Cil.html#TYPEinstr"><code class="code">Cil.instr</code></a> is a statement that has no local
-(intraprocedural) control flow. It can be either an assignment,
-function call, or an inline assembly instruction.<br>
-<br><code><span class="keyword">type</span> <a name="TYPEinstr"></a><code class="type"></code>instr = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Set</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElval">lval</a> * <a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>An assignment. The type of the expression is guaranteed to be the same
- with that of the lvalue</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Call</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElval">lval</a> option * <a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPEexp">exp</a> list * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A function call with the (optional) result placed in an lval. It is
- possible that the returned type of the function is not identical to
- that of the lvalue. In that case a cast is printed. The type of the
- actual arguments are identical to those of the declared formals. The
- number of arguments is the same as that of the declared formals, except
- for vararg functions. This construct is also used to encode a call to
- "__builtin_va_arg". In this case the second argument (which should be a
- type T) is encoded SizeOf(T)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Asm</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattributes">attributes</a> * string list * (string * <a href="Cil.html#TYPElval">lval</a>) list<br> * (string * <a href="Cil.html#TYPEexp">exp</a>) list * string list * <a href="Cil.html#TYPElocation">location</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>There are for storing inline assembly. They follow the GCC
- specification:
-<pre>
- asm [volatile] ("...template..." "..template.."
- : "c1" (o1), "c2" (o2), ..., "cN" (oN)
- : "d1" (i1), "d2" (i2), ..., "dM" (iM)
- : "r1", "r2", ..., "nL" );
-</pre>
-<p>
-
-where the parts are
-<p>
-<ul>
-<li><code class="code">volatile</code> (optional): when present, the assembler instruction
- cannot be removed, moved, or otherwise optimized</li>
-<li>template: a sequence of strings, with %0, %1, %2, etc. in the string to
- refer to the input and output expressions. I think they're numbered
- consecutively, but the docs don't specify. Each string is printed on
- a separate line. This is the only part that is present for MSVC inline
- assembly.</li>
-<li>"ci" (oi): pairs of constraint-string and output-lval; the
- constraint specifies that the register used must have some
- property, like being a floating-point register; the constraint
- string for outputs also has "=" to indicate it is written, or
- "+" to indicate it is both read and written; 'oi' is the
- name of a C lvalue (probably a variable name) to be used as
- the output destination</li>
-<li>"dj" (ij): pairs of constraint and input expression; the constraint
- is similar to the "ci"s. the 'ij' is an arbitrary C expression
- to be loaded into the corresponding register</li>
-<li>"rk": registers to be regarded as "clobbered" by the instruction;
- "memory" may be specified for arbitrary memory effects</li>
-</ul>
-
-an example (from gcc manual):
-<pre>
- asm volatile ("movc3 %0,%1,%2"
- : /* no outputs */
- : "g" (from), "g" (to), "g" (count)
- : "r0", "r1", "r2", "r3", "r4", "r5");
-</pre></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-<div class="info">
-Instructions.<br>
-</div>
-
-<br><code><span class="keyword">type</span> <a name="TYPElocation"></a><code class="type"></code>location = {</code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code>line : <code class="type">int</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The line number. -1 means "do not know"</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code>file : <code class="type">string</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The name of the source file</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code>byte : <code class="type">int</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The byte position in the source file</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-}
-
-<div class="info">
-Describes a location in a source file.<br>
-</div>
-
-<br><code><span class="keyword">type</span> <a name="TYPEtypsig"></a><code class="type"></code>typsig = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TSArray</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtypsig">typsig</a> * int64 option * <a href="Cil.html#TYPEattribute">attribute</a> list</code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TSPtr</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtypsig">typsig</a> * <a href="Cil.html#TYPEattribute">attribute</a> list</code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TSComp</span> <span class="keyword">of</span> <code class="type">bool * string * <a href="Cil.html#TYPEattribute">attribute</a> list</code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TSFun</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtypsig">typsig</a> * <a href="Cil.html#TYPEtypsig">typsig</a> list * bool * <a href="Cil.html#TYPEattribute">attribute</a> list</code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TSEnum</span> <span class="keyword">of</span> <code class="type">string * <a href="Cil.html#TYPEattribute">attribute</a> list</code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">TSBase</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></code></td>
-
-</tr></table>
-
-<div class="info">
-Type signatures. Two types are identical iff they have identical
- signatures. These contain the same information as types but canonicalized.
- For example, two function types that are identical except for the name of
- the formal arguments are given the same signature. Also, <code class="code">TNamed</code>
- constructors are unrolled.<br>
-</div>
-
-<br>
-<b>Lowering Options</b><br>
-<pre><span class="keyword">val</span> <a name="VALlowerConstants"></a>lowerConstants : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-Do lower constants (default true)<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALinsertImplicitCasts"></a>insertImplicitCasts : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-Do insert implicit casts (default true)<br>
-</div>
-<br><code><span class="keyword">type</span> <a name="TYPEfeatureDescr"></a><code class="type"></code>featureDescr = {</code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code>fd_enabled : <code class="type">bool Pervasives.ref</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The enable flag. Set to default value</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code>fd_name : <code class="type">string</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>This is used to construct an option "--doxxx" and "--dontxxx" that
- enable and disable the feature</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code>fd_description : <code class="type">string</code>;</code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code>fd_extraopt : <code class="type">(string * Arg.spec * string) list</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Additional command line options</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code>fd_doit : <code class="type"><a href="Cil.html#TYPEfile">file</a> -> unit</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>This performs the transformation</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code>fd_post_check : <code class="type">bool</code>;</code></td>
-
-</tr></table>
-}
-
-<div class="info">
-To be able to add/remove features easily, each feature should be package
- as an interface with the following interface. These features should be<br>
-</div>
-
-<pre><span class="keyword">val</span> <a name="VALcompareLoc"></a>compareLoc : <code class="type"><a href="Cil.html#TYPElocation">location</a> -> <a href="Cil.html#TYPElocation">location</a> -> int</code></pre><div class="info">
-Comparison function for locations.
-* Compares first by filename, then line, then byte<br>
-</div>
-<br>
-<b>Values for manipulating globals</b><br>
-<pre><span class="keyword">val</span> <a name="VALemptyFunction"></a>emptyFunction : <code class="type">string -> <a href="Cil.html#TYPEfundec">fundec</a></code></pre><div class="info">
-Make an empty function<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALsetFormals"></a>setFormals : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a> list -> unit</code></pre><div class="info">
-Update the formals of a <code class="code">fundec</code> and make sure that the function type
- has the same information. Will copy the name as well into the type.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALsetFunctionType"></a>setFunctionType : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> <a href="Cil.html#TYPEtyp">typ</a> -> unit</code></pre><div class="info">
-Set the types of arguments and results as given by the function type
- passed as the second argument. Will not copy the names from the function
- type to the formals<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALsetFunctionTypeMakeFormals"></a>setFunctionTypeMakeFormals : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> <a href="Cil.html#TYPEtyp">typ</a> -> unit</code></pre><div class="info">
-Set the type of the function and make formal arguments for them<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALsetMaxId"></a>setMaxId : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> unit</code></pre><div class="info">
-Update the smaxid after you have populated with locals and formals
- (unless you constructed those using <a href="Cil.html#VALmakeLocalVar"><code class="code">Cil.makeLocalVar</code></a> or
- <a href="Cil.html#VALmakeTempVar"><code class="code">Cil.makeTempVar</code></a>.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdummyFunDec"></a>dummyFunDec : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a></code></pre><div class="info">
-A dummy function declaration handy when you need one as a placeholder. It
- contains inside a dummy varinfo.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdummyFile"></a>dummyFile : <code class="type"><a href="Cil.html#TYPEfile">file</a></code></pre><div class="info">
-A dummy file<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALsaveBinaryFile"></a>saveBinaryFile : <code class="type"><a href="Cil.html#TYPEfile">file</a> -> string -> unit</code></pre><div class="info">
-Write a <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a> in binary form to the filesystem. The file can be
- read back in later using <a href="Cil.html#VALloadBinaryFile"><code class="code">Cil.loadBinaryFile</code></a>, possibly saving parsing
- time. The second argument is the name of the file that should be
- created.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALsaveBinaryFileChannel"></a>saveBinaryFileChannel : <code class="type"><a href="Cil.html#TYPEfile">file</a> -> Pervasives.out_channel -> unit</code></pre><div class="info">
-Write a <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a> in binary form to the filesystem. The file can be
- read back in later using <a href="Cil.html#VALloadBinaryFile"><code class="code">Cil.loadBinaryFile</code></a>, possibly saving parsing
- time. Does not close the channel.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALloadBinaryFile"></a>loadBinaryFile : <code class="type">string -> <a href="Cil.html#TYPEfile">file</a></code></pre><div class="info">
-Read a <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a> in binary form from the filesystem. The first
- argument is the name of a file previously created by
- <a href="Cil.html#VALsaveBinaryFile"><code class="code">Cil.saveBinaryFile</code></a>.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALgetGlobInit"></a>getGlobInit : <code class="type">?main_name:string -> <a href="Cil.html#TYPEfile">file</a> -> <a href="Cil.html#TYPEfundec">fundec</a></code></pre><div class="info">
-Get the global initializer and create one if it does not already exist.
- When it creates a global initializer it attempts to place a call to it in
- the main function named by the optional argument (default "main")<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALiterGlobals"></a>iterGlobals : <code class="type"><a href="Cil.html#TYPEfile">file</a> -> (<a href="Cil.html#TYPEglobal">global</a> -> unit) -> unit</code></pre><div class="info">
-Iterate over all globals, including the global initializer<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALfoldGlobals"></a>foldGlobals : <code class="type"><a href="Cil.html#TYPEfile">file</a> -> ('a -> <a href="Cil.html#TYPEglobal">global</a> -> 'a) -> 'a -> 'a</code></pre><div class="info">
-Fold over all globals, including the global initializer<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmapGlobals"></a>mapGlobals : <code class="type"><a href="Cil.html#TYPEfile">file</a> -> (<a href="Cil.html#TYPEglobal">global</a> -> <a href="Cil.html#TYPEglobal">global</a>) -> unit</code></pre><div class="info">
-Map over all globals, including the global initializer and change things
- in place<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALnew_sid"></a>new_sid : <code class="type">unit -> int</code></pre><pre><span class="keyword">val</span> <a name="VALprepareCFG"></a>prepareCFG : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> unit</code></pre><div class="info">
-Prepare a function for CFG information computation by
- <a href="Cil.html#VALcomputeCFGInfo"><code class="code">Cil.computeCFGInfo</code></a>. This function converts all <code class="code">Break</code>, <code class="code">Switch</code>,
- <code class="code">Default</code> and <code class="code">Continue</code> <a href="Cil.html#TYPEstmtkind"><code class="code">Cil.stmtkind</code></a>s and <a href="Cil.html#TYPElabel"><code class="code">Cil.label</code></a>s into <code class="code">If</code>s
- and <code class="code">Goto</code>s, giving the function body a very CFG-like character. This
- function modifies its argument in place.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcomputeCFGInfo"></a>computeCFGInfo : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> bool -> unit</code></pre><div class="info">
-Compute the CFG information for all statements in a fundec and return a
- list of the statements. The input fundec cannot have <code class="code">Break</code>, <code class="code">Switch</code>,
- <code class="code">Default</code>, or <code class="code">Continue</code> <a href="Cil.html#TYPEstmtkind"><code class="code">Cil.stmtkind</code></a>s or <a href="Cil.html#TYPElabel"><code class="code">Cil.label</code></a>s. Use
- <a href="Cil.html#VALprepareCFG"><code class="code">Cil.prepareCFG</code></a> to transform them away. The second argument should
- be <code class="code">true</code> if you wish a global statement number, <code class="code">false</code> if you wish a
- local (per-function) statement numbering. The list of statements is set
- in the sallstmts field of a fundec.
-<p>
-
- NOTE: unless you want the simpler control-flow graph provided by
- prepareCFG, or you need the function's smaxstmtid and sallstmt fields
- filled in, we recommend you use <a href="Cfg.html#VALcomputeFileCFG"><code class="code">Cfg.computeFileCFG</code></a> instead of this
- function to compute control-flow information.
- <a href="Cfg.html#VALcomputeFileCFG"><code class="code">Cfg.computeFileCFG</code></a> is newer and will handle switch, break, and
- continue correctly.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcopyFunction"></a>copyFunction : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> string -> <a href="Cil.html#TYPEfundec">fundec</a></code></pre><div class="info">
-Create a deep copy of a function. There should be no sharing between the
- copy and the original function<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALpushGlobal"></a>pushGlobal : <code class="type"><a href="Cil.html#TYPEglobal">global</a> -><br> types:<a href="Cil.html#TYPEglobal">global</a> list Pervasives.ref -><br> variables:<a href="Cil.html#TYPEglobal">global</a> list Pervasives.ref -> unit</code></pre><div class="info">
-CIL keeps the types at the beginning of the file and the variables at the
- end of the file. This function will take a global and add it to the
- corresponding stack. Its operation is actually more complicated because if
- the global declares a type that contains references to variables (e.g. in
- sizeof in an array length) then it will also add declarations for the
- variables to the types stack<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALinvalidStmt"></a>invalidStmt : <code class="type"><a href="Cil.html#TYPEstmt">stmt</a></code></pre><div class="info">
-An empty statement. Used in pretty printing<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALgccBuiltins"></a>gccBuiltins : <code class="type">(string, <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEtyp">typ</a> list * bool) Hashtbl.t</code></pre><div class="info">
-A list of the GCC built-in functions. Maps the name to the result and
- argument types, and whether it is vararg<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmsvcBuiltins"></a>msvcBuiltins : <code class="type">(string, <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEtyp">typ</a> list * bool) Hashtbl.t</code></pre><div class="info">
-A list of the MSVC built-in functions. Maps the name to the result and
- argument types, and whether it is vararg<br>
-</div>
-<br>
-<b>Values for manipulating initializers</b><br>
-<pre><span class="keyword">val</span> <a name="VALmakeZeroInit"></a>makeZeroInit : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEinit">init</a></code></pre><div class="info">
-Make a initializer for zero-ing a data type<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALfoldLeftCompound"></a>foldLeftCompound : <code class="type">doinit:(<a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEinit">init</a> -> <a href="Cil.html#TYPEtyp">typ</a> -> 'a -> 'a) -><br> ct:<a href="Cil.html#TYPEtyp">typ</a> -> initl:(<a href="Cil.html#TYPEoffset">offset</a> * <a href="Cil.html#TYPEinit">init</a>) list -> acc:'a -> 'a</code></pre><div class="info">
-Fold over the list of initializers in a Compound. <code class="code">doinit</code> is called on
- every present initializer, even if it is of compound type. In the case of
- arrays there might be missing zero-initializers at the end of the list.
- These are not scanned. This is much like <code class="code">List.fold_left</code> except we also
- pass the type of the initializer<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALfoldLeftCompoundAll"></a>foldLeftCompoundAll : <code class="type">doinit:(<a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEinit">init</a> -> <a href="Cil.html#TYPEtyp">typ</a> -> 'a -> 'a) -><br> ct:<a href="Cil.html#TYPEtyp">typ</a> -> initl:(<a href="Cil.html#TYPEoffset">offset</a> * <a href="Cil.html#TYPEinit">init</a>) list -> acc:'a -> 'a</code></pre><div class="info">
-Fold over the list of initializers in a Compound, like
- <a href="Cil.html#VALfoldLeftCompound"><code class="code">Cil.foldLeftCompound</code></a> but in the case of an array it scans even missing
- zero initializers at the end of the array<br>
-</div>
-<br>
-<b>Values for manipulating types</b><br>
-<pre><span class="keyword">val</span> <a name="VALvoidType"></a>voidType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-void<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALisVoidType"></a>isVoidType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><pre><span class="keyword">val</span> <a name="VALisVoidPtrType"></a>isVoidPtrType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><pre><span class="keyword">val</span> <a name="VALintType"></a>intType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-int<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALuintType"></a>uintType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-unsigned int<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALlongType"></a>longType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-long<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALulongType"></a>ulongType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-unsigned long<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcharType"></a>charType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-char<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcharPtrType"></a>charPtrType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-char *<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALwcharKind"></a>wcharKind : <code class="type"><a href="Cil.html#TYPEikind">ikind</a> Pervasives.ref</code></pre><div class="info">
-wchar_t (depends on architecture) and is set when you call
- <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a>.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALwcharType"></a>wcharType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> Pervasives.ref</code></pre><pre><span class="keyword">val</span> <a name="VALcharConstPtrType"></a>charConstPtrType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-char const *<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALvoidPtrType"></a>voidPtrType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-void *<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALintPtrType"></a>intPtrType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-int *<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALuintPtrType"></a>uintPtrType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-unsigned int *<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdoubleType"></a>doubleType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-double<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALupointType"></a>upointType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> Pervasives.ref</code></pre><pre><span class="keyword">val</span> <a name="VALtypeOfSizeOf"></a>typeOfSizeOf : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> Pervasives.ref</code></pre><pre><span class="keyword">val</span> <a name="VALisSigned"></a>isSigned : <code class="type"><a href="Cil.html#TYPEikind">ikind</a> -> bool</code></pre><div class="info">
-Returns true if and only if the given integer type is signed.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmkCompInfo"></a>mkCompInfo : <code class="type">bool -><br> string -><br> (<a href="Cil.html#TYPEcompinfo">compinfo</a> -><br> (string * <a href="Cil.html#TYPEtyp">typ</a> * int option * <a href="Cil.html#TYPEattributes">attributes</a> * <a href="Cil.html#TYPElocation">location</a>) list) -><br> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEcompinfo">compinfo</a></code></pre><div class="info">
-Creates a a (potentially recursive) composite type. The arguments are:
- (1) a boolean indicating whether it is a struct or a union, (2) the name
- (always non-empty), (3) a function that when given a representation of the
- structure type constructs the type of the fields recursive type (the first
- argument is only useful when some fields need to refer to the type of the
- structure itself), and (4) a list of attributes to be associated with the
- composite type. The resulting compinfo has the field "cdefined" only if
- the list of fields is non-empty.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcopyCompInfo"></a>copyCompInfo : <code class="type"><a href="Cil.html#TYPEcompinfo">compinfo</a> -> string -> <a href="Cil.html#TYPEcompinfo">compinfo</a></code></pre><div class="info">
-Makes a shallow copy of a <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> changing the name and the key.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmissingFieldName"></a>missingFieldName : <code class="type">string</code></pre><div class="info">
-This is a constant used as the name of an unnamed bitfield. These fields
- do not participate in initialization and their name is not printed.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcompFullName"></a>compFullName : <code class="type"><a href="Cil.html#TYPEcompinfo">compinfo</a> -> string</code></pre><div class="info">
-Get the full name of a comp<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALisCompleteType"></a>isCompleteType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><div class="info">
-Returns true if this is a complete type.
- This means that sizeof(t) makes sense.
- Incomplete types are not yet defined
- structures and empty arrays.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALunrollType"></a>unrollType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-Unroll a type until it exposes a non
- <code class="code">TNamed</code>. Will collect all attributes appearing in <code class="code">TNamed</code>!!!<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALunrollTypeDeep"></a>unrollTypeDeep : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-Unroll all the TNamed in a type (even under type constructors such as
- <code class="code">TPtr</code>, <code class="code">TFun</code> or <code class="code">TArray</code>. Does not unroll the types of fields in <code class="code">TComp</code>
- types. Will collect all attributes<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALseparateStorageModifiers"></a>separateStorageModifiers : <code class="type"><a href="Cil.html#TYPEattribute">attribute</a> list -> <a href="Cil.html#TYPEattribute">attribute</a> list * <a href="Cil.html#TYPEattribute">attribute</a> list</code></pre><div class="info">
-Separate out the storage-modifier name attributes<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALisIntegralType"></a>isIntegralType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><div class="info">
-True if the argument is an integral type (i.e. integer or enum)<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALisArithmeticType"></a>isArithmeticType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><div class="info">
-True if the argument is an arithmetic type (i.e. integer, enum or
- floating point<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALisPointerType"></a>isPointerType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><div class="info">
-True if the argument is a pointer type<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALisFunctionType"></a>isFunctionType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><div class="info">
-True if the argument is a function type<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALargsToList"></a>argsToList : <code class="type">(string * <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEattributes">attributes</a>) list option -><br> (string * <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEattributes">attributes</a>) list</code></pre><div class="info">
-Obtain the argument list ([] if None)<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALisArrayType"></a>isArrayType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><div class="info">
-True if the argument is an array type<br>
-</div>
-<pre><span class="keyword">exception</span> <a name="EXCEPTIONLenOfArray"></a>LenOfArray</pre>
-<div class="info">
-Raised when <a href="Cil.html#VALlenOfArray"><code class="code">Cil.lenOfArray</code></a> fails either because the length is <code class="code">None</code>
- or because it is a non-constant expression<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALlenOfArray"></a>lenOfArray : <code class="type"><a href="Cil.html#TYPEexp">exp</a> option -> int</code></pre><div class="info">
-Call to compute the array length as present in the array type, to an
- integer. Raises <a href="Cil.html#EXCEPTIONLenOfArray"><code class="code">Cil.LenOfArray</code></a> if not able to compute the length, such
- as when there is no length or the length is not a constant.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALgetCompField"></a>getCompField : <code class="type"><a href="Cil.html#TYPEcompinfo">compinfo</a> -> string -> <a href="Cil.html#TYPEfieldinfo">fieldinfo</a></code></pre><div class="info">
-Return a named fieldinfo in compinfo, or raise Not_found<br>
-</div>
-<br><code><span class="keyword">type</span> <a name="TYPEexistsAction"></a><code class="type"></code>existsAction = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">ExistsTrue</span></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">ExistsFalse</span></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">ExistsMaybe</span></code></td>
-
-</tr></table>
-
-<div class="info">
-A datatype to be used in conjunction with <code class="code">existsType</code><br>
-</div>
-
-<pre><span class="keyword">val</span> <a name="VALexistsType"></a>existsType : <code class="type">(<a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEexistsAction">existsAction</a>) -> <a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><div class="info">
-Scans a type by applying the function on all elements.
- When the function returns ExistsTrue, the scan stops with
- true. When the function returns ExistsFalse then the current branch is not
- scanned anymore. Care is taken to
- apply the function only once on each composite type, thus avoiding
- circularity. When the function returns ExistsMaybe then the types that
- construct the current type are scanned (e.g. the base type for TPtr and
- TArray, the type of fields for a TComp, etc).<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALsplitFunctionType"></a>splitFunctionType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -><br> <a href="Cil.html#TYPEtyp">typ</a> * (string * <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEattributes">attributes</a>) list option * bool *<br> <a href="Cil.html#TYPEattributes">attributes</a></code></pre><div class="info">
-Given a function type split it into return type,
- arguments, is_vararg and attributes. An error is raised if the type is not
- a function type
-<p>
-Same as <a href="Cil.html#VALsplitFunctionType"><code class="code">Cil.splitFunctionType</code></a> but takes a varinfo. Prints a nicer
- error message if the varinfo is not for a function<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALsplitFunctionTypeVI"></a>splitFunctionTypeVI : <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> -><br> <a href="Cil.html#TYPEtyp">typ</a> * (string * <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEattributes">attributes</a>) list option * bool *<br> <a href="Cil.html#TYPEattributes">attributes</a></code></pre><br>
-<b>Type signatures</b><br>
-<br>
-Type signatures. Two types are identical iff they have identical
- signatures. These contain the same information as types but canonicalized.
- For example, two function types that are identical except for the name of
- the formal arguments are given the same signature. Also, <code class="code">TNamed</code>
- constructors are unrolled. You shoud use <code class="code">Util.equals</code> to compare type
- signatures because they might still contain circular structures (through
- attributes, and sizeof)<br>
-<pre><span class="keyword">val</span> <a name="VALd_typsig"></a>d_typsig : <code class="type">unit -> <a href="Cil.html#TYPEtypsig">typsig</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Print a type signature<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALtypeSig"></a>typeSig : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEtypsig">typsig</a></code></pre><div class="info">
-Compute a type signature<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALtypeSigWithAttrs"></a>typeSigWithAttrs : <code class="type">?ignoreSign:bool -><br> (<a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEattributes">attributes</a>) -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEtypsig">typsig</a></code></pre><div class="info">
-Like <a href="Cil.html#VALtypeSig"><code class="code">Cil.typeSig</code></a> but customize the incorporation of attributes.
- Use ~ignoreSign:true to convert all signed integer types to unsigned,
- so that signed and unsigned will compare the same.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALsetTypeSigAttrs"></a>setTypeSigAttrs : <code class="type"><a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEtypsig">typsig</a> -> <a href="Cil.html#TYPEtypsig">typsig</a></code></pre><div class="info">
-Replace the attributes of a signature (only at top level)<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALtypeSigAttrs"></a>typeSigAttrs : <code class="type"><a href="Cil.html#TYPEtypsig">typsig</a> -> <a href="Cil.html#TYPEattributes">attributes</a></code></pre><div class="info">
-Get the top-level attributes of a signature<br>
-</div>
-<br>
-LVALUES<br>
-<pre><span class="keyword">val</span> <a name="VALmakeVarinfo"></a>makeVarinfo : <code class="type">bool -> string -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a></code></pre><div class="info">
-Make a varinfo. Use this (rarely) to make a raw varinfo. Use other
- functions to make locals (<a href="Cil.html#VALmakeLocalVar"><code class="code">Cil.makeLocalVar</code></a> or <a href="Cil.html#VALmakeFormalVar"><code class="code">Cil.makeFormalVar</code></a> or
- <a href="Cil.html#VALmakeTempVar"><code class="code">Cil.makeTempVar</code></a>) and globals (<a href="Cil.html#VALmakeGlobalVar"><code class="code">Cil.makeGlobalVar</code></a>). Note that this
- function will assign a new identifier. The first argument specifies
- whether the varinfo is for a global.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmakeFormalVar"></a>makeFormalVar : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> ?where:string -> string -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a></code></pre><div class="info">
-Make a formal variable for a function. Insert it in both the sformals
- and the type of the function. You can optionally specify where to insert
- this one. If where = "^" then it is inserted first. If where = "$" then
- it is inserted last. Otherwise where must be the name of a formal after
- which to insert this. By default it is inserted at the end.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmakeLocalVar"></a>makeLocalVar : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> ?insert:bool -> string -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a></code></pre><div class="info">
-Make a local variable and add it to a function's slocals (only if insert =
- true, which is the default). Make sure you know what you are doing if you
- set insert=false.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmakeTempVar"></a>makeTempVar : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> ?name:string -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a></code></pre><div class="info">
-Make a temporary variable and add it to a function's slocals. The name of
- the temporary variable will be generated based on the given name hint so
- that to avoid conflicts with other locals.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmakeGlobalVar"></a>makeGlobalVar : <code class="type">string -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a></code></pre><div class="info">
-Make a global variable. Your responsibility to make sure that the name
- is unique<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcopyVarinfo"></a>copyVarinfo : <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> -> string -> <a href="Cil.html#TYPEvarinfo">varinfo</a></code></pre><div class="info">
-Make a shallow copy of a <code class="code">varinfo</code> and assign a new identifier<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALnewVID"></a>newVID : <code class="type">unit -> int</code></pre><div class="info">
-Generate a new variable ID. This will be different than any variable ID
- that is generated by <a href="Cil.html#VALmakeLocalVar"><code class="code">Cil.makeLocalVar</code></a> and friends<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALaddOffsetLval"></a>addOffsetLval : <code class="type"><a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPElval">lval</a> -> <a href="Cil.html#TYPElval">lval</a></code></pre><div class="info">
-Add an offset at the end of an lvalue. Make sure the type of the lvalue
- and the offset are compatible.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALaddOffset"></a>addOffset : <code class="type"><a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEoffset">offset</a></code></pre><div class="info">
-<code class="code">addOffset o1 o2</code> adds <code class="code">o1</code> to the end of <code class="code">o2</code>.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALremoveOffsetLval"></a>removeOffsetLval : <code class="type"><a href="Cil.html#TYPElval">lval</a> -> <a href="Cil.html#TYPElval">lval</a> * <a href="Cil.html#TYPEoffset">offset</a></code></pre><div class="info">
-Remove ONE offset from the end of an lvalue. Returns the lvalue with the
- trimmed offset and the final offset. If the final offset is <code class="code">NoOffset</code>
- then the original <code class="code">lval</code> did not have an offset.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALremoveOffset"></a>removeOffset : <code class="type"><a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEoffset">offset</a> * <a href="Cil.html#TYPEoffset">offset</a></code></pre><div class="info">
-Remove ONE offset from the end of an offset sequence. Returns the
- trimmed offset and the final offset. If the final offset is <code class="code">NoOffset</code>
- then the original <code class="code">lval</code> did not have an offset.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALtypeOfLval"></a>typeOfLval : <code class="type"><a href="Cil.html#TYPElval">lval</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-Compute the type of an lvalue<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALtypeOffset"></a>typeOffset : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-Compute the type of an offset from a base type<br>
-</div>
-<br>
-<b>Values for manipulating expressions</b><br>
-<pre><span class="keyword">val</span> <a name="VALzero"></a>zero : <code class="type"><a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
-0<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALone"></a>one : <code class="type"><a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
-1<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmone"></a>mone : <code class="type"><a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
--1<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALkinteger64"></a>kinteger64 : <code class="type"><a href="Cil.html#TYPEikind">ikind</a> -> int64 -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
-Construct an integer of a given kind, using OCaml's int64 type. If needed
- it will truncate the integer to be within the representable range for the
- given kind.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALkinteger"></a>kinteger : <code class="type"><a href="Cil.html#TYPEikind">ikind</a> -> int -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
-Construct an integer of a given kind. Converts the integer to int64 and
- then uses kinteger64. This might truncate the value if you use a kind
- that cannot represent the given integer. This can only happen for one of
- the Char or Short kinds<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALinteger"></a>integer : <code class="type">int -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
-Construct an integer of kind IInt. You can use this always since the
- OCaml integers are 31 bits and are guaranteed to fit in an IInt<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALisInteger"></a>isInteger : <code class="type"><a href="Cil.html#TYPEexp">exp</a> -> int64 option</code></pre><div class="info">
-True if the given expression is a (possibly cast'ed)
- character or an integer constant<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALisConstant"></a>isConstant : <code class="type"><a href="Cil.html#TYPEexp">exp</a> -> bool</code></pre><div class="info">
-True if the expression is a compile-time constant<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALisZero"></a>isZero : <code class="type"><a href="Cil.html#TYPEexp">exp</a> -> bool</code></pre><div class="info">
-True if the given expression is a (possibly cast'ed) integer or character
- constant with value zero<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcharConstToInt"></a>charConstToInt : <code class="type">char -> <a href="Cil.html#TYPEconstant">constant</a></code></pre><div class="info">
-Given the character c in a (CChr c), sign-extend it to 32 bits.
- (This is the official way of interpreting character constants, according to
- ISO C 6.4.4.4.10, which says that character constants are chars cast to ints)
- Returns CInt64(sign-extened c, IInt, None)<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALconstFold"></a>constFold : <code class="type">bool -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
-Do constant folding on an expression. If the first argument is true then
- will also compute compiler-dependent expressions such as sizeof<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALconstFoldBinOp"></a>constFoldBinOp : <code class="type">bool -> <a href="Cil.html#TYPEbinop">binop</a> -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
-Do constant folding on a binary operation. The bulk of the work done by
- <code class="code">constFold</code> is done here. If the first argument is true then
- will also compute compiler-dependent expressions such as sizeof<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALincrem"></a>increm : <code class="type"><a href="Cil.html#TYPEexp">exp</a> -> int -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
-Increment an expression. Can be arithmetic or pointer type<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALvar"></a>var : <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> -> <a href="Cil.html#TYPElval">lval</a></code></pre><div class="info">
-Makes an lvalue out of a given variable<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmkAddrOf"></a>mkAddrOf : <code class="type"><a href="Cil.html#TYPElval">lval</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
-Make an AddrOf. Given an lvalue of type T will give back an expression of
- type ptr(T). It optimizes somewhat expressions like "& v" and "& v<code class="code">0</code>"<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmkAddrOrStartOf"></a>mkAddrOrStartOf : <code class="type"><a href="Cil.html#TYPElval">lval</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
-Like mkAddrOf except if the type of lval is an array then it uses
- StartOf. This is the right operation for getting a pointer to the start
- of the storage denoted by lval.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmkMem"></a>mkMem : <code class="type">addr:<a href="Cil.html#TYPEexp">exp</a> -> off:<a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPElval">lval</a></code></pre><div class="info">
-Make a Mem, while optimizing AddrOf. The type of the addr must be
- TPtr(t) and the type of the resulting lval is t. Note that in CIL the
- implicit conversion between an array and the pointer to the first
- element does not apply. You must do the conversion yourself using
- StartOf<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmkString"></a>mkString : <code class="type">string -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
-Make an expression that is a string constant (of pointer type)<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmkCastT"></a>mkCastT : <code class="type">e:<a href="Cil.html#TYPEexp">exp</a> -> oldt:<a href="Cil.html#TYPEtyp">typ</a> -> newt:<a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
-Construct a cast when having the old type of the expression. If the new
- type is the same as the old type, then no cast is added.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmkCast"></a>mkCast : <code class="type">e:<a href="Cil.html#TYPEexp">exp</a> -> newt:<a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
-Like <a href="Cil.html#VALmkCastT"><code class="code">Cil.mkCastT</code></a> but uses typeOf to get <code class="code">oldt</code><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALstripCasts"></a>stripCasts : <code class="type"><a href="Cil.html#TYPEexp">exp</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
-Removes casts from this expression, but ignores casts within
- other expression constructs. So we delete the (A) and (B) casts from
- "(A)(B)(x + (C)y)", but leave the (C) cast.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALtypeOf"></a>typeOf : <code class="type"><a href="Cil.html#TYPEexp">exp</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-Compute the type of an expression<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALparseInt"></a>parseInt : <code class="type">string -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
-Convert a string representing a C integer literal to an expression.
- Handles the prefixes 0x and 0 and the suffixes L, U, UL, LL, ULL<br>
-</div>
-<br>
-<b>Values for manipulating statements</b><br>
-<pre><span class="keyword">val</span> <a name="VALmkStmt"></a>mkStmt : <code class="type"><a href="Cil.html#TYPEstmtkind">stmtkind</a> -> <a href="Cil.html#TYPEstmt">stmt</a></code></pre><div class="info">
-Construct a statement, given its kind. Initialize the <code class="code">sid</code> field to -1,
- and <code class="code">labels</code>, <code class="code">succs</code> and <code class="code">preds</code> to the empty list<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmkBlock"></a>mkBlock : <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> list -> <a href="Cil.html#TYPEblock">block</a></code></pre><div class="info">
-Construct a block with no attributes, given a list of statements<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmkStmtOneInstr"></a>mkStmtOneInstr : <code class="type"><a href="Cil.html#TYPEinstr">instr</a> -> <a href="Cil.html#TYPEstmt">stmt</a></code></pre><div class="info">
-Construct a statement consisting of just one instruction<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcompactStmts"></a>compactStmts : <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> list -> <a href="Cil.html#TYPEstmt">stmt</a> list</code></pre><div class="info">
-Try to compress statements so as to get maximal basic blocks<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmkEmptyStmt"></a>mkEmptyStmt : <code class="type">unit -> <a href="Cil.html#TYPEstmt">stmt</a></code></pre><div class="info">
-Returns an empty statement (of kind <code class="code">Instr</code>)<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdummyInstr"></a>dummyInstr : <code class="type"><a href="Cil.html#TYPEinstr">instr</a></code></pre><div class="info">
-A instr to serve as a placeholder<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdummyStmt"></a>dummyStmt : <code class="type"><a href="Cil.html#TYPEstmt">stmt</a></code></pre><div class="info">
-A statement consisting of just <code class="code">dummyInstr</code><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmkWhile"></a>mkWhile : <code class="type">guard:<a href="Cil.html#TYPEexp">exp</a> -> body:<a href="Cil.html#TYPEstmt">stmt</a> list -> <a href="Cil.html#TYPEstmt">stmt</a> list</code></pre><div class="info">
-Make a while loop. Can contain Break or Continue<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmkForIncr"></a>mkForIncr : <code class="type">iter:<a href="Cil.html#TYPEvarinfo">varinfo</a> -><br> first:<a href="Cil.html#TYPEexp">exp</a> -><br> stopat:<a href="Cil.html#TYPEexp">exp</a> -> incr:<a href="Cil.html#TYPEexp">exp</a> -> body:<a href="Cil.html#TYPEstmt">stmt</a> list -> <a href="Cil.html#TYPEstmt">stmt</a> list</code></pre><div class="info">
-Make a for loop for(i=start; i<past; i += incr) { ... }. The body
- can contain Break but not Continue. Can be used with i a pointer
- or an integer. Start and done must have the same type but incr
- must be an integer<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmkFor"></a>mkFor : <code class="type">start:<a href="Cil.html#TYPEstmt">stmt</a> list -><br> guard:<a href="Cil.html#TYPEexp">exp</a> -> next:<a href="Cil.html#TYPEstmt">stmt</a> list -> body:<a href="Cil.html#TYPEstmt">stmt</a> list -> <a href="Cil.html#TYPEstmt">stmt</a> list</code></pre><div class="info">
-Make a for loop for(start; guard; next) { ... }. The body can
- contain Break but not Continue !!!<br>
-</div>
-<br>
-<b>Values for manipulating attributes</b><br>
-<br><code><span class="keyword">type</span> <a name="TYPEattributeClass"></a><code class="type"></code>attributeClass = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">AttrName</span> <span class="keyword">of</span> <code class="type">bool</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Attribute of a name. If argument is true and we are on MSVC then
- the attribute is printed using __declspec as part of the storage
- specifier</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">AttrFunType</span> <span class="keyword">of</span> <code class="type">bool</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Attribute of a function type. If argument is true and we are on
- MSVC then the attribute is printed just before the function name</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">AttrType</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Attribute of a type</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-<div class="info">
-Various classes of attributes<br>
-</div>
-
-<pre><span class="keyword">val</span> <a name="VALattributeHash"></a>attributeHash : <code class="type">(string, <a href="Cil.html#TYPEattributeClass">attributeClass</a>) Hashtbl.t</code></pre><div class="info">
-This table contains the mapping of predefined attributes to classes.
- Extend this table with more attributes as you need. This table is used to
- determine how to associate attributes with names or types<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALpartitionAttributes"></a>partitionAttributes : <code class="type">default:<a href="Cil.html#TYPEattributeClass">attributeClass</a> -><br> <a href="Cil.html#TYPEattributes">attributes</a> -><br> <a href="Cil.html#TYPEattribute">attribute</a> list * <a href="Cil.html#TYPEattribute">attribute</a> list * <a href="Cil.html#TYPEattribute">attribute</a> list</code></pre><div class="info">
-Partition the attributes into classes:name attributes, function type,
- and type attributes<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALaddAttribute"></a>addAttribute : <code class="type"><a href="Cil.html#TYPEattribute">attribute</a> -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEattributes">attributes</a></code></pre><div class="info">
-Add an attribute. Maintains the attributes in sorted order of the second
- argument<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALaddAttributes"></a>addAttributes : <code class="type"><a href="Cil.html#TYPEattribute">attribute</a> list -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEattributes">attributes</a></code></pre><div class="info">
-Add a list of attributes. Maintains the attributes in sorted order. The
- second argument must be sorted, but not necessarily the first<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdropAttribute"></a>dropAttribute : <code class="type">string -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEattributes">attributes</a></code></pre><div class="info">
-Remove all attributes with the given name. Maintains the attributes in
- sorted order.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdropAttributes"></a>dropAttributes : <code class="type">string list -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEattributes">attributes</a></code></pre><div class="info">
-Remove all attributes with names appearing in the string list.
- Maintains the attributes in sorted order<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALfilterAttributes"></a>filterAttributes : <code class="type">string -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEattributes">attributes</a></code></pre><div class="info">
-Retains attributes with the given name<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALhasAttribute"></a>hasAttribute : <code class="type">string -> <a href="Cil.html#TYPEattributes">attributes</a> -> bool</code></pre><div class="info">
-True if the named attribute appears in the attribute list. The list of
- attributes must be sorted.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALtypeAttrs"></a>typeAttrs : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEattribute">attribute</a> list</code></pre><div class="info">
-Returns all the attributes contained in a type. This requires a traversal
- of the type structure, in case of composite, enumeration and named types<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALsetTypeAttrs"></a>setTypeAttrs : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><pre><span class="keyword">val</span> <a name="VALtypeAddAttributes"></a>typeAddAttributes : <code class="type"><a href="Cil.html#TYPEattribute">attribute</a> list -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-Add some attributes to a type<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALtypeRemoveAttributes"></a>typeRemoveAttributes : <code class="type">string list -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-Remove all attributes with the given names from a type. Note that this
- does not remove attributes from typedef and tag definitions, just from
- their uses<br>
-</div>
-<br>
-<b>The visitor</b><br>
-<br><code><span class="keyword">type</span> <a name="TYPEvisitAction"></a><code class="type">'a</code> visitAction = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">SkipChildren</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Do not visit the children. Return
- the node as it is.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">DoChildren</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Continue with the children of this
- node. Rebuild the node on return
- if any of the children changes
- (use == test)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">ChangeTo</span> <span class="keyword">of</span> <code class="type">'a</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Replace the expression with the
- given one</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">ChangeDoChildrenPost</span> <span class="keyword">of</span> <code class="type">'a * ('a -> 'a)</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>First consider that the entire
- exp is replaced by the first
- parameter. Then continue with
- the children. On return rebuild
- the node if any of the children
- has changed and then apply the
- function on the node</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-<div class="info">
-Different visiting actions. 'a will be instantiated with <code class="code">exp</code>, <code class="code">instr</code>,
- etc.<br>
-</div>
-
-<pre><span class="keyword">class type</span> <a name="TYPEcilVisitor"></a><a href="Cil.cilVisitor.html">cilVisitor</a> = <code class="code">object</code> <a href="Cil.cilVisitor.html">..</a> <code class="code">end</code></pre><div class="info">
-A visitor interface for traversing CIL trees.
-</div>
-<pre><span class="keyword">class</span> <a name="TYPEnopCilVisitor"></a><a href="Cil.nopCilVisitor.html">nopCilVisitor</a> : <code class="type"></code><code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a></code></pre><div class="info">
-Default Visitor.
-</div>
-<pre><span class="keyword">val</span> <a name="VALvisitCilFile"></a>visitCilFile : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEfile">file</a> -> unit</code></pre><div class="info">
-Visit a file. This will will re-cons all globals TWICE (so that it is
- tail-recursive). Use <a href="Cil.html#VALvisitCilFileSameGlobals"><code class="code">Cil.visitCilFileSameGlobals</code></a> if your visitor will
- not change the list of globals.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALvisitCilFileSameGlobals"></a>visitCilFileSameGlobals : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEfile">file</a> -> unit</code></pre><div class="info">
-A visitor for the whole file that does not change the globals (but maybe
- changes things inside the globals). Use this function instead of
- <a href="Cil.html#VALvisitCilFile"><code class="code">Cil.visitCilFile</code></a> whenever appropriate because it is more efficient for
- long files.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALvisitCilGlobal"></a>visitCilGlobal : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEglobal">global</a> -> <a href="Cil.html#TYPEglobal">global</a> list</code></pre><div class="info">
-Visit a global<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALvisitCilFunction"></a>visitCilFunction : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEfundec">fundec</a> -> <a href="Cil.html#TYPEfundec">fundec</a></code></pre><div class="info">
-Visit a function definition<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALvisitCilExpr"></a>visitCilExpr : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><pre><span class="keyword">val</span> <a name="VALvisitCilLval"></a>visitCilLval : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPElval">lval</a> -> <a href="Cil.html#TYPElval">lval</a></code></pre><div class="info">
-Visit an lvalue<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALvisitCilOffset"></a>visitCilOffset : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEoffset">offset</a></code></pre><div class="info">
-Visit an lvalue or recursive offset<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALvisitCilInitOffset"></a>visitCilInitOffset : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEoffset">offset</a></code></pre><div class="info">
-Visit an initializer offset<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALvisitCilInstr"></a>visitCilInstr : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEinstr">instr</a> -> <a href="Cil.html#TYPEinstr">instr</a> list</code></pre><div class="info">
-Visit an instruction<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALvisitCilStmt"></a>visitCilStmt : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEstmt">stmt</a> -> <a href="Cil.html#TYPEstmt">stmt</a></code></pre><div class="info">
-Visit a statement<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALvisitCilBlock"></a>visitCilBlock : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEblock">block</a> -> <a href="Cil.html#TYPEblock">block</a></code></pre><div class="info">
-Visit a block<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALvisitCilType"></a>visitCilType : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
-Visit a type<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALvisitCilVarDecl"></a>visitCilVarDecl : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a></code></pre><div class="info">
-Visit a variable declaration<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALvisitCilInit"></a>visitCilInit : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEinit">init</a> -> <a href="Cil.html#TYPEinit">init</a></code></pre><div class="info">
-Visit an initializer<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALvisitCilAttributes"></a>visitCilAttributes : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEattribute">attribute</a> list -> <a href="Cil.html#TYPEattribute">attribute</a> list</code></pre><div class="info">
-Visit a list of attributes<br>
-</div>
-<br>
-<b>Utility functions</b><br>
-<pre><span class="keyword">val</span> <a name="VALmsvcMode"></a>msvcMode : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-Whether the pretty printer should print output for the MS VC compiler.
- Default is GCC. After you set this function you should call <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a>.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALuseLogicalOperators"></a>useLogicalOperators : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-Whether to use the logical operands LAnd and LOr. By default, do not use
- them because they are unlike other expressions and do not evaluate both of
- their operands<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALconstFoldVisitor"></a>constFoldVisitor : <code class="type">bool -> <a href="Cil.cilVisitor.html">cilVisitor</a></code></pre><div class="info">
-A visitor that does constant folding. Pass as argument whether you want
- machine specific simplifications to be done, or not.<br>
-</div>
-<br><code><span class="keyword">type</span> <a name="TYPElineDirectiveStyle"></a><code class="type"></code>lineDirectiveStyle = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">LineComment</span></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">LinePreprocessorInput</span></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">LinePreprocessorOutput</span></code></td>
-
-</tr></table>
-
-<div class="info">
-Styles of printing line directives<br>
-</div>
-
-<pre><span class="keyword">val</span> <a name="VALlineDirectiveStyle"></a>lineDirectiveStyle : <code class="type"><a href="Cil.html#TYPElineDirectiveStyle">lineDirectiveStyle</a> option Pervasives.ref</code></pre><div class="info">
-How to print line directives<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALprint_CIL_Input"></a>print_CIL_Input : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-Whether we print something that will only be used as input to our own
- parser. In that case we are a bit more liberal in what we print<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALprintCilAsIs"></a>printCilAsIs : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-Whether to print the CIL as they are, without trying to be smart and
- print nicer code. Normally this is false, in which case the pretty
- printer will turn the while(1) loops of CIL into nicer loops, will not
- print empty "else" blocks, etc. These is one case howewer in which if you
- turn this on you will get code that does not compile: if you use varargs
- the __builtin_va_arg function will be printed in its internal form.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALlineLength"></a>lineLength : <code class="type">int Pervasives.ref</code></pre><div class="info">
-The length used when wrapping output lines. Setting this variable to
- a large integer will prevent wrapping and make #line directives more
- accurate.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALforgcc"></a>forgcc : <code class="type">string -> string</code></pre><div class="info">
-Return the string 's' if we're printing output for gcc, suppres
- it if we're printing for CIL to parse back in. the purpose is to
- hide things from gcc that it complains about, but still be able
- to do lossless transformations when CIL is the consumer<br>
-</div>
-<br>
-<b>Debugging support</b><br>
-<pre><span class="keyword">val</span> <a name="VALcurrentLoc"></a>currentLoc : <code class="type"><a href="Cil.html#TYPElocation">location</a> Pervasives.ref</code></pre><div class="info">
-A reference to the current location. If you are careful to set this to
- the current location then you can use some built-in logging functions that
- will print the location.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcurrentGlobal"></a>currentGlobal : <code class="type"><a href="Cil.html#TYPEglobal">global</a> Pervasives.ref</code></pre><div class="info">
-A reference to the current global being visited<br>
-</div>
-<br>
-CIL has a fairly easy to use mechanism for printing error messages. This
- mechanism is built on top of the pretty-printer mechanism (see
- <a href="Pretty.html#TYPEdoc"><code class="code">Pretty.doc</code></a>) and the error-message modules (see <a href="Errormsg.html#VALerror"><code class="code">Errormsg.error</code></a>).
-<p>
-
- Here is a typical example for printing a log message: <pre>
-ignore (Errormsg.log "Expression %a is not positive (at %s:%i)\n"
- d_exp e loc.file loc.line)
-</pre>
-<p>
-
- and here is an example of how you print a fatal error message that stop the
- execution: <pre>
-Errormsg.s (Errormsg.bug "Why am I here?")
-</pre>
-<p>
-
- Notice that you can use C format strings with some extension. The most
-useful extension is "%a" that means to consumer the next two argument from
-the argument list and to apply the first to <code class="code">unit</code> and then to the second
-and to print the resulting <a href="Pretty.html#TYPEdoc"><code class="code">Pretty.doc</code></a>. For each major type in CIL there is
-a corresponding function that pretty-prints an element of that type:<br>
-<pre><span class="keyword">val</span> <a name="VALd_loc"></a>d_loc : <code class="type">unit -> <a href="Cil.html#TYPElocation">location</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print a location<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_thisloc"></a>d_thisloc : <code class="type">unit -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print the <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_ikind"></a>d_ikind : <code class="type">unit -> <a href="Cil.html#TYPEikind">ikind</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print an integer of a given kind<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_fkind"></a>d_fkind : <code class="type">unit -> <a href="Cil.html#TYPEfkind">fkind</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print a floating-point kind<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_storage"></a>d_storage : <code class="type">unit -> <a href="Cil.html#TYPEstorage">storage</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print storage-class information<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_const"></a>d_const : <code class="type">unit -> <a href="Cil.html#TYPEconstant">constant</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print a constant<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALderefStarLevel"></a>derefStarLevel : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALindexLevel"></a>indexLevel : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALarrowLevel"></a>arrowLevel : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALaddrOfLevel"></a>addrOfLevel : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALadditiveLevel"></a>additiveLevel : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALcomparativeLevel"></a>comparativeLevel : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALbitwiseLevel"></a>bitwiseLevel : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALgetParenthLevel"></a>getParenthLevel : <code class="type"><a href="Cil.html#TYPEexp">exp</a> -> int</code></pre><div class="info">
-Parentheses level. An expression "a op b" is printed parenthesized if its
- parentheses level is >= that that of its context. Identifiers have the
- lowest level and weakly binding operators (e.g. |) have the largest level.
- The correctness criterion is that a smaller level MUST correspond to a
- stronger precedence!<br>
-</div>
-<pre><span class="keyword">class type</span> <a name="TYPEcilPrinter"></a><a href="Cil.cilPrinter.html">cilPrinter</a> = <code class="code">object</code> <a href="Cil.cilPrinter.html">..</a> <code class="code">end</code></pre><div class="info">
-A printer interface for CIL trees.
-</div>
-<pre><span class="keyword">class</span> <a name="TYPEdefaultCilPrinterClass"></a><a href="Cil.defaultCilPrinterClass.html">defaultCilPrinterClass</a> : <code class="type"></code><code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a></code></pre><pre><span class="keyword">val</span> <a name="VALdefaultCilPrinter"></a>defaultCilPrinter : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a></code></pre><pre><span class="keyword">class</span> <a name="TYPEplainCilPrinterClass"></a><a href="Cil.plainCilPrinterClass.html">plainCilPrinterClass</a> : <code class="type"></code><code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a></code></pre><div class="info">
-These are pretty-printers that will show you more details on the internal
- CIL representation, without trying hard to make it look like C
-</div>
-<pre><span class="keyword">val</span> <a name="VALplainCilPrinter"></a>plainCilPrinter : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a></code></pre><pre><span class="keyword">val</span> <a name="VALprinterForMaincil"></a>printerForMaincil : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> Pervasives.ref</code></pre><pre><span class="keyword">val</span> <a name="VALprintType"></a>printType : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Print a type given a pretty printer<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALprintExp"></a>printExp : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Print an expression given a pretty printer<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALprintLval"></a>printLval : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPElval">lval</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Print an lvalue given a pretty printer<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALprintGlobal"></a>printGlobal : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEglobal">global</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Print a global given a pretty printer<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALprintAttr"></a>printAttr : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEattribute">attribute</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Print an attribute given a pretty printer<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALprintAttrs"></a>printAttrs : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Print a set of attributes given a pretty printer<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALprintInstr"></a>printInstr : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEinstr">instr</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Print an instruction given a pretty printer<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALprintStmt"></a>printStmt : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEstmt">stmt</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Print a statement given a pretty printer. This can take very long
- (or even overflow the stack) for huge statements. Use <a href="Cil.html#VALdumpStmt"><code class="code">Cil.dumpStmt</code></a>
- instead.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALprintBlock"></a>printBlock : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEblock">block</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Print a block given a pretty printer. This can take very long
- (or even overflow the stack) for huge block. Use <a href="Cil.html#VALdumpBlock"><code class="code">Cil.dumpBlock</code></a>
- instead.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdumpStmt"></a>dumpStmt : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> Pervasives.out_channel -> int -> <a href="Cil.html#TYPEstmt">stmt</a> -> unit</code></pre><div class="info">
-Dump a statement to a file using a given indentation. Use this instead of
- <a href="Cil.html#VALprintStmt"><code class="code">Cil.printStmt</code></a> whenever possible.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdumpBlock"></a>dumpBlock : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> Pervasives.out_channel -> int -> <a href="Cil.html#TYPEblock">block</a> -> unit</code></pre><div class="info">
-Dump a block to a file using a given indentation. Use this instead of
- <a href="Cil.html#VALprintBlock"><code class="code">Cil.printBlock</code></a> whenever possible.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALprintInit"></a>printInit : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEinit">init</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Print an initializer given a pretty printer. This can take very long
- (or even overflow the stack) for huge initializers. Use <a href="Cil.html#VALdumpInit"><code class="code">Cil.dumpInit</code></a>
- instead.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdumpInit"></a>dumpInit : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> Pervasives.out_channel -> int -> <a href="Cil.html#TYPEinit">init</a> -> unit</code></pre><div class="info">
-Dump an initializer to a file using a given indentation. Use this instead of
- <a href="Cil.html#VALprintInit"><code class="code">Cil.printInit</code></a> whenever possible.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_type"></a>d_type : <code class="type">unit -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print a type using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_exp"></a>d_exp : <code class="type">unit -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print an expression using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_lval"></a>d_lval : <code class="type">unit -> <a href="Cil.html#TYPElval">lval</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print an lvalue using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_offset"></a>d_offset : <code class="type"><a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> unit -> <a href="Cil.html#TYPEoffset">offset</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print an offset using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>, given the pretty
- printing for the base.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_init"></a>d_init : <code class="type">unit -> <a href="Cil.html#TYPEinit">init</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print an initializer using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>. This can be
- extremely slow (or even overflow the stack) for huge initializers. Use
- <a href="Cil.html#VALdumpInit"><code class="code">Cil.dumpInit</code></a> instead.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_binop"></a>d_binop : <code class="type">unit -> <a href="Cil.html#TYPEbinop">binop</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print a binary operator<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_unop"></a>d_unop : <code class="type">unit -> <a href="Cil.html#TYPEunop">unop</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print a unary operator<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_attr"></a>d_attr : <code class="type">unit -> <a href="Cil.html#TYPEattribute">attribute</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print an attribute using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_attrparam"></a>d_attrparam : <code class="type">unit -> <a href="Cil.html#TYPEattrparam">attrparam</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print an argument of an attribute using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_attrlist"></a>d_attrlist : <code class="type">unit -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print a list of attributes using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_instr"></a>d_instr : <code class="type">unit -> <a href="Cil.html#TYPEinstr">instr</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print an instruction using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_label"></a>d_label : <code class="type">unit -> <a href="Cil.html#TYPElabel">label</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print a label using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_stmt"></a>d_stmt : <code class="type">unit -> <a href="Cil.html#TYPEstmt">stmt</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print a statement using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>. This can be
- extremely slow (or even overflow the stack) for huge statements. Use
- <a href="Cil.html#VALdumpStmt"><code class="code">Cil.dumpStmt</code></a> instead.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_block"></a>d_block : <code class="type">unit -> <a href="Cil.html#TYPEblock">block</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print a block using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>. This can be
- extremely slow (or even overflow the stack) for huge blocks. Use
- <a href="Cil.html#VALdumpBlock"><code class="code">Cil.dumpBlock</code></a> instead.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_global"></a>d_global : <code class="type">unit -> <a href="Cil.html#TYPEglobal">global</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print the internal representation of a global using
- <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>. This can be extremely slow (or even overflow the
- stack) for huge globals (such as arrays with lots of initializers). Use
- <a href="Cil.html#VALdumpGlobal"><code class="code">Cil.dumpGlobal</code></a> instead.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdn_exp"></a>dn_exp : <code class="type">unit -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Versions of the above pretty printers, that don't print #line directives<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdn_lval"></a>dn_lval : <code class="type">unit -> <a href="Cil.html#TYPElval">lval</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALdn_init"></a>dn_init : <code class="type">unit -> <a href="Cil.html#TYPEinit">init</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALdn_type"></a>dn_type : <code class="type">unit -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALdn_global"></a>dn_global : <code class="type">unit -> <a href="Cil.html#TYPEglobal">global</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALdn_attrlist"></a>dn_attrlist : <code class="type">unit -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALdn_attr"></a>dn_attr : <code class="type">unit -> <a href="Cil.html#TYPEattribute">attribute</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALdn_attrparam"></a>dn_attrparam : <code class="type">unit -> <a href="Cil.html#TYPEattrparam">attrparam</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALdn_stmt"></a>dn_stmt : <code class="type">unit -> <a href="Cil.html#TYPEstmt">stmt</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALdn_instr"></a>dn_instr : <code class="type">unit -> <a href="Cil.html#TYPEinstr">instr</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALd_shortglobal"></a>d_shortglobal : <code class="type">unit -> <a href="Cil.html#TYPEglobal">global</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print a short description of the global. This is useful for error
- messages<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdumpGlobal"></a>dumpGlobal : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> Pervasives.out_channel -> <a href="Cil.html#TYPEglobal">global</a> -> unit</code></pre><div class="info">
-Pretty-print a global. Here you give the channel where the printout
- should be sent.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdumpFile"></a>dumpFile : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> Pervasives.out_channel -> string -> <a href="Cil.html#TYPEfile">file</a> -> unit</code></pre><div class="info">
-Pretty-print an entire file. Here you give the channel where the printout
- should be sent.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALbug"></a>bug : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
-Like <a href="Errormsg.html#VALbug"><code class="code">Errormsg.bug</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is also printed<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALunimp"></a>unimp : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
-Like <a href="Errormsg.html#VALunimp"><code class="code">Errormsg.unimp</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a>is also printed<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALerror"></a>error : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
-Like <a href="Errormsg.html#VALerror"><code class="code">Errormsg.error</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is also printed<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALerrorLoc"></a>errorLoc : <code class="type"><a href="Cil.html#TYPElocation">location</a> -> ('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
-Like <a href="Cil.html#VALerror"><code class="code">Cil.error</code></a> except that it explicitly takes a location argument,
- instead of using the <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALwarn"></a>warn : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
-Like <a href="Errormsg.html#VALwarn"><code class="code">Errormsg.warn</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is also printed<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALwarnOpt"></a>warnOpt : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
-Like <a href="Errormsg.html#VALwarnOpt"><code class="code">Errormsg.warnOpt</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is also printed.
- This warning is printed only of <a href="Errormsg.html#VALwarnFlag"><code class="code">Errormsg.warnFlag</code></a> is set.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALwarnContext"></a>warnContext : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
-Like <a href="Errormsg.html#VALwarn"><code class="code">Errormsg.warn</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> and context
- is also printed<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALwarnContextOpt"></a>warnContextOpt : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
-Like <a href="Errormsg.html#VALwarn"><code class="code">Errormsg.warn</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> and context is also
- printed. This warning is printed only of <a href="Errormsg.html#VALwarnFlag"><code class="code">Errormsg.warnFlag</code></a> is set.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALwarnLoc"></a>warnLoc : <code class="type"><a href="Cil.html#TYPElocation">location</a> -> ('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
-Like <a href="Cil.html#VALwarn"><code class="code">Cil.warn</code></a> except that it explicitly takes a location argument,
- instead of using the <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a><br>
-</div>
-<br>
-Sometimes you do not want to see the syntactic sugar that the above
- pretty-printing functions add. In that case you can use the following
- pretty-printing functions. But note that the output of these functions is
- not valid C<br>
-<pre><span class="keyword">val</span> <a name="VALd_plainexp"></a>d_plainexp : <code class="type">unit -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print the internal representation of an expression<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_plaininit"></a>d_plaininit : <code class="type">unit -> <a href="Cil.html#TYPEinit">init</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print the internal representation of an integer<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_plainlval"></a>d_plainlval : <code class="type">unit -> <a href="Cil.html#TYPElval">lval</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print the internal representation of an lvalue<br>
-</div>
-<br>
-Pretty-print the internal representation of an lvalue offset
-val d_plainoffset: unit -> offset -> Pretty.doc<br>
-<pre><span class="keyword">val</span> <a name="VALd_plaintype"></a>d_plaintype : <code class="type">unit -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print the internal representation of a type<br>
-</div>
-<br>
-<b>ALPHA conversion</b> has been moved to the Alpha module.<br>
-<pre><span class="keyword">val</span> <a name="VALuniqueVarNames"></a>uniqueVarNames : <code class="type"><a href="Cil.html#TYPEfile">file</a> -> unit</code></pre><div class="info">
-Assign unique names to local variables. This might be necessary after you
- transformed the code and added or renamed some new variables. Names are
- not used by CIL internally, but once you print the file out the compiler
- downstream might be confused. You might
- have added a new global that happens to have the same name as a local in
- some function. Rename the local to ensure that there would never be
- confusioin. Or, viceversa, you might have added a local with a name that
- conflicts with a global<br>
-</div>
-<br>
-<b>Optimization Passes</b><br>
-<pre><span class="keyword">val</span> <a name="VALpeepHole2"></a>peepHole2 : <code class="type">(<a href="Cil.html#TYPEinstr">instr</a> * <a href="Cil.html#TYPEinstr">instr</a> -> <a href="Cil.html#TYPEinstr">instr</a> list option) -> <a href="Cil.html#TYPEstmt">stmt</a> list -> unit</code></pre><div class="info">
-A peephole optimizer that processes two adjacent statements and possibly
- replaces them both. If some replacement happens, then the new statements
- are themselves subject to optimization<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALpeepHole1"></a>peepHole1 : <code class="type">(<a href="Cil.html#TYPEinstr">instr</a> -> <a href="Cil.html#TYPEinstr">instr</a> list option) -> <a href="Cil.html#TYPEstmt">stmt</a> list -> unit</code></pre><div class="info">
-Similar to <code class="code">peepHole2</code> except that the optimization window consists of
- one statement, not two<br>
-</div>
-<br>
-<b>Machine dependency</b><br>
-<pre><span class="keyword">exception</span> <a name="EXCEPTIONSizeOfError"></a>SizeOfError <span class="keyword">of</span> <code class="type">string * <a href="Cil.html#TYPEtyp">typ</a></code></pre>
-<div class="info">
-Raised when one of the bitsSizeOf functions cannot compute the size of a
- type. This can happen because the type contains array-length expressions
- that we don't know how to compute or because it is a type whose size is
- not defined (e.g. TFun or an undefined compinfo). The string is an
- explanation of the error<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALbitsSizeOf"></a>bitsSizeOf : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> int</code></pre><div class="info">
-The size of a type, in bits. Trailing padding is added for structs and
- arrays. Raises <a href="Cil.html#EXCEPTIONSizeOfError"><code class="code">Cil.SizeOfError</code></a> when it cannot compute the size. This
- function is architecture dependent, so you should only call this after you
- call <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a>. Remember that on GCC sizeof(void) is 1!<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALsizeOf"></a>sizeOf : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><pre><span class="keyword">val</span> <a name="VALalignOf_int"></a>alignOf_int : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> int</code></pre><div class="info">
-The minimum alignment (in bytes) for a type. This function is
- architecture dependent, so you should only call this after you call
- <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a>.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALbitsOffset"></a>bitsOffset : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEoffset">offset</a> -> int * int</code></pre><div class="info">
-Give a type of a base and an offset, returns the number of bits from the
- base address and the width (also expressed in bits) for the subobject
- denoted by the offset. Raises <a href="Cil.html#EXCEPTIONSizeOfError"><code class="code">Cil.SizeOfError</code></a> when it cannot compute
- the size. This function is architecture dependent, so you should only call
- this after you call <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a>.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALchar_is_unsigned"></a>char_is_unsigned : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-Whether "char" is unsigned. Set after you call <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALlittle_endian"></a>little_endian : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-Whether the machine is little endian. Set after you call <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALunderscore_name"></a>underscore_name : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-Whether the compiler generates assembly labels by prepending "_" to the
- identifier. That is, will function foo() have the label "foo", or "_foo"?
- Set after you call <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALlocUnknown"></a>locUnknown : <code class="type"><a href="Cil.html#TYPElocation">location</a></code></pre><div class="info">
-Represents a location that cannot be determined<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALget_instrLoc"></a>get_instrLoc : <code class="type"><a href="Cil.html#TYPEinstr">instr</a> -> <a href="Cil.html#TYPElocation">location</a></code></pre><div class="info">
-Return the location of an instruction<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALget_globalLoc"></a>get_globalLoc : <code class="type"><a href="Cil.html#TYPEglobal">global</a> -> <a href="Cil.html#TYPElocation">location</a></code></pre><div class="info">
-Return the location of a global, or locUnknown<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALget_stmtLoc"></a>get_stmtLoc : <code class="type"><a href="Cil.html#TYPEstmtkind">stmtkind</a> -> <a href="Cil.html#TYPElocation">location</a></code></pre><div class="info">
-Return the location of a statement, or locUnknown<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdExp"></a>dExp : <code class="type"><a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
-Generate an <a href="Cil.html#TYPEexp"><code class="code">Cil.exp</code></a> to be used in case of errors.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdInstr"></a>dInstr : <code class="type"><a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> <a href="Cil.html#TYPElocation">location</a> -> <a href="Cil.html#TYPEinstr">instr</a></code></pre><div class="info">
-Generate an <a href="Cil.html#TYPEinstr"><code class="code">Cil.instr</code></a> to be used in case of errors.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdGlobal"></a>dGlobal : <code class="type"><a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> <a href="Cil.html#TYPElocation">location</a> -> <a href="Cil.html#TYPEglobal">global</a></code></pre><div class="info">
-Generate a <a href="Cil.html#TYPEglobal"><code class="code">Cil.global</code></a> to be used in case of errors.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmapNoCopy"></a>mapNoCopy : <code class="type">('a -> 'a) -> 'a list -> 'a list</code></pre><div class="info">
-Like map but try not to make a copy of the list<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmapNoCopyList"></a>mapNoCopyList : <code class="type">('a -> 'a list) -> 'a list -> 'a list</code></pre><div class="info">
-Like map but each call can return a list. Try not to make a copy of the
- list<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALstartsWith"></a>startsWith : <code class="type">string -> string -> bool</code></pre><div class="info">
-sm: return true if the first is a prefix of the second string<br>
-</div>
-<br>
-<b>An Interpreter for constructing CIL constructs</b><br>
-<br><code><span class="keyword">type</span> <a name="TYPEformatArg"></a><code class="type"></code>formatArg = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Fe</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Feo</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a> option</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>For array lengths</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Fu</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEunop">unop</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Fb</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEbinop">binop</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Fk</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEikind">ikind</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">FE</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a> list</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>For arguments in a function call</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Ff</span> <span class="keyword">of</span> <code class="type">(string * <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEattributes">attributes</a>)</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>For a formal argument</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">FF</span> <span class="keyword">of</span> <code class="type">(string * <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEattributes">attributes</a>) list</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>For formal argument lists</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Fva</span> <span class="keyword">of</span> <code class="type">bool</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>For the ellipsis in a function type</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Fv</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Fl</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElval">lval</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Flo</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElval">lval</a> option</code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Fo</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEoffset">offset</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Fc</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEcompinfo">compinfo</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Fi</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEinstr">instr</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">FI</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEinstr">instr</a> list</code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Ft</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Fd</span> <span class="keyword">of</span> <code class="type">int</code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Fg</span> <span class="keyword">of</span> <code class="type">string</code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Fs</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEstmt">stmt</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">FS</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> list</code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">FA</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Fp</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattrparam">attrparam</a></code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">FP</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattrparam">attrparam</a> list</code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">FX</span> <span class="keyword">of</span> <code class="type">string</code></code></td>
-
-</tr></table>
-
-<div class="info">
-The type of argument for the interpreter<br>
-</div>
-
-<pre><span class="keyword">val</span> <a name="VALd_formatarg"></a>d_formatarg : <code class="type">unit -> <a href="Cil.html#TYPEformatArg">formatArg</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-prints a format arg<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALlowerConstants"></a>lowerConstants : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-Do lower constant expressions into constants (default true)<br>
-</div>
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Cil.nopCilVisitor.html b/cil/doc/api/Cil.nopCilVisitor.html
deleted file mode 100644
index 868e79d4b5b1cfc9fc40c9c91d7b47a8adfbe890..0000000000000000000000000000000000000000
--- a/cil/doc/api/Cil.nopCilVisitor.html
+++ /dev/null
@@ -1,35 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="next" href="Cil.defaultCilPrinterClass.html">
-<link rel="Up" href="Cil.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.nopCilVisitor</title>
-</head>
-<body>
-<div class="navbar"> <a href="Cil.html">Up</a>
- <a href="Cil.defaultCilPrinterClass.html">Next</a>
-</div>
-<center><h1>Class <a href="type_Cil.nopCilVisitor.html">Cil.nopCilVisitor</a></h1></center>
-<br>
-<pre><span class="keyword">class</span> <a name="TYPEnopCilVisitor"></a>nopCilVisitor : <code class="type"></code><code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a></code></pre>Default Visitor. Traverses the CIL tree without modifying anything<br>
-<hr width="100%">
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Cil.plainCilPrinterClass.html b/cil/doc/api/Cil.plainCilPrinterClass.html
deleted file mode 100644
index 0d5fca5841b12d7a4c19b1dd54f2fa58462e6f5d..0000000000000000000000000000000000000000
--- a/cil/doc/api/Cil.plainCilPrinterClass.html
+++ /dev/null
@@ -1,36 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="previous" href="Cil.defaultCilPrinterClass.html">
-<link rel="Up" href="Cil.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.plainCilPrinterClass</title>
-</head>
-<body>
-<div class="navbar"><a href="Cil.defaultCilPrinterClass.html">Previous</a>
- <a href="Cil.html">Up</a>
- </div>
-<center><h1>Class <a href="type_Cil.plainCilPrinterClass.html">Cil.plainCilPrinterClass</a></h1></center>
-<br>
-<pre><span class="keyword">class</span> <a name="TYPEplainCilPrinterClass"></a>plainCilPrinterClass : <code class="type"></code><code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a></code></pre>These are pretty-printers that will show you more details on the internal
- CIL representation, without trying hard to make it look like C<br>
-<hr width="100%">
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Cillower.html b/cil/doc/api/Cillower.html
deleted file mode 100644
index d8fa8ddd3cc70d05b2cb6a70822e07fb88a77443..0000000000000000000000000000000000000000
--- a/cil/doc/api/Cillower.html
+++ /dev/null
@@ -1,40 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="previous" href="Alpha.html">
-<link rel="next" href="Cfg.html">
-<link rel="Up" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cillower</title>
-</head>
-<body>
-<div class="navbar"><a href="Alpha.html">Previous</a>
- <a href="index.html">Up</a>
- <a href="Cfg.html">Next</a>
-</div>
-<center><h1>Module <a href="type_Cillower.html">Cillower</a></h1></center>
-<br>
-<pre><span class="keyword">module</span> Cillower: <code class="code">sig</code> <a href="Cillower.html">..</a> <code class="code">end</code></pre>A number of lowering passes over CIL<br>
-<hr width="100%">
-<pre><span class="keyword">val</span> <a name="VALlowerEnumVisitor"></a>lowerEnumVisitor : <code class="type"><a href="Cil.cilVisitor.html">Cil.cilVisitor</a></code></pre><div class="info">
-Replace enumeration constants with integer constants<br>
-</div>
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Clist.html b/cil/doc/api/Clist.html
deleted file mode 100644
index 27f373e50499e34658aa3483f51f4d43a0e9a61f..0000000000000000000000000000000000000000
--- a/cil/doc/api/Clist.html
+++ /dev/null
@@ -1,118 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="previous" href="Errormsg.html">
-<link rel="next" href="Stats.html">
-<link rel="Up" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Clist</title>
-</head>
-<body>
-<div class="navbar"><a href="Errormsg.html">Previous</a>
- <a href="index.html">Up</a>
- <a href="Stats.html">Next</a>
-</div>
-<center><h1>Module <a href="type_Clist.html">Clist</a></h1></center>
-<br>
-<pre><span class="keyword">module</span> Clist: <code class="code">sig</code> <a href="Clist.html">..</a> <code class="code">end</code></pre>Utilities for managing "concatenable lists" (clists). We often need to
- concatenate sequences, and using lists for this purpose is expensive. This
- module provides routines to manage such lists more efficiently. In this
- model, we never do cons or append explicitly. Instead we maintain
- the elements of the list in a special data structure. Routines are provided
- to convert to/from ordinary lists, and carry out common list operations.<br>
-<hr width="100%">
-<br><code><span class="keyword">type</span> <a name="TYPEclist"></a><code class="type">'a</code> clist = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">CList</span> <span class="keyword">of</span> <code class="type">'a list</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The only representation for the empty
- list. Try to use sparingly.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">CConsL</span> <span class="keyword">of</span> <code class="type">'a * 'a <a href="Clist.html#TYPEclist">clist</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Do not use this a lot because scanning
- it is not tail recursive</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">CConsR</span> <span class="keyword">of</span> <code class="type">'a <a href="Clist.html#TYPEclist">clist</a> * 'a</code></code></td>
-
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">CSeq</span> <span class="keyword">of</span> <code class="type">'a <a href="Clist.html#TYPEclist">clist</a> * 'a <a href="Clist.html#TYPEclist">clist</a></code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>We concatenate only two of them at this
- time. Neither is the empty clist. To be
- sure always use append to make these</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-<div class="info">
-The clist datatype. A clist can be an ordinary list, or a clist preceded
- or followed by an element, or two clists implicitly appended together<br>
-</div>
-
-<pre><span class="keyword">val</span> <a name="VALtoList"></a>toList : <code class="type">'a <a href="Clist.html#TYPEclist">clist</a> -> 'a list</code></pre><div class="info">
-Convert a clist to an ordinary list<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALfromList"></a>fromList : <code class="type">'a list -> 'a <a href="Clist.html#TYPEclist">clist</a></code></pre><div class="info">
-Convert an ordinary list to a clist<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALsingle"></a>single : <code class="type">'a -> 'a <a href="Clist.html#TYPEclist">clist</a></code></pre><div class="info">
-Create a clist containing one element<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALempty"></a>empty : <code class="type">'a <a href="Clist.html#TYPEclist">clist</a></code></pre><div class="info">
-The empty clist<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALappend"></a>append : <code class="type">'a <a href="Clist.html#TYPEclist">clist</a> -> 'a <a href="Clist.html#TYPEclist">clist</a> -> 'a <a href="Clist.html#TYPEclist">clist</a></code></pre><div class="info">
-Append two clists<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcheckBeforeAppend"></a>checkBeforeAppend : <code class="type">'a <a href="Clist.html#TYPEclist">clist</a> -> 'a <a href="Clist.html#TYPEclist">clist</a> -> bool</code></pre><div class="info">
-A useful check to assert before an append. It checks that the two lists
- are not identically the same (Except if they are both empty)<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALlength"></a>length : <code class="type">'a <a href="Clist.html#TYPEclist">clist</a> -> int</code></pre><div class="info">
-Find the length of a clist<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmap"></a>map : <code class="type">('a -> 'b) -> 'a <a href="Clist.html#TYPEclist">clist</a> -> 'b <a href="Clist.html#TYPEclist">clist</a></code></pre><div class="info">
-Map a function over a clist. Returns another clist<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALfold_left"></a>fold_left : <code class="type">('a -> 'b -> 'a) -> 'a -> 'b <a href="Clist.html#TYPEclist">clist</a> -> 'a</code></pre><div class="info">
-A version of fold_left that works on clists<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALiter"></a>iter : <code class="type">('a -> unit) -> 'a <a href="Clist.html#TYPEclist">clist</a> -> unit</code></pre><div class="info">
-A version of iter that works on clists<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALrev"></a>rev : <code class="type">('a -> 'a) -> 'a <a href="Clist.html#TYPEclist">clist</a> -> 'a <a href="Clist.html#TYPEclist">clist</a></code></pre><div class="info">
-Reverse a clist. The first function reverses an element.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdocCList"></a>docCList : <code class="type"><a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> ('a -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -> unit -> 'a <a href="Clist.html#TYPEclist">clist</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-A document for printing a clist (similar to <code class="code">docList</code>)<br>
-</div>
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Dataflow.BackwardsDataFlow.html b/cil/doc/api/Dataflow.BackwardsDataFlow.html
deleted file mode 100644
index 782d318c24f1c0098976c8fc6ea77fb3bfc58f48..0000000000000000000000000000000000000000
--- a/cil/doc/api/Dataflow.BackwardsDataFlow.html
+++ /dev/null
@@ -1,54 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="previous" href="Dataflow.ForwardsDataFlow.html">
-<link rel="Up" href="Dataflow.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow.BackwardsDataFlow</title>
-</head>
-<body>
-<div class="navbar"><a href="Dataflow.ForwardsDataFlow.html">Previous</a>
- <a href="Dataflow.html">Up</a>
- </div>
-<center><h1>Functor <a href="type_Dataflow.BackwardsDataFlow.html">Dataflow.BackwardsDataFlow</a></h1></center>
-<br>
-<pre><span class="keyword">module</span> BackwardsDataFlow: <div class="sig_block"><code class="code">functor (</code><code class="code">T</code><code class="code"> : </code><code class="type"><a href="Dataflow.BackwardsTransfer.html">BackwardsTransfer</a></code><code class="code">) -> </code><code class="code">sig</code> <a href="Dataflow.BackwardsDataFlow.html">..</a> <code class="code">end</code></div></pre><table border="0" cellpadding="3" width="100%">
-<tr>
-<td align="left" valign="top" width="1%%"><b>Parameters: </b></td>
-<td>
-<table class="paramstable">
-<tr>
-<td align="center" valign="top" width="15%">
-<code>T</code></td>
-<td align="center" valign="top">:</td>
-<td><code class="type"><a href="Dataflow.BackwardsTransfer.html">BackwardsTransfer</a></code>
-</table>
-</td>
-</tr>
-</table>
-<hr width="100%">
-<pre><span class="keyword">val</span> <a name="VALcompute"></a>compute : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> list -> unit</code></pre><div class="info">
-Fill in the T.stmtStartData, given a number of initial statements to
- start from (the sinks for the backwards data flow). All of the statements
- (not just the initial ones!) must have some entry in T.stmtStartData
- (i.e., the initial data should not be bottom)<br>
-</div>
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Dataflow.BackwardsTransfer.html b/cil/doc/api/Dataflow.BackwardsTransfer.html
deleted file mode 100644
index 0ff812dff35624d74e1fcdf74c5dd672a2934611..0000000000000000000000000000000000000000
--- a/cil/doc/api/Dataflow.BackwardsTransfer.html
+++ /dev/null
@@ -1,83 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="previous" href="Dataflow.ForwardsTransfer.html">
-<link rel="Up" href="Dataflow.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow.BackwardsTransfer</title>
-</head>
-<body>
-<div class="navbar"><a href="Dataflow.ForwardsTransfer.html">Previous</a>
- <a href="Dataflow.html">Up</a>
- </div>
-<center><h1>Module type <a href="type_Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a></h1></center>
-<br>
-<pre><span class="keyword">module type</span> BackwardsTransfer = <code class="code">sig</code> <a href="Dataflow.BackwardsTransfer.html">..</a> <code class="code">end</code></pre><hr width="100%">
-<pre><span class="keyword">val</span> <a name="VALname"></a>name : <code class="type">string</code></pre><div class="info">
-For debugging purposes, the name of the analysis<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdebug"></a>debug : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-Whether to turn on debugging<br>
-</div>
-<pre><span class="keyword">type</span> <a name="TYPEt"></a><code class="type"></code>t </pre>
-<div class="info">
-The type of the data we compute for each block start. In many
- presentations of backwards data flow analysis we maintain the
- data at the block end. This is not easy to do with JVML because
- a block has many exceptional ends. So we maintain the data for
- the statement start.<br>
-</div>
-
-<pre><span class="keyword">val</span> <a name="VALpretty"></a>pretty : <code class="type">unit -> <a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print the state<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALstmtStartData"></a>stmtStartData : <code class="type"><a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> Inthash.t</code></pre><div class="info">
-For each block id, the data at the start. This data structure must be
- initialized with the initial data for each block<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcombineStmtStartData"></a>combineStmtStartData : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> -><br> old:<a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> -><br> <a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> -> <a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> option</code></pre><div class="info">
-When the analysis reaches the start of a block, combine the old data
- with the one we have just computed. Return None if the combination is
- the same as the old data, otherwise return the combination. In the
- latter case, the predecessors of the statement are put on the working
- list.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcombineSuccessors"></a>combineSuccessors : <code class="type"><a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> -><br> <a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> -> <a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a></code></pre><div class="info">
-Take the data from two successors and combine it<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdoStmt"></a>doStmt : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> -> <a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> <a href="Dataflow.html#TYPEaction">Dataflow.action</a></code></pre><div class="info">
-The (backwards) transfer function for a branch. The <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is
- set before calling this. If it returns None, then we have some default
- handling. Otherwise, the returned data is the data before the branch
- (not considering the exception handlers)<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdoInstr"></a>doInstr : <code class="type"><a href="Cil.html#TYPEinstr">Cil.instr</a> -><br> <a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> -> <a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> <a href="Dataflow.html#TYPEaction">Dataflow.action</a></code></pre><div class="info">
-The (backwards) transfer function for an instruction. The
- <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is set before calling this. If it returns None, then we
- have some default handling. Otherwise, the returned data is the data
- before the branch (not considering the exception handlers)<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALfilterStmt"></a>filterStmt : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> -> <a href="Cil.html#TYPEstmt">Cil.stmt</a> -> bool</code></pre><div class="info">
-Whether to put this predecessor block in the worklist. We give the
- predecessor and the block whose predecessor we are (and whose data has
- changed)<br>
-</div>
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Dataflow.ForwardsDataFlow.html b/cil/doc/api/Dataflow.ForwardsDataFlow.html
deleted file mode 100644
index 760dc2beebfdd697b83460030cde74c0937be489..0000000000000000000000000000000000000000
--- a/cil/doc/api/Dataflow.ForwardsDataFlow.html
+++ /dev/null
@@ -1,53 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="next" href="Dataflow.BackwardsDataFlow.html">
-<link rel="Up" href="Dataflow.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow.ForwardsDataFlow</title>
-</head>
-<body>
-<div class="navbar"> <a href="Dataflow.html">Up</a>
- <a href="Dataflow.BackwardsDataFlow.html">Next</a>
-</div>
-<center><h1>Functor <a href="type_Dataflow.ForwardsDataFlow.html">Dataflow.ForwardsDataFlow</a></h1></center>
-<br>
-<pre><span class="keyword">module</span> ForwardsDataFlow: <div class="sig_block"><code class="code">functor (</code><code class="code">T</code><code class="code"> : </code><code class="type"><a href="Dataflow.ForwardsTransfer.html">ForwardsTransfer</a></code><code class="code">) -> </code><code class="code">sig</code> <a href="Dataflow.ForwardsDataFlow.html">..</a> <code class="code">end</code></div></pre><table border="0" cellpadding="3" width="100%">
-<tr>
-<td align="left" valign="top" width="1%%"><b>Parameters: </b></td>
-<td>
-<table class="paramstable">
-<tr>
-<td align="center" valign="top" width="15%">
-<code>T</code></td>
-<td align="center" valign="top">:</td>
-<td><code class="type"><a href="Dataflow.ForwardsTransfer.html">ForwardsTransfer</a></code>
-</table>
-</td>
-</tr>
-</table>
-<hr width="100%">
-<pre><span class="keyword">val</span> <a name="VALcompute"></a>compute : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> list -> unit</code></pre><div class="info">
-Fill in the T.stmtStartData, given a number of initial statements to
- start from. All of the initial statements must have some entry in
- T.stmtStartData (i.e., the initial data should not be bottom)<br>
-</div>
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Dataflow.ForwardsTransfer.html b/cil/doc/api/Dataflow.ForwardsTransfer.html
deleted file mode 100644
index dbefaa036966bd0110a910b30c1e78ceb9af3209..0000000000000000000000000000000000000000
--- a/cil/doc/api/Dataflow.ForwardsTransfer.html
+++ /dev/null
@@ -1,88 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="next" href="Dataflow.BackwardsTransfer.html">
-<link rel="Up" href="Dataflow.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow.ForwardsTransfer</title>
-</head>
-<body>
-<div class="navbar"> <a href="Dataflow.html">Up</a>
- <a href="Dataflow.BackwardsTransfer.html">Next</a>
-</div>
-<center><h1>Module type <a href="type_Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a></h1></center>
-<br>
-<pre><span class="keyword">module type</span> ForwardsTransfer = <code class="code">sig</code> <a href="Dataflow.ForwardsTransfer.html">..</a> <code class="code">end</code></pre><hr width="100%">
-<pre><span class="keyword">val</span> <a name="VALname"></a>name : <code class="type">string</code></pre><div class="info">
-For debugging purposes, the name of the analysis<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdebug"></a>debug : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-Whether to turn on debugging<br>
-</div>
-<pre><span class="keyword">type</span> <a name="TYPEt"></a><code class="type"></code>t </pre>
-<div class="info">
-The type of the data we compute for each block start. May be
- imperative.<br>
-</div>
-
-<pre><span class="keyword">val</span> <a name="VALcopy"></a>copy : <code class="type"><a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> -> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a></code></pre><div class="info">
-Make a deep copy of the data<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALstmtStartData"></a>stmtStartData : <code class="type"><a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> Inthash.t</code></pre><div class="info">
-For each statement id, the data at the start. Not found in the hash
- table means nothing is known about the state at this point. At the end
- of the analysis this means that the block is not reachable.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALpretty"></a>pretty : <code class="type">unit -> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Pretty-print the state<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcomputeFirstPredecessor"></a>computeFirstPredecessor : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> -> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> -> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a></code></pre><div class="info">
-Give the first value for a predecessors, compute the value to be set
- for the block<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcombinePredecessors"></a>combinePredecessors : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> -><br> old:<a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> -><br> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> -> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> option</code></pre><div class="info">
-Take some old data for the start of a statement, and some new data for
- the same point. Return None if the combination is identical to the old
- data. Otherwise, compute the combination, and return it.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdoInstr"></a>doInstr : <code class="type"><a href="Cil.html#TYPEinstr">Cil.instr</a> -><br> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> -> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> <a href="Dataflow.html#TYPEaction">Dataflow.action</a></code></pre><div class="info">
-The (forwards) transfer function for an instruction. The
- <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is set before calling this. The default action is to
- continue with the state unchanged.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdoStmt"></a>doStmt : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> -><br> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> -><br> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> <a href="Dataflow.html#TYPEstmtaction">Dataflow.stmtaction</a></code></pre><div class="info">
-The (forwards) transfer function for a statement. The <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a>
- is set before calling this. The default action is to do the instructions
- in this statement, if applicable, and continue with the successors.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdoGuard"></a>doGuard : <code class="type"><a href="Cil.html#TYPEexp">Cil.exp</a> -><br> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> -><br> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> <a href="Dataflow.html#TYPEguardaction">Dataflow.guardaction</a></code></pre><div class="info">
-Generate the successor to an If statement assuming the given expression
- is nonzero. Analyses that don't need guard information can return
- GDefault; this is equivalent to returning GUse of the input.
- A return value of GUnreachable indicates that this half of the branch
- will not be taken and should not be explored. This will be called
- twice per If, once for "then" and once for "else".<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALfilterStmt"></a>filterStmt : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> -> bool</code></pre><div class="info">
-Whether to put this statement in the worklist. This is called when a
- block would normally be put in the worklist.<br>
-</div>
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Dataflow.html b/cil/doc/api/Dataflow.html
deleted file mode 100644
index 9f744ea0a80008a497ad37669460ea0c081f5023..0000000000000000000000000000000000000000
--- a/cil/doc/api/Dataflow.html
+++ /dev/null
@@ -1,114 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="previous" href="Cfg.html">
-<link rel="next" href="Dominators.html">
-<link rel="Up" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow</title>
-</head>
-<body>
-<div class="navbar"><a href="Cfg.html">Previous</a>
- <a href="index.html">Up</a>
- <a href="Dominators.html">Next</a>
-</div>
-<center><h1>Module <a href="type_Dataflow.html">Dataflow</a></h1></center>
-<br>
-<pre><span class="keyword">module</span> Dataflow: <code class="code">sig</code> <a href="Dataflow.html">..</a> <code class="code">end</code></pre>A framework for data flow analysis for CIL code. Before using
- this framework, you must initialize the Control-flow Graph for your
- program, e.g using <a href="Cfg.html#VALcomputeFileCFG"><code class="code">Cfg.computeFileCFG</code></a><br>
-<hr width="100%">
-<br><code><span class="keyword">type</span> <a name="TYPEaction"></a><code class="type">'a</code> action = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Default</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The default action</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Done</span> <span class="keyword">of</span> <code class="type">'a</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Do not do the default action. Use this result</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">Post</span> <span class="keyword">of</span> <code class="type">('a -> 'a)</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The default action, followed by the given
- transformer</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-
-<br><code><span class="keyword">type</span> <a name="TYPEstmtaction"></a><code class="type">'a</code> stmtaction = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">SDefault</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The default action</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">SDone</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Do not visit this statement or its successors</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">SUse</span> <span class="keyword">of</span> <code class="type">'a</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Visit the instructions and successors of this statement
- as usual, but use the specified state instead of the
- one that was passed to doStmt</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-
-<br><code><span class="keyword">type</span> <a name="TYPEguardaction"></a><code class="type">'a</code> guardaction = </code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">GDefault</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The default state</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">GUse</span> <span class="keyword">of</span> <code class="type">'a</code></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Use this data for the branch</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code><span class="keyword">|</span></code></td>
-<td align="left" valign="top" >
-<code><span class="constructor">GUnreachable</span></code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The branch will never be taken.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-
-
-<pre><span class="keyword">module type</span> <a href="Dataflow.ForwardsTransfer.html">ForwardsTransfer</a> = <code class="code">sig</code> <a href="Dataflow.ForwardsTransfer.html">..</a> <code class="code">end</code></pre><pre><span class="keyword">module</span> <a href="Dataflow.ForwardsDataFlow.html">ForwardsDataFlow</a>: <div class="sig_block"><code class="code">functor (</code><code class="code">T</code><code class="code"> : </code><code class="type"><a href="Dataflow.ForwardsTransfer.html">ForwardsTransfer</a></code><code class="code">) -> </code><code class="code">sig</code> <a href="Dataflow.ForwardsDataFlow.html">..</a> <code class="code">end</code></div></pre><pre><span class="keyword">module type</span> <a href="Dataflow.BackwardsTransfer.html">BackwardsTransfer</a> = <code class="code">sig</code> <a href="Dataflow.BackwardsTransfer.html">..</a> <code class="code">end</code></pre><pre><span class="keyword">module</span> <a href="Dataflow.BackwardsDataFlow.html">BackwardsDataFlow</a>: <div class="sig_block"><code class="code">functor (</code><code class="code">T</code><code class="code"> : </code><code class="type"><a href="Dataflow.BackwardsTransfer.html">BackwardsTransfer</a></code><code class="code">) -> </code><code class="code">sig</code> <a href="Dataflow.BackwardsDataFlow.html">..</a> <code class="code">end</code></div></pre></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Dominators.html b/cil/doc/api/Dominators.html
deleted file mode 100644
index 4d8eaf9e482b936f4fc5abf79115cdaa2de2faee..0000000000000000000000000000000000000000
--- a/cil/doc/api/Dominators.html
+++ /dev/null
@@ -1,58 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="previous" href="Dataflow.html">
-<link rel="Up" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dominators</title>
-</head>
-<body>
-<div class="navbar"><a href="Dataflow.html">Previous</a>
- <a href="index.html">Up</a>
- </div>
-<center><h1>Module <a href="type_Dominators.html">Dominators</a></h1></center>
-<br>
-<pre><span class="keyword">module</span> Dominators: <code class="code">sig</code> <a href="Dominators.html">..</a> <code class="code">end</code></pre>Compute dominators using data flow analysis<br>
-<hr width="100%">
-<br>
-Author: George Necula
- 5/28/2004
-<br>
-<pre><span class="keyword">val</span> <a name="VALcomputeIDom"></a>computeIDom : <code class="type"><a href="Cil.html#TYPEfundec">Cil.fundec</a> -> <a href="Cil.html#TYPEstmt">Cil.stmt</a> option Inthash.t</code></pre><div class="info">
-Invoke on a code after filling in the CFG info and it computes the
- immediate dominator information. We map each statement to its immediate
- dominator (None for the start statement, and for the unreachable
- statements).<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALgetIdom"></a>getIdom : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> option Inthash.t -> <a href="Cil.html#TYPEstmt">Cil.stmt</a> -> <a href="Cil.html#TYPEstmt">Cil.stmt</a> option</code></pre><div class="info">
-This is like Inthash.find but gives an error if the information is
- Not_found<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdominates"></a>dominates : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> option Inthash.t -> <a href="Cil.html#TYPEstmt">Cil.stmt</a> -> <a href="Cil.html#TYPEstmt">Cil.stmt</a> -> bool</code></pre><div class="info">
-Check whether one statement dominates another.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALfindNaturalLoops"></a>findNaturalLoops : <code class="type"><a href="Cil.html#TYPEfundec">Cil.fundec</a> -> <a href="Cil.html#TYPEstmt">Cil.stmt</a> option Inthash.t -> (<a href="Cil.html#TYPEstmt">Cil.stmt</a> * <a href="Cil.html#TYPEstmt">Cil.stmt</a> list) list</code></pre><div class="info">
-Compute the start of the natural loops. This assumes that the "idom"
- field has been computed. For each start, keep a list of origin of a back
- edge. The loop consists of the loop start and all predecessors of the
- origins of back edges, up to and including the loop start<br>
-</div>
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Errormsg.html b/cil/doc/api/Errormsg.html
deleted file mode 100644
index bc194728cf4fb00d97f8cffb2bf58de323d6ac0f..0000000000000000000000000000000000000000
--- a/cil/doc/api/Errormsg.html
+++ /dev/null
@@ -1,141 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="previous" href="Pretty.html">
-<link rel="next" href="Clist.html">
-<link rel="Up" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Errormsg</title>
-</head>
-<body>
-<div class="navbar"><a href="Pretty.html">Previous</a>
- <a href="index.html">Up</a>
- <a href="Clist.html">Next</a>
-</div>
-<center><h1>Module <a href="type_Errormsg.html">Errormsg</a></h1></center>
-<br>
-<pre><span class="keyword">module</span> Errormsg: <code class="code">sig</code> <a href="Errormsg.html">..</a> <code class="code">end</code></pre>Utility functions for error-reporting<br>
-<hr width="100%">
-<pre><span class="keyword">val</span> <a name="VALlogChannel"></a>logChannel : <code class="type">Pervasives.out_channel Pervasives.ref</code></pre><div class="info">
-A channel for printing log messages<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdebugFlag"></a>debugFlag : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-If set then print debugging info<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALverboseFlag"></a>verboseFlag : <code class="type">bool Pervasives.ref</code></pre><pre><span class="keyword">val</span> <a name="VALwarnFlag"></a>warnFlag : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-Set to true if you want to see all warnings.<br>
-</div>
-<pre><span class="keyword">exception</span> <a name="EXCEPTIONError"></a>Error</pre>
-<div class="info">
-Error reporting functions raise this exception<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALerror"></a>error : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>, unit) format4 -> 'a</code></pre><div class="info">
-Prints an error message of the form <code class="code">Error: ...</code>.
- Use in conjunction with s, for example: <code class="code">E.s (E.error ... )</code>.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALbug"></a>bug : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>, unit) format4 -> 'a</code></pre><div class="info">
-Similar to <code class="code">error</code> except that its output has the form <code class="code">Bug: ...</code><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALunimp"></a>unimp : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>, unit) format4 -> 'a</code></pre><div class="info">
-Similar to <code class="code">error</code> except that its output has the form <code class="code">Unimplemented: ...</code><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALs"></a>s : <code class="type">'a -> 'b</code></pre><div class="info">
-Stop the execution by raising an Error.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALhadErrors"></a>hadErrors : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-This is set whenever one of the above error functions are called. It must
- be cleared manually<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALwarn"></a>warn : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>, unit) format4 -> 'a</code></pre><div class="info">
-Like <a href="Errormsg.html#VALerror"><code class="code">Errormsg.error</code></a> but does not raise the <a href="Errormsg.html#EXCEPTIONError"><code class="code">Errormsg.Error</code></a>
- exception. Return type is unit.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALwarnOpt"></a>warnOpt : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>, unit) format4 -> 'a</code></pre><div class="info">
-Like <a href="Errormsg.html#VALwarn"><code class="code">Errormsg.warn</code></a> but optional. Printed only if the
- <a href="Errormsg.html#VALwarnFlag"><code class="code">Errormsg.warnFlag</code></a> is set<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALlog"></a>log : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>, unit) format4 -> 'a</code></pre><div class="info">
-Print something to <code class="code">logChannel</code><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALlogg"></a>logg : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>, unit) format4 -> 'a</code></pre><div class="info">
-same as <a href="Errormsg.html#VALlog"><code class="code">Errormsg.log</code></a> but do not wrap lines<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALnull"></a>null : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>, unit) format4 -> 'a</code></pre><div class="info">
-Do not actually print (i.e. print to /dev/null)<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALpushContext"></a>pushContext : <code class="type">(unit -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -> unit</code></pre><div class="info">
-Registers a context printing function<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALpopContext"></a>popContext : <code class="type">unit -> unit</code></pre><div class="info">
-Removes the last registered context printing function<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALshowContext"></a>showContext : <code class="type">unit -> unit</code></pre><div class="info">
-Show the context stack to stderr<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALwithContext"></a>withContext : <code class="type">(unit -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -> ('a -> 'b) -> 'a -> 'b</code></pre><div class="info">
-To ensure that the context is registered and removed properly, use the
- function below<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALnewline"></a>newline : <code class="type">unit -> unit</code></pre><pre><span class="keyword">val</span> <a name="VALnewHline"></a>newHline : <code class="type">unit -> unit</code></pre><pre><span class="keyword">val</span> <a name="VALgetPosition"></a>getPosition : <code class="type">unit -> int * string * int</code></pre><pre><span class="keyword">val</span> <a name="VALgetHPosition"></a>getHPosition : <code class="type">unit -> int * string</code></pre><div class="info">
-high-level position<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALsetHLine"></a>setHLine : <code class="type">int -> unit</code></pre><pre><span class="keyword">val</span> <a name="VALsetHFile"></a>setHFile : <code class="type">string -> unit</code></pre><pre><span class="keyword">val</span> <a name="VALsetCurrentLine"></a>setCurrentLine : <code class="type">int -> unit</code></pre><pre><span class="keyword">val</span> <a name="VALsetCurrentFile"></a>setCurrentFile : <code class="type">string -> unit</code></pre><br><code><span class="keyword">type</span> <a name="TYPElocation"></a><code class="type"></code>location = {</code><table class="typetable">
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code>file : <code class="type">string</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The file name</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code>line : <code class="type">int</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The line number</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code>hfile : <code class="type">string</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The high-level file name, or "" if not present</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr>
-<tr>
-<td align="left" valign="top" >
-<code> </code></td>
-<td align="left" valign="top" >
-<code>hline : <code class="type">int</code>;</code></td>
-<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The high-level line number, or 0 if not present</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
-</tr></table>
-}
-
-<div class="info">
-Type for source-file locations<br>
-</div>
-
-<pre><span class="keyword">val</span> <a name="VALd_loc"></a>d_loc : <code class="type">unit -> <a href="Errormsg.html#TYPElocation">location</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALd_hloc"></a>d_hloc : <code class="type">unit -> <a href="Errormsg.html#TYPElocation">location</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALgetLocation"></a>getLocation : <code class="type">unit -> <a href="Errormsg.html#TYPElocation">location</a></code></pre><pre><span class="keyword">val</span> <a name="VALparse_error"></a>parse_error : <code class="type">string -> 'a</code></pre><pre><span class="keyword">val</span> <a name="VALlocUnknown"></a>locUnknown : <code class="type"><a href="Errormsg.html#TYPElocation">location</a></code></pre><div class="info">
-An unknown location for use when you need one but you don't have one<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALreadingFromStdin"></a>readingFromStdin : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-Records whether the stdin is open for reading the goal *<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALstartParsing"></a>startParsing : <code class="type">?useBasename:bool -> string -> Lexing.lexbuf</code></pre><pre><span class="keyword">val</span> <a name="VALstartParsingFromString"></a>startParsingFromString : <code class="type">?file:string -> ?line:int -> string -> Lexing.lexbuf</code></pre><pre><span class="keyword">val</span> <a name="VALfinishParsing"></a>finishParsing : <code class="type">unit -> unit</code></pre></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Formatcil.html b/cil/doc/api/Formatcil.html
deleted file mode 100644
index 8dee76d7789081f61a69966d311e2eb6c1f46dfa..0000000000000000000000000000000000000000
--- a/cil/doc/api/Formatcil.html
+++ /dev/null
@@ -1,84 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="previous" href="Cil.html">
-<link rel="next" href="Alpha.html">
-<link rel="Up" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Formatcil</title>
-</head>
-<body>
-<div class="navbar"><a href="Cil.html">Previous</a>
- <a href="index.html">Up</a>
- <a href="Alpha.html">Next</a>
-</div>
-<center><h1>Module <a href="type_Formatcil.html">Formatcil</a></h1></center>
-<br>
-<pre><span class="keyword">module</span> Formatcil: <code class="code">sig</code> <a href="Formatcil.html">..</a> <code class="code">end</code></pre><b>An Interpreter for constructing CIL constructs</b><br>
-<hr width="100%">
-<pre><span class="keyword">val</span> <a name="VALcExp"></a>cExp : <code class="type">string -> (string * <a href="Cil.html#TYPEformatArg">Cil.formatArg</a>) list -> <a href="Cil.html#TYPEexp">Cil.exp</a></code></pre><div class="info">
-Constructs an expression based on the program and the list of arguments.
- Each argument consists of a name followed by the actual data. This
- argument will be placed instead of occurrences of "%v:name" in the pattern
- (where the "v" is dependent on the type of the data). The parsing of the
- string is memoized. * Only the first expression is parsed.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcLval"></a>cLval : <code class="type">string -> (string * <a href="Cil.html#TYPEformatArg">Cil.formatArg</a>) list -> <a href="Cil.html#TYPElval">Cil.lval</a></code></pre><div class="info">
-Constructs an lval based on the program and the list of arguments.
- Only the first lvalue is parsed.
- The parsing of the string is memoized.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcType"></a>cType : <code class="type">string -> (string * <a href="Cil.html#TYPEformatArg">Cil.formatArg</a>) list -> <a href="Cil.html#TYPEtyp">Cil.typ</a></code></pre><div class="info">
-Constructs a type based on the program and the list of arguments.
- Only the first type is parsed.
- The parsing of the string is memoized.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcInstr"></a>cInstr : <code class="type">string -> <a href="Cil.html#TYPElocation">Cil.location</a> -> (string * <a href="Cil.html#TYPEformatArg">Cil.formatArg</a>) list -> <a href="Cil.html#TYPEinstr">Cil.instr</a></code></pre><div class="info">
-Constructs an instruction based on the program and the list of arguments.
- Only the first instruction is parsed.
- The parsing of the string is memoized.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcStmt"></a>cStmt : <code class="type">string -><br> (string -> <a href="Cil.html#TYPEtyp">Cil.typ</a> -> <a href="Cil.html#TYPEvarinfo">Cil.varinfo</a>) -><br> <a href="Cil.html#TYPElocation">Cil.location</a> -> (string * <a href="Cil.html#TYPEformatArg">Cil.formatArg</a>) list -> <a href="Cil.html#TYPEstmt">Cil.stmt</a></code></pre><pre><span class="keyword">val</span> <a name="VALcStmts"></a>cStmts : <code class="type">string -><br> (string -> <a href="Cil.html#TYPEtyp">Cil.typ</a> -> <a href="Cil.html#TYPEvarinfo">Cil.varinfo</a>) -><br> <a href="Cil.html#TYPElocation">Cil.location</a> -> (string * <a href="Cil.html#TYPEformatArg">Cil.formatArg</a>) list -> <a href="Cil.html#TYPEstmt">Cil.stmt</a> list</code></pre><div class="info">
-Constructs a list of statements<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdExp"></a>dExp : <code class="type">string -> <a href="Cil.html#TYPEexp">Cil.exp</a> -> <a href="Cil.html#TYPEformatArg">Cil.formatArg</a> list option</code></pre><div class="info">
-Deconstructs an expression based on the program. Produces an optional
- list of format arguments. The parsing of the string is memoized.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdLval"></a>dLval : <code class="type">string -> <a href="Cil.html#TYPElval">Cil.lval</a> -> <a href="Cil.html#TYPEformatArg">Cil.formatArg</a> list option</code></pre><div class="info">
-Deconstructs an lval based on the program. Produces an optional
- list of format arguments. The parsing of the string is memoized.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdType"></a>dType : <code class="type">string -> <a href="Cil.html#TYPEtyp">Cil.typ</a> -> <a href="Cil.html#TYPEformatArg">Cil.formatArg</a> list option</code></pre><div class="info">
-Deconstructs a type based on the program. Produces an optional list of
- format arguments. The parsing of the string is memoized.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdInstr"></a>dInstr : <code class="type">string -> <a href="Cil.html#TYPEinstr">Cil.instr</a> -> <a href="Cil.html#TYPEformatArg">Cil.formatArg</a> list option</code></pre><div class="info">
-Deconstructs an instruction based on the program. Produces an optional
- list of format arguments. The parsing of the string is memoized.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALnoMemoize"></a>noMemoize : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-If set then will not memoize the parsed patterns<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALtest"></a>test : <code class="type">unit -> unit</code></pre><div class="info">
-Just a testing function<br>
-</div>
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Pretty.MakeMapPrinter.html b/cil/doc/api/Pretty.MakeMapPrinter.html
deleted file mode 100644
index 9693a68d75c6db38608072c3a3e990149305763d..0000000000000000000000000000000000000000
--- a/cil/doc/api/Pretty.MakeMapPrinter.html
+++ /dev/null
@@ -1,63 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="next" href="Pretty.MakeSetPrinter.html">
-<link rel="Up" href="Pretty.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Pretty.MakeMapPrinter</title>
-</head>
-<body>
-<div class="navbar"> <a href="Pretty.html">Up</a>
- <a href="Pretty.MakeSetPrinter.html">Next</a>
-</div>
-<center><h1>Functor <a href="type_Pretty.MakeMapPrinter.html">Pretty.MakeMapPrinter</a></h1></center>
-<br>
-<pre><span class="keyword">module</span> MakeMapPrinter: <div class="sig_block"><code class="code">functor (</code><code class="code">Map</code><code class="code"> : </code><code class="code">sig</code><div class="sig_block"><pre><span class="keyword">type</span> <a name="TYPEkey"></a><code class="type"></code>key </pre>
-
-<pre><span class="keyword">type</span> <a name="TYPEt"></a><code class="type">'a</code> t </pre>
-
-<pre><span class="keyword">val</span> <a name="VALfold"></a>fold : <code class="type">(key -> 'a -> 'b -> 'b) -><br> 'a t -> 'b -> 'b</code></pre></div><code class="code">end</code><code class="code">) -> </code><code class="code">sig</code> <a href="Pretty.MakeMapPrinter.html">..</a> <code class="code">end</code></div></pre>Format maps.<br>
-<table border="0" cellpadding="3" width="100%">
-<tr>
-<td align="left" valign="top" width="1%%"><b>Parameters: </b></td>
-<td>
-<table class="paramstable">
-<tr>
-<td align="center" valign="top" width="15%">
-<code>Map</code></td>
-<td align="center" valign="top">:</td>
-<td><code class="type">sig
- type key
- type 'a t
- val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
- end</code>
-</table>
-</td>
-</tr>
-</table>
-<hr width="100%">
-<pre><span class="keyword">val</span> <a name="VALdocMap"></a>docMap : <code class="type">?sep:<a href="Pretty.html#TYPEdoc">Pretty.doc</a> -><br> (Map.key -> 'a -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -> unit -> 'a Map.t -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Format a map, analogous to docList.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_map"></a>d_map : <code class="type">?dmaplet:(<a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -><br> string -><br> (unit -> Map.key -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -><br> (unit -> 'a -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -> unit -> 'a Map.t -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Format a map, analogous to d_list.<br>
-</div>
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Pretty.MakeSetPrinter.html b/cil/doc/api/Pretty.MakeSetPrinter.html
deleted file mode 100644
index e9343b2f1a7d0aef12c9c2105c61c9a08383ce22..0000000000000000000000000000000000000000
--- a/cil/doc/api/Pretty.MakeSetPrinter.html
+++ /dev/null
@@ -1,63 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="previous" href="Pretty.MakeMapPrinter.html">
-<link rel="Up" href="Pretty.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Pretty.MakeSetPrinter</title>
-</head>
-<body>
-<div class="navbar"><a href="Pretty.MakeMapPrinter.html">Previous</a>
- <a href="Pretty.html">Up</a>
- </div>
-<center><h1>Functor <a href="type_Pretty.MakeSetPrinter.html">Pretty.MakeSetPrinter</a></h1></center>
-<br>
-<pre><span class="keyword">module</span> MakeSetPrinter: <div class="sig_block"><code class="code">functor (</code><code class="code">Set</code><code class="code"> : </code><code class="code">sig</code><div class="sig_block"><pre><span class="keyword">type</span> <a name="TYPEelt"></a><code class="type"></code>elt </pre>
-
-<pre><span class="keyword">type</span> <a name="TYPEt"></a><code class="type"></code>t </pre>
-
-<pre><span class="keyword">val</span> <a name="VALfold"></a>fold : <code class="type">(elt -> 'a -> 'a) -><br> t -> 'a -> 'a</code></pre></div><code class="code">end</code><code class="code">) -> </code><code class="code">sig</code> <a href="Pretty.MakeSetPrinter.html">..</a> <code class="code">end</code></div></pre>Format sets.<br>
-<table border="0" cellpadding="3" width="100%">
-<tr>
-<td align="left" valign="top" width="1%%"><b>Parameters: </b></td>
-<td>
-<table class="paramstable">
-<tr>
-<td align="center" valign="top" width="15%">
-<code>Set</code></td>
-<td align="center" valign="top">:</td>
-<td><code class="type">sig
- type elt
- type t
- val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
- end</code>
-</table>
-</td>
-</tr>
-</table>
-<hr width="100%">
-<pre><span class="keyword">val</span> <a name="VALdocSet"></a>docSet : <code class="type">?sep:<a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> (Set.elt -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -> unit -> Set.t -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Format a set, analogous to docList.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_set"></a>d_set : <code class="type">string -> (unit -> Set.elt -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -> unit -> Set.t -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
-Format a set, analogous to d_list.<br>
-</div>
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Pretty.html b/cil/doc/api/Pretty.html
deleted file mode 100644
index c9c48c8eff5190b9254635de1a37ab63549854ed..0000000000000000000000000000000000000000
--- a/cil/doc/api/Pretty.html
+++ /dev/null
@@ -1,268 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="next" href="Errormsg.html">
-<link rel="Up" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Pretty</title>
-</head>
-<body>
-<div class="navbar"> <a href="index.html">Up</a>
- <a href="Errormsg.html">Next</a>
-</div>
-<center><h1>Module <a href="type_Pretty.html">Pretty</a></h1></center>
-<br>
-<pre><span class="keyword">module</span> Pretty: <code class="code">sig</code> <a href="Pretty.html">..</a> <code class="code">end</code></pre>Utility functions for pretty-printing. The major features provided by
- this module are <ul>
-<li>An <code class="code">fprintf</code>-style interface with support for user-defined printers</li>
-<li>The printout is fit to a width by selecting some of the optional newlines</li>
-<li>Constructs for alignment and indentation</li>
-<li>Print ellipsis starting at a certain nesting depth</li>
-<li>Constructs for printing lists and arrays</li>
-</ul>
-
- Pretty-printing occurs in two stages:<ul>
-<li>Construct a <a href="Pretty.html#TYPEdoc"><code class="code">Pretty.doc</code></a> object that encodes all of the elements to be
- printed
- along with alignment specifiers and optional and mandatory newlines</li>
-<li>Format the <a href="Pretty.html#TYPEdoc"><code class="code">Pretty.doc</code></a> to a certain width and emit it as a string, to an
- output stream or pass it to a user-defined function</li>
-</ul>
-
- The formatting algorithm is not optimal but it does a pretty good job while
- still operating in linear time. The original version was based on a pretty
- printer by Philip Wadler which turned out to not scale to large jobs.<br>
-<hr width="100%">
-<br>
-API<br>
-<pre><span class="keyword">type</span> <a name="TYPEdoc"></a><code class="type"></code>doc </pre>
-<div class="info">
-The type of unformated documents. Elements of this type can be
- constructed in two ways. Either with a number of constructor shown below,
- or using the <a href="Pretty.html#VALdprintf"><code class="code">Pretty.dprintf</code></a> function with a <code class="code">printf</code>-like interface.
- The <a href="Pretty.html#VALdprintf"><code class="code">Pretty.dprintf</code></a> method is slightly slower so we do not use it for
- large jobs such as the output routines for a compiler. But we use it for
- small jobs such as logging and error messages.<br>
-</div>
-
-<br>
-Constructors for the doc type.<br>
-<pre><span class="keyword">val</span> <a name="VALnil"></a>nil : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-Constructs an empty document<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VAL(++)"></a>(++) : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a> -> <a href="Pretty.html#TYPEdoc">doc</a> -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-Concatenates two documents. This is an infix operator that associates to
- the left.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALconcat"></a>concat : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a> -> <a href="Pretty.html#TYPEdoc">doc</a> -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALtext"></a>text : <code class="type">string -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-A document that prints the given string<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALnum"></a>num : <code class="type">int -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-A document that prints an integer in decimal form<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALreal"></a>real : <code class="type">float -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-A document that prints a real number<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALchr"></a>chr : <code class="type">char -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-A document that prints a character. This is just like <a href="Pretty.html#VALtext"><code class="code">Pretty.text</code></a>
- with a one-character string.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALline"></a>line : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-A document that consists of a mandatory newline. This is just like <code class="code">(text
- "\n")</code>. The new line will be indented to the current indentation level,
- unless you use <a href="Pretty.html#VALleftflush"><code class="code">Pretty.leftflush</code></a> right after this.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALleftflush"></a>leftflush : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-Use after a <a href="Pretty.html#VALline"><code class="code">Pretty.line</code></a> to prevent the indentation. Whatever follows
- next will be flushed left. Indentation resumes on the next line.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALbreak"></a>break : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-A document that consists of either a space or a line break. Also called
- an optional line break. Such a break will be
- taken only if necessary to fit the document in a given width. If the break
- is not taken a space is printed instead.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALalign"></a>align : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-Mark the current column as the current indentation level. Does not print
- anything. All taken line breaks will align to this column. The previous
- alignment level is saved on a stack.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALunalign"></a>unalign : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-Reverts to the last saved indentation level.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmark"></a>mark : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-Mark the beginning of a markup section. The width of a markup section is
- considered 0 for the purpose of computing identation<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALunmark"></a>unmark : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-The end of a markup section<br>
-</div>
-<br>
-Syntactic sugar<br>
-<pre><span class="keyword">val</span> <a name="VALindent"></a>indent : <code class="type">int -> <a href="Pretty.html#TYPEdoc">doc</a> -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-Indents the document. Same as <code class="code">((text " ") ++ align ++ doc ++ unalign)</code>,
- with the specified number of spaces.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALmarkup"></a>markup : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a> -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-Prints a document as markup. The marked document cannot contain line
- breaks or alignment constructs.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALseq"></a>seq : <code class="type">sep:<a href="Pretty.html#TYPEdoc">doc</a> -> doit:('a -> <a href="Pretty.html#TYPEdoc">doc</a>) -> elements:'a list -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-Formats a sequence. <code class="code">sep</code> is a separator, <code class="code">doit</code> is a function that
- converts an element to a document.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdocList"></a>docList : <code class="type">?sep:<a href="Pretty.html#TYPEdoc">doc</a> -> ('a -> <a href="Pretty.html#TYPEdoc">doc</a>) -> unit -> 'a list -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-An alternative function for printing a list. The <code class="code">unit</code> argument is there
- to make this function more easily usable with the <a href="Pretty.html#VALdprintf"><code class="code">Pretty.dprintf</code></a>
- interface. The first argument is a separator, by default a comma.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_list"></a>d_list : <code class="type">string -> (unit -> 'a -> <a href="Pretty.html#TYPEdoc">doc</a>) -> unit -> 'a list -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-sm: Yet another list printer. This one accepts the same kind of
- printing function that <a href="Pretty.html#VALdprintf"><code class="code">Pretty.dprintf</code></a> does, and itself works
- in the dprintf context. Also accepts
- a string as the separator since that's by far the most common.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdocArray"></a>docArray : <code class="type">?sep:<a href="Pretty.html#TYPEdoc">doc</a> -><br> (int -> 'a -> <a href="Pretty.html#TYPEdoc">doc</a>) -> unit -> 'a array -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-Formats an array. A separator and a function that prints an array
- element. The default separator is a comma.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdocOpt"></a>docOpt : <code class="type">('a -> <a href="Pretty.html#TYPEdoc">doc</a>) -> unit -> 'a option -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-Prints an <code class="code">'a option</code> with <code class="code">None</code> or <code class="code">Some</code><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALd_int32"></a>d_int32 : <code class="type">int32 -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-Print an int32<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALf_int32"></a>f_int32 : <code class="type">unit -> int32 -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALd_int64"></a>d_int64 : <code class="type">int64 -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALf_int64"></a>f_int64 : <code class="type">unit -> int64 -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><pre><span class="keyword">module</span> <a href="Pretty.MakeMapPrinter.html">MakeMapPrinter</a>: <div class="sig_block"><code class="code">functor (</code><code class="code">Map</code><code class="code"> : </code><code class="code">sig</code><div class="sig_block"><pre><span class="keyword">type</span> <a name="TYPEkey"></a><code class="type"></code>key </pre>
-
-<pre><span class="keyword">type</span> <a name="TYPEt"></a><code class="type">'a</code> t </pre>
-
-<pre><span class="keyword">val</span> <a name="VALfold"></a>fold : <code class="type">(key -> 'a -> 'b -> 'b) -><br> 'a t -> 'b -> 'b</code></pre></div><code class="code">end</code><code class="code">) -> </code><code class="code">sig</code> <a href="Pretty.MakeMapPrinter.html">..</a> <code class="code">end</code></div></pre><div class="info">
-Format maps.
-</div>
-<pre><span class="keyword">module</span> <a href="Pretty.MakeSetPrinter.html">MakeSetPrinter</a>: <div class="sig_block"><code class="code">functor (</code><code class="code">Set</code><code class="code"> : </code><code class="code">sig</code><div class="sig_block"><pre><span class="keyword">type</span> <a name="TYPEelt"></a><code class="type"></code>elt </pre>
-
-<pre><span class="keyword">type</span> <a name="TYPEt"></a><code class="type"></code>t </pre>
-
-<pre><span class="keyword">val</span> <a name="VALfold"></a>fold : <code class="type">(elt -> 'a -> 'a) -><br> t -> 'a -> 'a</code></pre></div><code class="code">end</code><code class="code">) -> </code><code class="code">sig</code> <a href="Pretty.MakeSetPrinter.html">..</a> <code class="code">end</code></div></pre><div class="info">
-Format sets.
-</div>
-<pre><span class="keyword">val</span> <a name="VALinsert"></a>insert : <code class="type">unit -> <a href="Pretty.html#TYPEdoc">doc</a> -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
-A function that is useful with the <code class="code">printf</code>-like interface<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALdprintf"></a>dprintf : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">doc</a>, <a href="Pretty.html#TYPEdoc">doc</a>) format4 -> 'a</code></pre><div class="info">
-This function provides an alternative method for constructing
- <code class="code">doc</code> objects. The first argument for this function is a format string
- argument (of type <code class="code">('a, unit, doc) format</code>; if you insist on
- understanding what that means see the module <code class="code">Printf</code>). The format string
- is like that for the <code class="code">printf</code> function in C, except that it understands a
- few more formatting controls, all starting with the @ character.
-<p>
-
- See the gprintf function if you want to pipe the result of dprintf into
- some other functions.
-<p>
-
- The following special formatting characters are understood (these do not
- correspond to arguments of the function):<ul>
-<li> @[ Inserts an <a href="Pretty.html#VALalign"><code class="code">Pretty.align</code></a>. Every format string must have matching
- <a href="Pretty.html#VALalign"><code class="code">Pretty.align</code></a> and <a href="Pretty.html#VALunalign"><code class="code">Pretty.unalign</code></a>. </li>
-<li> @] Inserts an <a href="Pretty.html#VALunalign"><code class="code">Pretty.unalign</code></a>.</li>
-<li> @! Inserts a <a href="Pretty.html#VALline"><code class="code">Pretty.line</code></a>. Just like "\n"</li>
-<li> @? Inserts a <a href="Pretty.html#VALbreak"><code class="code">Pretty.break</code></a>.</li>
-<li> @< Inserts a <a href="Pretty.html#VALmark"><code class="code">Pretty.mark</code></a>. </li>
-<li> @> Inserts a <a href="Pretty.html#VALunmark"><code class="code">Pretty.unmark</code></a>.</li>
-<li> @^ Inserts a <a href="Pretty.html#VALleftflush"><code class="code">Pretty.leftflush</code></a>
- Should be used immediately after @! or "\n".</li>
-<li> @@ : inserts a @ character</li>
-</ul>
-
- In addition to the usual <code class="code">printf</code> % formatting characters the following two
- new characters are supported:<ul>
-<li>%t Corresponds to an argument of type <code class="code">unit -> doc</code>. This argument is
- invoked to produce a document</li>
-<li>%a Corresponds to <b>two</b> arguments. The first of type <code class="code">unit -> 'a -> doc</code>
- and the second of type <code class="code">'a</code>. (The extra <code class="code">unit</code> is do to the
- peculiarities of the built-in support for format strings in Ocaml. It
- turns out that it is not a major problem.) Here is an example of how
- you use this:</li>
-</ul>
-
-<pre>dprintf "Name=%s, SSN=%7d, Children=@[%a@]\n"
- pers.name pers.ssn (docList (chr ',' ++ break) text)
- pers.children</pre>
-<p>
-
- The result of <code class="code">dprintf</code> is a <a href="Pretty.html#TYPEdoc"><code class="code">Pretty.doc</code></a>. You can format the document and
- emit it using the functions <a href="Pretty.html#VALfprint"><code class="code">Pretty.fprint</code></a> and <a href="Pretty.html#VALsprint"><code class="code">Pretty.sprint</code></a>.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALgprintf"></a>gprintf : <code class="type">(<a href="Pretty.html#TYPEdoc">doc</a> -> 'a) -> ('b, unit, <a href="Pretty.html#TYPEdoc">doc</a>, 'a) format4 -> 'b</code></pre><div class="info">
-Like <a href="Pretty.html#VALdprintf"><code class="code">Pretty.dprintf</code></a> but more general. It also takes a function that is
- invoked on the constructed document but before any formatting is done. The
- type of the format argument means that 'a is the type of the parameters of
- this function, unit is the type of the first argument to %a and %t
- formats, doc is the type of the intermediate result, and 'b is the type of
- the result of gprintf.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALfprint"></a>fprint : <code class="type">Pervasives.out_channel -> width:int -> <a href="Pretty.html#TYPEdoc">doc</a> -> unit</code></pre><div class="info">
-Format the document to the given width and emit it to the given channel<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALsprint"></a>sprint : <code class="type">width:int -> <a href="Pretty.html#TYPEdoc">doc</a> -> string</code></pre><div class="info">
-Format the document to the given width and emit it as a string<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALfprintf"></a>fprintf : <code class="type">Pervasives.out_channel -> ('a, unit, <a href="Pretty.html#TYPEdoc">doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
-Like <a href="Pretty.html#VALdprintf"><code class="code">Pretty.dprintf</code></a> followed by <a href="Pretty.html#VALfprint"><code class="code">Pretty.fprint</code></a><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALprintf"></a>printf : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
-Like <a href="Pretty.html#VALfprintf"><code class="code">Pretty.fprintf</code></a> applied to <code class="code">stdout</code><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALeprintf"></a>eprintf : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
-Like <a href="Pretty.html#VALfprintf"><code class="code">Pretty.fprintf</code></a> applied to <code class="code">stderr</code><br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALwithPrintDepth"></a>withPrintDepth : <code class="type">int -> (unit -> unit) -> unit</code></pre><div class="info">
-Invokes a thunk, with printDepth temporarily set to the specified value<br>
-</div>
-<br>
-The following variables can be used to control the operation of the printer<br>
-<pre><span class="keyword">val</span> <a name="VALprintDepth"></a>printDepth : <code class="type">int Pervasives.ref</code></pre><div class="info">
-Specifies the nesting depth of the <code class="code">align</code>/<code class="code">unalign</code> pairs at which
- everything is replaced with ellipsis<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALprintIndent"></a>printIndent : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-If false then does not indent<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALfastMode"></a>fastMode : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-If set to <code class="code">true</code> then optional breaks are taken only when the document
- has exceeded the given width. This means that the printout will looked
- more ragged but it will be faster<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALflushOften"></a>flushOften : <code class="type">bool Pervasives.ref</code></pre><div class="info">
-If true the it flushes after every print<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALcountNewLines"></a>countNewLines : <code class="type">int Pervasives.ref</code></pre><div class="info">
-Keep a running count of the taken newlines. You can read and write this
- from the client code if you want<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALauto_printer"></a>auto_printer : <code class="type">string -> 'a</code></pre><div class="info">
-A function that when used at top-level in a module will direct
- the pa_prtype module generate automatically the printing functions for a
- type<br>
-</div>
-</body></html>
\ No newline at end of file
diff --git a/cil/doc/api/Stats.html b/cil/doc/api/Stats.html
deleted file mode 100644
index b3f8aa4220391535834e61058c0a6157c3d6108e..0000000000000000000000000000000000000000
--- a/cil/doc/api/Stats.html
+++ /dev/null
@@ -1,69 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link rel="previous" href="Clist.html">
-<link rel="next" href="Cil.html">
-<link rel="Up" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Stats</title>
-</head>
-<body>
-<div class="navbar"><a href="Clist.html">Previous</a>
- <a href="index.html">Up</a>
- <a href="Cil.html">Next</a>
-</div>
-<center><h1>Module <a href="type_Stats.html">Stats</a></h1></center>
-<br>
-<pre><span class="keyword">module</span> Stats: <code class="code">sig</code> <a href="Stats.html">..</a> <code class="code">end</code></pre>Utilities for maintaining timing statistics<br>
-<hr width="100%">
-<pre><span class="keyword">val</span> <a name="VALreset"></a>reset : <code class="type">bool -> unit</code></pre><div class="info">
-Resets all the timings. Invoke with "true" if you want to switch to using
- the hardware performance counters from now on. You get an exception if
- there are not performance counters available<br>
-</div>
-<pre><span class="keyword">exception</span> <a name="EXCEPTIONNoPerfCount"></a>NoPerfCount</pre>
-<pre><span class="keyword">val</span> <a name="VALhas_performance_counters"></a>has_performance_counters : <code class="type">unit -> bool</code></pre><div class="info">
-Check if we have performance counters<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALsample_pentium_perfcount_20"></a>sample_pentium_perfcount_20 : <code class="type">unit -> int</code></pre><div class="info">
-Sample the current cycle count, in megacycles.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALsample_pentium_perfcount_10"></a>sample_pentium_perfcount_10 : <code class="type">unit -> int</code></pre><div class="info">
-Sample the current cycle count, in kilocycles.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALtime"></a>time : <code class="type">string -> ('a -> 'b) -> 'a -> 'b</code></pre><div class="info">
-Time a function and associate the time with the given string. If some
- timing information is already associated with that string, then accumulate
- the times. If this function is invoked within another timed function then
- you can have a hierarchy of timings<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALrepeattime"></a>repeattime : <code class="type">float -> string -> ('a -> 'b) -> 'a -> 'b</code></pre><div class="info">
-repeattime is like time but runs the function several times until the total
- running time is greater or equal to the first argument. The total time is
- then divided by the number of times the function was run.<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALprint"></a>print : <code class="type">Pervasives.out_channel -> string -> unit</code></pre><div class="info">
-Print the current stats preceeded by a message<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALlastTime"></a>lastTime : <code class="type">float Pervasives.ref</code></pre><div class="info">
-Time a function and set lastTime to the time it took<br>
-</div>
-<pre><span class="keyword">val</span> <a name="VALtimethis"></a>timethis : <code class="type">('a -> 'b) -> 'a -> 'b</code></pre></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/index.html b/cil/doc/api/index.html
deleted file mode 100644
index f9636b27f9e13aa0ade45a029cb3759432f73d7b..0000000000000000000000000000000000000000
--- a/cil/doc/api/index.html
+++ /dev/null
@@ -1,83 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5)</title>
-</head>
-<body>
-<center><h1>CIL API Documentation (version 1.3.5)</h1></center>
-<a href="index_types.html">Index of types</a><br>
-<a href="index_exceptions.html">Index of exceptions</a><br>
-<a href="index_values.html">Index of values</a><br>
-<a href="index_methods.html">Index of class methods</a><br>
-<a href="index_classes.html">Index of classes</a><br>
-<a href="index_class_types.html">Index of class types</a><br>
-<a href="index_modules.html">Index of modules</a><br>
-<a href="index_module_types.html">Index of module types</a><br>
-<br/><br>
-<table class="indextable">
-<tr><td><a href="Pretty.html">Pretty</a></td><td><div class="info">
-Utility functions for pretty-printing.
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html">Errormsg</a></td><td><div class="info">
-Utility functions for error-reporting
-</div>
-</td></tr>
-<tr><td><a href="Clist.html">Clist</a></td><td><div class="info">
-Utilities for managing "concatenable lists" (clists).
-</div>
-</td></tr>
-<tr><td><a href="Stats.html">Stats</a></td><td><div class="info">
-Utilities for maintaining timing statistics
-</div>
-</td></tr>
-<tr><td><a href="Cil.html">Cil</a></td><td><div class="info">
-CIL API Documentation.
-</div>
-</td></tr>
-<tr><td><a href="Formatcil.html">Formatcil</a></td><td><div class="info">
-<b>An Interpreter for constructing CIL constructs</b>
-</div>
-</td></tr>
-<tr><td><a href="Alpha.html">Alpha</a></td><td><div class="info">
-<b>ALPHA conversion</b>
-</div>
-</td></tr>
-<tr><td><a href="Cillower.html">Cillower</a></td><td><div class="info">
-A number of lowering passes over CIL
-</div>
-</td></tr>
-<tr><td><a href="Cfg.html">Cfg</a></td><td><div class="info">
-Code to compute the control-flow graph of a function or file.
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.html">Dataflow</a></td><td><div class="info">
-A framework for data flow analysis for CIL code.
-</div>
-</td></tr>
-<tr><td><a href="Dominators.html">Dominators</a></td><td><div class="info">
-Compute dominators using data flow analysis
-</div>
-</td></tr>
-</table>
-</body>
-</html>
\ No newline at end of file
diff --git a/cil/doc/api/index_attributes.html b/cil/doc/api/index_attributes.html
deleted file mode 100644
index 347bfa92a4594891304fa492c3e77a6f09146ed9..0000000000000000000000000000000000000000
--- a/cil/doc/api/index_attributes.html
+++ /dev/null
@@ -1,30 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of class attributes</title>
-</head>
-<body>
-<center><h1>Index of class attributes</h1></center>
-<table>
-</table><br>
-</body>
-</html>
\ No newline at end of file
diff --git a/cil/doc/api/index_class_types.html b/cil/doc/api/index_class_types.html
deleted file mode 100644
index 4c7faefeffa2acd8d0ea7c16718ea1f62da82485..0000000000000000000000000000000000000000
--- a/cil/doc/api/index_class_types.html
+++ /dev/null
@@ -1,41 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of class types</title>
-</head>
-<body>
-<center><h1>Index of class types</h1></center>
-<table>
-<tr><td align="left"><br>C</td></tr>
-<tr><td><a href="Cil.cilPrinter.html">cilPrinter</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-A printer interface for CIL trees.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilVisitor.html">cilVisitor</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-A visitor interface for traversing CIL trees.
-</div>
-</td></tr>
-</table><br>
-</body>
-</html>
\ No newline at end of file
diff --git a/cil/doc/api/index_classes.html b/cil/doc/api/index_classes.html
deleted file mode 100644
index 1a5ba7d4047ea494eed7897ec46e1b4bedeae1d0..0000000000000000000000000000000000000000
--- a/cil/doc/api/index_classes.html
+++ /dev/null
@@ -1,46 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of classes</title>
-</head>
-<body>
-<center><h1>Index of classes</h1></center>
-<table>
-<tr><td align="left"><br>D</td></tr>
-<tr><td><a href="Cil.defaultCilPrinterClass.html">defaultCilPrinterClass</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td align="left"><br>N</td></tr>
-<tr><td><a href="Cil.nopCilVisitor.html">nopCilVisitor</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Default Visitor.
-</div>
-</td></tr>
-<tr><td align="left"><br>P</td></tr>
-<tr><td><a href="Cil.plainCilPrinterClass.html">plainCilPrinterClass</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-These are pretty-printers that will show you more details on the internal
- CIL representation, without trying hard to make it look like C
-</div>
-</td></tr>
-</table><br>
-</body>
-</html>
\ No newline at end of file
diff --git a/cil/doc/api/index_exceptions.html b/cil/doc/api/index_exceptions.html
deleted file mode 100644
index e774a65a4133172fdc9c64189705c6c08c58cdfa..0000000000000000000000000000000000000000
--- a/cil/doc/api/index_exceptions.html
+++ /dev/null
@@ -1,53 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of exceptions</title>
-</head>
-<body>
-<center><h1>Index of exceptions</h1></center>
-<table>
-<tr><td align="left"><br>E</td></tr>
-<tr><td><a href="Errormsg.html#EXCEPTIONError">Error</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-Error reporting functions raise this exception
-</div>
-</td></tr>
-<tr><td align="left"><br>L</td></tr>
-<tr><td><a href="Cil.html#EXCEPTIONLenOfArray">LenOfArray</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Raised when <a href="Cil.html#VALlenOfArray"><code class="code">Cil.lenOfArray</code></a> fails either because the length is <code class="code">None</code>
- or because it is a non-constant expression
-</div>
-</td></tr>
-<tr><td align="left"><br>N</td></tr>
-<tr><td><a href="Stats.html#EXCEPTIONNoPerfCount">NoPerfCount</a> [<a href="Stats.html">Stats</a>]</td>
-<td></td></tr>
-<tr><td align="left"><br>S</td></tr>
-<tr><td><a href="Cil.html#EXCEPTIONSizeOfError">SizeOfError</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Raised when one of the bitsSizeOf functions cannot compute the size of a
- type.
-</div>
-</td></tr>
-</table><br>
-</body>
-</html>
\ No newline at end of file
diff --git a/cil/doc/api/index_methods.html b/cil/doc/api/index_methods.html
deleted file mode 100644
index 1558de3ef9e6c3cb46cc8e847ab4144fa2790ac6..0000000000000000000000000000000000000000
--- a/cil/doc/api/index_methods.html
+++ /dev/null
@@ -1,228 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of class methods</title>
-</head>
-<body>
-<center><h1>Index of class methods</h1></center>
-<table>
-<tr><td align="left"><br>D</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODdBlock">dBlock</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Dump a control-flow block to a file with a given indentation.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODdGlobal">dGlobal</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Dump a global to a file with a given indentation.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODdInit">dInit</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Dump a global to a file with a given indentation.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODdStmt">dStmt</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Dump a control-flow statement to a file with a given indentation.
-</div>
-</td></tr>
-<tr><td align="left"><br>P</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpAttr">pAttr</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Attribute.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpAttrParam">pAttrParam</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Attribute parameter
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpAttrs">pAttrs</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Attribute lists
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpBlock">pBlock</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpExp">pExp</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Print expressions
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpFieldDecl">pFieldDecl</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-A field declaration
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpGlobal">pGlobal</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Global (vars, types, etc.).
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpInit">pInit</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Print initializers.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpInstr">pInstr</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Invoked on each instruction occurrence.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpLabel">pLabel</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Print a label.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpLineDirective">pLineDirective</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Print a line-number.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpLval">pLval</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Invoked on each lvalue occurrence
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpOffset">pOffset</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Invoked on each offset occurrence.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpStmt">pStmt</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Control-flow statement.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpStmtKind">pStmtKind</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Print a statement kind.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpType">pType</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpVDecl">pVDecl</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Invoked for each variable declaration.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilPrinter.html#METHODpVar">pVar</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
-<td><div class="info">
-Invoked on each variable use.
-</div>
-</td></tr>
-<tr><td align="left"><br>Q</td></tr>
-<tr><td><a href="Cil.cilVisitor.html#METHODqueueInstr">queueInstr</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
-<td><div class="info">
-Add here instructions while visiting to queue them to preceede the
- current statement or instruction being processed.
-</div>
-</td></tr>
-<tr><td align="left"><br>U</td></tr>
-<tr><td><a href="Cil.cilVisitor.html#METHODunqueueInstr">unqueueInstr</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
-<td><div class="info">
-Gets the queue of instructions and resets the queue.
-</div>
-</td></tr>
-<tr><td align="left"><br>V</td></tr>
-<tr><td><a href="Cil.cilVisitor.html#METHODvattr">vattr</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
-<td><div class="info">
-Attribute.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilVisitor.html#METHODvattrparam">vattrparam</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
-<td><div class="info">
-Attribute parameters.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilVisitor.html#METHODvblock">vblock</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
-<td><div class="info">
-Block.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilVisitor.html#METHODvexpr">vexpr</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
-<td><div class="info">
-Invoked on each expression occurrence.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilVisitor.html#METHODvfunc">vfunc</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
-<td><div class="info">
-Function definition.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilVisitor.html#METHODvglob">vglob</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
-<td><div class="info">
-Global (vars, types,
- etc.)
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilVisitor.html#METHODvinit">vinit</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
-<td><div class="info">
-Initializers for globals
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilVisitor.html#METHODvinitoffs">vinitoffs</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
-<td><div class="info">
-Invoked on each offset appearing in the list of a
- CompoundInit initializer.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilVisitor.html#METHODvinst">vinst</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
-<td><div class="info">
-Invoked on each instruction occurrence.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilVisitor.html#METHODvlval">vlval</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
-<td><div class="info">
-Invoked on each lvalue occurrence
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilVisitor.html#METHODvoffs">voffs</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
-<td><div class="info">
-Invoked on each offset occurrence that is *not* as part
- of an initializer list specification, i.e.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilVisitor.html#METHODvstmt">vstmt</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
-<td><div class="info">
-Control-flow statement.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilVisitor.html#METHODvtype">vtype</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
-<td><div class="info">
-Use of some type.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilVisitor.html#METHODvvdec">vvdec</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
-<td><div class="info">
-Invoked for each variable declaration.
-</div>
-</td></tr>
-<tr><td><a href="Cil.cilVisitor.html#METHODvvrbl">vvrbl</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
-<td><div class="info">
-Invoked on each variable use.
-</div>
-</td></tr>
-</table><br>
-</body>
-</html>
\ No newline at end of file
diff --git a/cil/doc/api/index_module_types.html b/cil/doc/api/index_module_types.html
deleted file mode 100644
index 244d402775f1854ea1b276378d0771b625515aa3..0000000000000000000000000000000000000000
--- a/cil/doc/api/index_module_types.html
+++ /dev/null
@@ -1,36 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of module types</title>
-</head>
-<body>
-<center><h1>Index of module types</h1></center>
-<table>
-<tr><td align="left"><br>B</td></tr>
-<tr><td><a href="Dataflow.BackwardsTransfer.html">BackwardsTransfer</a> [<a href="Dataflow.html">Dataflow</a>]</td>
-<td></td></tr>
-<tr><td align="left"><br>F</td></tr>
-<tr><td><a href="Dataflow.ForwardsTransfer.html">ForwardsTransfer</a> [<a href="Dataflow.html">Dataflow</a>]</td>
-<td></td></tr>
-</table><br>
-</body>
-</html>
\ No newline at end of file
diff --git a/cil/doc/api/index_modules.html b/cil/doc/api/index_modules.html
deleted file mode 100644
index 090693f57496c613648d025fff6a52b72a232c77..0000000000000000000000000000000000000000
--- a/cil/doc/api/index_modules.html
+++ /dev/null
@@ -1,108 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of modules</title>
-</head>
-<body>
-<center><h1>Index of modules</h1></center>
-<table>
-<tr><td align="left"><br>A</td></tr>
-<tr><td><a href="Alpha.html">Alpha</a> </td>
-<td><div class="info">
-<b>ALPHA conversion</b>
-</div>
-</td></tr>
-<tr><td align="left"><br>B</td></tr>
-<tr><td><a href="Dataflow.BackwardsDataFlow.html">BackwardsDataFlow</a> [<a href="Dataflow.html">Dataflow</a>]</td>
-<td></td></tr>
-<tr><td align="left"><br>C</td></tr>
-<tr><td><a href="Cfg.html">Cfg</a> </td>
-<td><div class="info">
-Code to compute the control-flow graph of a function or file.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html">Cil</a> </td>
-<td><div class="info">
-CIL API Documentation.
-</div>
-</td></tr>
-<tr><td><a href="Cillower.html">Cillower</a> </td>
-<td><div class="info">
-A number of lowering passes over CIL
-</div>
-</td></tr>
-<tr><td><a href="Clist.html">Clist</a> </td>
-<td><div class="info">
-Utilities for managing "concatenable lists" (clists).
-</div>
-</td></tr>
-<tr><td align="left"><br>D</td></tr>
-<tr><td><a href="Dataflow.html">Dataflow</a> </td>
-<td><div class="info">
-A framework for data flow analysis for CIL code.
-</div>
-</td></tr>
-<tr><td><a href="Dominators.html">Dominators</a> </td>
-<td><div class="info">
-Compute dominators using data flow analysis
-</div>
-</td></tr>
-<tr><td align="left"><br>E</td></tr>
-<tr><td><a href="Errormsg.html">Errormsg</a> </td>
-<td><div class="info">
-Utility functions for error-reporting
-</div>
-</td></tr>
-<tr><td align="left"><br>F</td></tr>
-<tr><td><a href="Formatcil.html">Formatcil</a> </td>
-<td><div class="info">
-<b>An Interpreter for constructing CIL constructs</b>
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.ForwardsDataFlow.html">ForwardsDataFlow</a> [<a href="Dataflow.html">Dataflow</a>]</td>
-<td></td></tr>
-<tr><td align="left"><br>M</td></tr>
-<tr><td><a href="Pretty.MakeMapPrinter.html">MakeMapPrinter</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Format maps.
-</div>
-</td></tr>
-<tr><td><a href="Pretty.MakeSetPrinter.html">MakeSetPrinter</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Format sets.
-</div>
-</td></tr>
-<tr><td align="left"><br>P</td></tr>
-<tr><td><a href="Pretty.html">Pretty</a> </td>
-<td><div class="info">
-Utility functions for pretty-printing.
-</div>
-</td></tr>
-<tr><td align="left"><br>S</td></tr>
-<tr><td><a href="Stats.html">Stats</a> </td>
-<td><div class="info">
-Utilities for maintaining timing statistics
-</div>
-</td></tr>
-</table><br>
-</body>
-</html>
\ No newline at end of file
diff --git a/cil/doc/api/index_types.html b/cil/doc/api/index_types.html
deleted file mode 100644
index 1974acd6ace38ff6a88a70b697658be47f19fd8c..0000000000000000000000000000000000000000
--- a/cil/doc/api/index_types.html
+++ /dev/null
@@ -1,271 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of types</title>
-</head>
-<body>
-<center><h1>Index of types</h1></center>
-<table>
-<tr><td align="left"><br>A</td></tr>
-<tr><td><a href="Dataflow.html#TYPEaction">action</a> [<a href="Dataflow.html">Dataflow</a>]</td>
-<td></td></tr>
-<tr><td><a href="Alpha.html#TYPEalphaTableData">alphaTableData</a> [<a href="Alpha.html">Alpha</a>]</td>
-<td><div class="info">
-This is the type of the elements of the alpha renaming table.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEattribute">attribute</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#TYPEattributeClass">attributeClass</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Various classes of attributes
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEattributes">attributes</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Attributes are lists sorted by the attribute name.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEattrparam">attrparam</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-The type of parameters of attributes
-</div>
-</td></tr>
-<tr><td align="left"><br>B</td></tr>
-<tr><td><a href="Cil.html#TYPEbinop">binop</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Binary operations
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEblock">block</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-A block is a sequence of statements with the control falling through from
- one element to the next
-</div>
-</td></tr>
-<tr><td align="left"><br>C</td></tr>
-<tr><td><a href="Clist.html#TYPEclist">clist</a> [<a href="Clist.html">Clist</a>]</td>
-<td><div class="info">
-The clist datatype.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEcomment">comment</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#TYPEcompinfo">compinfo</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-The definition of a structure or union type.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEconstant">constant</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Literal constants
-</div>
-</td></tr>
-<tr><td align="left"><br>D</td></tr>
-<tr><td><a href="Pretty.html#TYPEdoc">doc</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-The type of unformated documents.
-</div>
-</td></tr>
-<tr><td align="left"><br>E</td></tr>
-<tr><td><a href="Cil.html#TYPEenuminfo">enuminfo</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Information about an enumeration
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEexistsAction">existsAction</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-A datatype to be used in conjunction with <code class="code">existsType</code>
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEexp">exp</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Expressions (Side-effect free)
-</div>
-</td></tr>
-<tr><td align="left"><br>F</td></tr>
-<tr><td><a href="Cil.html#TYPEfeatureDescr">featureDescr</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-To be able to add/remove features easily, each feature should be package
- as an interface with the following interface.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEfieldinfo">fieldinfo</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Information about a struct/union field
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEfile">file</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Top-level representation of a C source file
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEfkind">fkind</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Various kinds of floating-point numbers
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEformatArg">formatArg</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-The type of argument for the interpreter
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEfundec">fundec</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Function definitions.
-</div>
-</td></tr>
-<tr><td align="left"><br>G</td></tr>
-<tr><td><a href="Cil.html#TYPEglobal">global</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-A global declaration or definition
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.html#TYPEguardaction">guardaction</a> [<a href="Dataflow.html">Dataflow</a>]</td>
-<td></td></tr>
-<tr><td align="left"><br>I</td></tr>
-<tr><td><a href="Cil.html#TYPEikind">ikind</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Various kinds of integers
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEinit">init</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Initializers for global variables.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEinitinfo">initinfo</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-We want to be able to update an initializer in a global variable, so we
- define it as a mutable field
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEinstr">instr</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Instructions.
-</div>
-</td></tr>
-<tr><td align="left"><br>L</td></tr>
-<tr><td><a href="Cil.html#TYPElabel">label</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Labels
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPElhost">lhost</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-The host part of an <a href="Cil.html#TYPElval"><code class="code">Cil.lval</code></a>.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPElineDirectiveStyle">lineDirectiveStyle</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Styles of printing line directives
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPElocation">location</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Describes a location in a source file.
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#TYPElocation">location</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-Type for source-file locations
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPElval">lval</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-An lvalue
-</div>
-</td></tr>
-<tr><td align="left"><br>O</td></tr>
-<tr><td><a href="Cil.html#TYPEoffset">offset</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-The offset part of an <a href="Cil.html#TYPElval"><code class="code">Cil.lval</code></a>.
-</div>
-</td></tr>
-<tr><td align="left"><br>S</td></tr>
-<tr><td><a href="Cil.html#TYPEstmt">stmt</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Statements.
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.html#TYPEstmtaction">stmtaction</a> [<a href="Dataflow.html">Dataflow</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#TYPEstmtkind">stmtkind</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-The various kinds of control-flow statements statements
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEstorage">storage</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Storage-class information
-</div>
-</td></tr>
-<tr><td align="left"><br>T</td></tr>
-<tr><td><a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
-<td><div class="info">
-The type of the data we compute for each block start.
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
-<td><div class="info">
-The type of the data we compute for each block start.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEtyp">typ</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#TYPEtypeinfo">typeinfo</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Information about a defined type
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEtypsig">typsig</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Type signatures.
-</div>
-</td></tr>
-<tr><td align="left"><br>U</td></tr>
-<tr><td><a href="Alpha.html#TYPEundoAlphaElement">undoAlphaElement</a> [<a href="Alpha.html">Alpha</a>]</td>
-<td><div class="info">
-This is the type of the elements that are recorded by the alpha
- conversion functions in order to be able to undo changes to the tables
- they modify.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEunop">unop</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Unary operators
-</div>
-</td></tr>
-<tr><td align="left"><br>V</td></tr>
-<tr><td><a href="Cil.html#TYPEvarinfo">varinfo</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Information about a variable.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#TYPEvisitAction">visitAction</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Different visiting actions.
-</div>
-</td></tr>
-</table><br>
-</body>
-</html>
\ No newline at end of file
diff --git a/cil/doc/api/index_values.html b/cil/doc/api/index_values.html
deleted file mode 100644
index 799daafde74e26b186a713e3e087d133c77f762e..0000000000000000000000000000000000000000
--- a/cil/doc/api/index_values.html
+++ /dev/null
@@ -1,1964 +0,0 @@
-<html>
-<head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of values</title>
-</head>
-<body>
-<center><h1>Index of values</h1></center>
-<table>
-<tr><td align="left"><br></td></tr>
-<tr><td><a href="Pretty.html#VAL(++)">(++)</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Concatenates two documents.
-</div>
-</td></tr>
-<tr><td align="left"><br>A</td></tr>
-<tr><td><a href="Cil.html#VALaddAttribute">addAttribute</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Add an attribute.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALaddAttributes">addAttributes</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Add a list of attributes.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALaddOffset">addOffset</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-<code class="code">addOffset o1 o2</code> adds <code class="code">o1</code> to the end of <code class="code">o2</code>.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALaddOffsetLval">addOffsetLval</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Add an offset at the end of an lvalue.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALadditiveLevel">additiveLevel</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALaddrOfLevel">addrOfLevel</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Pretty.html#VALalign">align</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Mark the current column as the current indentation level.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALalignOf_int">alignOf_int</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-The minimum alignment (in bytes) for a type.
-</div>
-</td></tr>
-<tr><td><a href="Clist.html#VALappend">append</a> [<a href="Clist.html">Clist</a>]</td>
-<td><div class="info">
-Append two clists
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALargsToList">argsToList</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Obtain the argument list ([] if None)
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALarrowLevel">arrowLevel</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALattributeHash">attributeHash</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-This table contains the mapping of predefined attributes to classes.
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALauto_printer">auto_printer</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-A function that when used at top-level in a module will direct
- the pa_prtype module generate automatically the printing functions for a
- type
-</div>
-</td></tr>
-<tr><td align="left"><br>B</td></tr>
-<tr><td><a href="Cil.html#VALbitsOffset">bitsOffset</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Give a type of a base and an offset, returns the number of bits from the
- base address and the width (also expressed in bits) for the subobject
- denoted by the offset.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALbitsSizeOf">bitsSizeOf</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-The size of a type, in bits.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALbitwiseLevel">bitwiseLevel</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Pretty.html#VALbreak">break</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-A document that consists of either a space or a line break.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALbug">bug</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Like <a href="Errormsg.html#VALbug"><code class="code">Errormsg.bug</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is also printed
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALbug">bug</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-Similar to <code class="code">error</code> except that its output has the form <code class="code">Bug: ...</code>
-</div>
-</td></tr>
-<tr><td align="left"><br>C</td></tr>
-<tr><td><a href="Formatcil.html#VALcExp">cExp</a> [<a href="Formatcil.html">Formatcil</a>]</td>
-<td><div class="info">
-Constructs an expression based on the program and the list of arguments.
-</div>
-</td></tr>
-<tr><td><a href="Formatcil.html#VALcInstr">cInstr</a> [<a href="Formatcil.html">Formatcil</a>]</td>
-<td><div class="info">
-Constructs an instruction based on the program and the list of arguments.
-</div>
-</td></tr>
-<tr><td><a href="Formatcil.html#VALcLval">cLval</a> [<a href="Formatcil.html">Formatcil</a>]</td>
-<td><div class="info">
-Constructs an lval based on the program and the list of arguments.
-</div>
-</td></tr>
-<tr><td><a href="Formatcil.html#VALcStmt">cStmt</a> [<a href="Formatcil.html">Formatcil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Formatcil.html#VALcStmts">cStmts</a> [<a href="Formatcil.html">Formatcil</a>]</td>
-<td><div class="info">
-Constructs a list of statements
-</div>
-</td></tr>
-<tr><td><a href="Formatcil.html#VALcType">cType</a> [<a href="Formatcil.html">Formatcil</a>]</td>
-<td><div class="info">
-Constructs a type based on the program and the list of arguments.
-</div>
-</td></tr>
-<tr><td><a href="Cfg.html#VALcfgFun">cfgFun</a> [<a href="Cfg.html">Cfg</a>]</td>
-<td><div class="info">
-Compute a control flow graph for fd.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALcharConstPtrType">charConstPtrType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-char const *
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALcharConstToInt">charConstToInt</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Given the character c in a (CChr c), sign-extend it to 32 bits.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALcharPtrType">charPtrType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-char *
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALcharType">charType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-char
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALchar_is_unsigned">char_is_unsigned</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Whether "char" is unsigned.
-</div>
-</td></tr>
-<tr><td><a href="Clist.html#VALcheckBeforeAppend">checkBeforeAppend</a> [<a href="Clist.html">Clist</a>]</td>
-<td><div class="info">
-A useful check to assert before an append.
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALchr">chr</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-A document that prints a character.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALcilVersion">cilVersion</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-This are the CIL version numbers.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALcilVersionMajor">cilVersionMajor</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALcilVersionMinor">cilVersionMinor</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALcilVersionRevision">cilVersionRevision</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cfg.html#VALclearCFGinfo">clearCFGinfo</a> [<a href="Cfg.html">Cfg</a>]</td>
-<td><div class="info">
-clear the sid, succs, and preds fields of each statment in a function
-</div>
-</td></tr>
-<tr><td><a href="Cfg.html#VALclearFileCFG">clearFileCFG</a> [<a href="Cfg.html">Cfg</a>]</td>
-<td><div class="info">
-clear the sid, succs, and preds fields of each statement.
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.ForwardsTransfer.html#VALcombinePredecessors">combinePredecessors</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
-<td><div class="info">
-Take some old data for the start of a statement, and some new data for
- the same point.
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.BackwardsTransfer.html#VALcombineStmtStartData">combineStmtStartData</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
-<td><div class="info">
-When the analysis reaches the start of a block, combine the old data
- with the one we have just computed.
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.BackwardsTransfer.html#VALcombineSuccessors">combineSuccessors</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
-<td><div class="info">
-Take the data from two successors and combine it
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALcompFullName">compFullName</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Get the full name of a comp
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALcompactStmts">compactStmts</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Try to compress statements so as to get maximal basic blocks
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALcomparativeLevel">comparativeLevel</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALcompareLoc">compareLoc</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Comparison function for locations.
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.BackwardsDataFlow.html#VALcompute">compute</a> [<a href="Dataflow.BackwardsDataFlow.html">Dataflow.BackwardsDataFlow</a>]</td>
-<td><div class="info">
-Fill in the T.stmtStartData, given a number of initial statements to
- start from (the sinks for the backwards data flow).
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.ForwardsDataFlow.html#VALcompute">compute</a> [<a href="Dataflow.ForwardsDataFlow.html">Dataflow.ForwardsDataFlow</a>]</td>
-<td><div class="info">
-Fill in the T.stmtStartData, given a number of initial statements to
- start from.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALcomputeCFGInfo">computeCFGInfo</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Compute the CFG information for all statements in a fundec and return a
- list of the statements.
-</div>
-</td></tr>
-<tr><td><a href="Cfg.html#VALcomputeFileCFG">computeFileCFG</a> [<a href="Cfg.html">Cfg</a>]</td>
-<td><div class="info">
-Compute the CFG for an entire file, by calling cfgFun on each function.
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.ForwardsTransfer.html#VALcomputeFirstPredecessor">computeFirstPredecessor</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
-<td><div class="info">
-Give the first value for a predecessors, compute the value to be set
- for the block
-</div>
-</td></tr>
-<tr><td><a href="Dominators.html#VALcomputeIDom">computeIDom</a> [<a href="Dominators.html">Dominators</a>]</td>
-<td><div class="info">
-Invoke on a code after filling in the CFG info and it computes the
- immediate dominator information.
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALconcat">concat</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALconstFold">constFold</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Do constant folding on an expression.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALconstFoldBinOp">constFoldBinOp</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Do constant folding on a binary operation.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALconstFoldVisitor">constFoldVisitor</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-A visitor that does constant folding.
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.ForwardsTransfer.html#VALcopy">copy</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
-<td><div class="info">
-Make a deep copy of the data
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALcopyCompInfo">copyCompInfo</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Makes a shallow copy of a <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> changing the name and the key.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALcopyFunction">copyFunction</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Create a deep copy of a function.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALcopyVarinfo">copyVarinfo</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Make a shallow copy of a <code class="code">varinfo</code> and assign a new identifier
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALcountNewLines">countNewLines</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Keep a running count of the taken newlines.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALcurrentGlobal">currentGlobal</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-A reference to the current global being visited
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALcurrentLoc">currentLoc</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-A reference to the current location.
-</div>
-</td></tr>
-<tr><td align="left"><br>D</td></tr>
-<tr><td><a href="Formatcil.html#VALdExp">dExp</a> [<a href="Formatcil.html">Formatcil</a>]</td>
-<td><div class="info">
-Deconstructs an expression based on the program.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALdExp">dExp</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Generate an <a href="Cil.html#TYPEexp"><code class="code">Cil.exp</code></a> to be used in case of errors.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALdGlobal">dGlobal</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Generate a <a href="Cil.html#TYPEglobal"><code class="code">Cil.global</code></a> to be used in case of errors.
-</div>
-</td></tr>
-<tr><td><a href="Formatcil.html#VALdInstr">dInstr</a> [<a href="Formatcil.html">Formatcil</a>]</td>
-<td><div class="info">
-Deconstructs an instruction based on the program.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALdInstr">dInstr</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Generate an <a href="Cil.html#TYPEinstr"><code class="code">Cil.instr</code></a> to be used in case of errors.
-</div>
-</td></tr>
-<tr><td><a href="Formatcil.html#VALdLval">dLval</a> [<a href="Formatcil.html">Formatcil</a>]</td>
-<td><div class="info">
-Deconstructs an lval based on the program.
-</div>
-</td></tr>
-<tr><td><a href="Formatcil.html#VALdType">dType</a> [<a href="Formatcil.html">Formatcil</a>]</td>
-<td><div class="info">
-Deconstructs a type based on the program.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_attr">d_attr</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print an attribute using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_attrlist">d_attrlist</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print a list of attributes using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_attrparam">d_attrparam</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print an argument of an attribute using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_binop">d_binop</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print a binary operator
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_block">d_block</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print a block using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_const">d_const</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print a constant
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_exp">d_exp</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print an expression using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_fkind">d_fkind</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print a floating-point kind
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_formatarg">d_formatarg</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-prints a format arg
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_global">d_global</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print the internal representation of a global using
- <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>.
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALd_hloc">d_hloc</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALd_ikind">d_ikind</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print an integer of a given kind
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_init">d_init</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print an initializer using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_instr">d_instr</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print an instruction using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALd_int32">d_int32</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Print an int32
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALd_int64">d_int64</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALd_label">d_label</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print a label using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALd_list">d_list</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-sm: Yet another list printer.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_loc">d_loc</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print a location
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALd_loc">d_loc</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALd_lval">d_lval</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print an lvalue using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>
-</div>
-</td></tr>
-<tr><td><a href="Pretty.MakeMapPrinter.html#VALd_map">d_map</a> [<a href="Pretty.MakeMapPrinter.html">Pretty.MakeMapPrinter</a>]</td>
-<td><div class="info">
-Format a map, analogous to d_list.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_offset">d_offset</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print an offset using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>, given the pretty
- printing for the base.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_plainexp">d_plainexp</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print the internal representation of an expression
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_plaininit">d_plaininit</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print the internal representation of an integer
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_plainlval">d_plainlval</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print the internal representation of an lvalue
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_plaintype">d_plaintype</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print the internal representation of a type
-</div>
-</td></tr>
-<tr><td><a href="Pretty.MakeSetPrinter.html#VALd_set">d_set</a> [<a href="Pretty.MakeSetPrinter.html">Pretty.MakeSetPrinter</a>]</td>
-<td><div class="info">
-Format a set, analogous to d_list.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_shortglobal">d_shortglobal</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print a short description of the global.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_stmt">d_stmt</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print a statement using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_storage">d_storage</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print storage-class information
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_thisloc">d_thisloc</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print the <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a>
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_type">d_type</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print a type using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_typsig">d_typsig</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Print a type signature
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALd_unop">d_unop</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print a unary operator
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.BackwardsTransfer.html#VALdebug">debug</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
-<td><div class="info">
-Whether to turn on debugging
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.ForwardsTransfer.html#VALdebug">debug</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
-<td><div class="info">
-Whether to turn on debugging
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALdebugFlag">debugFlag</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-If set then print debugging info
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALdefaultCilPrinter">defaultCilPrinter</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALderefStarLevel">derefStarLevel</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALdn_attr">dn_attr</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALdn_attrlist">dn_attrlist</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALdn_attrparam">dn_attrparam</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALdn_exp">dn_exp</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Versions of the above pretty printers, that don't print #line directives
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALdn_global">dn_global</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALdn_init">dn_init</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALdn_instr">dn_instr</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALdn_lval">dn_lval</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALdn_stmt">dn_stmt</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALdn_type">dn_type</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Dataflow.ForwardsTransfer.html#VALdoGuard">doGuard</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
-<td><div class="info">
-Generate the successor to an If statement assuming the given expression
- is nonzero.
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.BackwardsTransfer.html#VALdoInstr">doInstr</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
-<td><div class="info">
-The (backwards) transfer function for an instruction.
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.ForwardsTransfer.html#VALdoInstr">doInstr</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
-<td><div class="info">
-The (forwards) transfer function for an instruction.
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.BackwardsTransfer.html#VALdoStmt">doStmt</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
-<td><div class="info">
-The (backwards) transfer function for a branch.
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.ForwardsTransfer.html#VALdoStmt">doStmt</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
-<td><div class="info">
-The (forwards) transfer function for a statement.
-</div>
-</td></tr>
-<tr><td><a href="Alpha.html#VALdocAlphaTable">docAlphaTable</a> [<a href="Alpha.html">Alpha</a>]</td>
-<td><div class="info">
-Split the name in preparation for newAlphaName.
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALdocArray">docArray</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Formats an array.
-</div>
-</td></tr>
-<tr><td><a href="Clist.html#VALdocCList">docCList</a> [<a href="Clist.html">Clist</a>]</td>
-<td><div class="info">
-A document for printing a clist (similar to <code class="code">docList</code>)
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALdocList">docList</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-An alternative function for printing a list.
-</div>
-</td></tr>
-<tr><td><a href="Pretty.MakeMapPrinter.html#VALdocMap">docMap</a> [<a href="Pretty.MakeMapPrinter.html">Pretty.MakeMapPrinter</a>]</td>
-<td><div class="info">
-Format a map, analogous to docList.
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALdocOpt">docOpt</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Prints an <code class="code">'a option</code> with <code class="code">None</code> or <code class="code">Some</code>
-</div>
-</td></tr>
-<tr><td><a href="Pretty.MakeSetPrinter.html#VALdocSet">docSet</a> [<a href="Pretty.MakeSetPrinter.html">Pretty.MakeSetPrinter</a>]</td>
-<td><div class="info">
-Format a set, analogous to docList.
-</div>
-</td></tr>
-<tr><td><a href="Dominators.html#VALdominates">dominates</a> [<a href="Dominators.html">Dominators</a>]</td>
-<td><div class="info">
-Check whether one statement dominates another.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALdoubleType">doubleType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-double
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALdprintf">dprintf</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-This function provides an alternative method for constructing
- <code class="code">doc</code> objects.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALdropAttribute">dropAttribute</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Remove all attributes with the given name.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALdropAttributes">dropAttributes</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Remove all attributes with names appearing in the string list.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALdummyFile">dummyFile</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-A dummy file
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALdummyFunDec">dummyFunDec</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-A dummy function declaration handy when you need one as a placeholder.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALdummyInstr">dummyInstr</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-A instr to serve as a placeholder
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALdummyStmt">dummyStmt</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-A statement consisting of just <code class="code">dummyInstr</code>
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALdumpBlock">dumpBlock</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Dump a block to a file using a given indentation.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALdumpFile">dumpFile</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print an entire file.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALdumpGlobal">dumpGlobal</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Pretty-print a global.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALdumpInit">dumpInit</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Dump an initializer to a file using a given indentation.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALdumpStmt">dumpStmt</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Dump a statement to a file using a given indentation.
-</div>
-</td></tr>
-<tr><td align="left"><br>E</td></tr>
-<tr><td><a href="Clist.html#VALempty">empty</a> [<a href="Clist.html">Clist</a>]</td>
-<td><div class="info">
-The empty clist
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALemptyFunction">emptyFunction</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Make an empty function
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALeprintf">eprintf</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Like <a href="Pretty.html#VALfprintf"><code class="code">Pretty.fprintf</code></a> applied to <code class="code">stderr</code>
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALerror">error</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Like <a href="Errormsg.html#VALerror"><code class="code">Errormsg.error</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is also printed
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALerror">error</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-Prints an error message of the form <code class="code">Error: ...</code>.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALerrorLoc">errorLoc</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Like <a href="Cil.html#VALerror"><code class="code">Cil.error</code></a> except that it explicitly takes a location argument,
- instead of using the <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a>
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALexistsType">existsType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Scans a type by applying the function on all elements.
-</div>
-</td></tr>
-<tr><td align="left"><br>F</td></tr>
-<tr><td><a href="Pretty.html#VALf_int32">f_int32</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td></td></tr>
-<tr><td><a href="Pretty.html#VALf_int64">f_int64</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td></td></tr>
-<tr><td><a href="Pretty.html#VALfastMode">fastMode</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-If set to <code class="code">true</code> then optional breaks are taken only when the document
- has exceeded the given width.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALfilterAttributes">filterAttributes</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Retains attributes with the given name
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.BackwardsTransfer.html#VALfilterStmt">filterStmt</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
-<td><div class="info">
-Whether to put this predecessor block in the worklist.
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.ForwardsTransfer.html#VALfilterStmt">filterStmt</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
-<td><div class="info">
-Whether to put this statement in the worklist.
-</div>
-</td></tr>
-<tr><td><a href="Dominators.html#VALfindNaturalLoops">findNaturalLoops</a> [<a href="Dominators.html">Dominators</a>]</td>
-<td><div class="info">
-Compute the start of the natural loops.
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALfinishParsing">finishParsing</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td></td></tr>
-<tr><td><a href="Pretty.html#VALflushOften">flushOften</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-If true the it flushes after every print
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALfoldGlobals">foldGlobals</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Fold over all globals, including the global initializer
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALfoldLeftCompound">foldLeftCompound</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Fold over the list of initializers in a Compound.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALfoldLeftCompoundAll">foldLeftCompoundAll</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Fold over the list of initializers in a Compound, like
- <a href="Cil.html#VALfoldLeftCompound"><code class="code">Cil.foldLeftCompound</code></a> but in the case of an array it scans even missing
- zero initializers at the end of the array
-</div>
-</td></tr>
-<tr><td><a href="Clist.html#VALfold_left">fold_left</a> [<a href="Clist.html">Clist</a>]</td>
-<td><div class="info">
-A version of fold_left that works on clists
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALforgcc">forgcc</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Return the string 's' if we're printing output for gcc, suppres
- it if we're printing for CIL to parse back in.
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALfprint">fprint</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Format the document to the given width and emit it to the given channel
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALfprintf">fprintf</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Like <a href="Pretty.html#VALdprintf"><code class="code">Pretty.dprintf</code></a> followed by <a href="Pretty.html#VALfprint"><code class="code">Pretty.fprint</code></a>
-</div>
-</td></tr>
-<tr><td><a href="Clist.html#VALfromList">fromList</a> [<a href="Clist.html">Clist</a>]</td>
-<td><div class="info">
-Convert an ordinary list to a clist
-</div>
-</td></tr>
-<tr><td align="left"><br>G</td></tr>
-<tr><td><a href="Cil.html#VALgccBuiltins">gccBuiltins</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-A list of the GCC built-in functions.
-</div>
-</td></tr>
-<tr><td><a href="Alpha.html#VALgetAlphaPrefix">getAlphaPrefix</a> [<a href="Alpha.html">Alpha</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALgetCompField">getCompField</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Return a named fieldinfo in compinfo, or raise Not_found
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALgetGlobInit">getGlobInit</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Get the global initializer and create one if it does not already exist.
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALgetHPosition">getHPosition</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-high-level position
-</div>
-</td></tr>
-<tr><td><a href="Dominators.html#VALgetIdom">getIdom</a> [<a href="Dominators.html">Dominators</a>]</td>
-<td><div class="info">
-This is like Inthash.find but gives an error if the information is
- Not_found
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALgetLocation">getLocation</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALgetParenthLevel">getParenthLevel</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Parentheses level.
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALgetPosition">getPosition</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALget_globalLoc">get_globalLoc</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Return the location of a global, or locUnknown
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALget_instrLoc">get_instrLoc</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Return the location of an instruction
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALget_stmtLoc">get_stmtLoc</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Return the location of a statement, or locUnknown
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALgprintf">gprintf</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Like <a href="Pretty.html#VALdprintf"><code class="code">Pretty.dprintf</code></a> but more general.
-</div>
-</td></tr>
-<tr><td align="left"><br>H</td></tr>
-<tr><td><a href="Errormsg.html#VALhadErrors">hadErrors</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-This is set whenever one of the above error functions are called.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALhasAttribute">hasAttribute</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-True if the named attribute appears in the attribute list.
-</div>
-</td></tr>
-<tr><td><a href="Stats.html#VALhas_performance_counters">has_performance_counters</a> [<a href="Stats.html">Stats</a>]</td>
-<td><div class="info">
-Check if we have performance counters
-</div>
-</td></tr>
-<tr><td align="left"><br>I</td></tr>
-<tr><td><a href="Cil.html#VALincrem">increm</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Increment an expression.
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALindent">indent</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Indents the document.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALindexLevel">indexLevel</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALinitCIL">initCIL</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Call this function to perform some initialization.
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALinsert">insert</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-A function that is useful with the <code class="code">printf</code>-like interface
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALinsertImplicitCasts">insertImplicitCasts</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Do insert implicit casts (default true)
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALintPtrType">intPtrType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-int *
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALintType">intType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-int
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALinteger">integer</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Construct an integer of kind IInt.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALinvalidStmt">invalidStmt</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-An empty statement.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALisArithmeticType">isArithmeticType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-True if the argument is an arithmetic type (i.e.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALisArrayType">isArrayType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-True if the argument is an array type
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALisCompleteType">isCompleteType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Returns true if this is a complete type.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALisConstant">isConstant</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-True if the expression is a compile-time constant
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALisFunctionType">isFunctionType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-True if the argument is a function type
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALisInteger">isInteger</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-True if the given expression is a (possibly cast'ed)
- character or an integer constant
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALisIntegralType">isIntegralType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-True if the argument is an integral type (i.e.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALisPointerType">isPointerType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-True if the argument is a pointer type
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALisSigned">isSigned</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Returns true if and only if the given integer type is signed.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALisVoidPtrType">isVoidPtrType</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALisVoidType">isVoidType</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALisZero">isZero</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-True if the given expression is a (possibly cast'ed) integer or character
- constant with value zero
-</div>
-</td></tr>
-<tr><td><a href="Clist.html#VALiter">iter</a> [<a href="Clist.html">Clist</a>]</td>
-<td><div class="info">
-A version of iter that works on clists
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALiterGlobals">iterGlobals</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Iterate over all globals, including the global initializer
-</div>
-</td></tr>
-<tr><td align="left"><br>K</td></tr>
-<tr><td><a href="Cil.html#VALkinteger">kinteger</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Construct an integer of a given kind.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALkinteger64">kinteger64</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Construct an integer of a given kind, using OCaml's int64 type.
-</div>
-</td></tr>
-<tr><td align="left"><br>L</td></tr>
-<tr><td><a href="Stats.html#VALlastTime">lastTime</a> [<a href="Stats.html">Stats</a>]</td>
-<td><div class="info">
-Time a function and set lastTime to the time it took
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALleftflush">leftflush</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Use after a <a href="Pretty.html#VALline"><code class="code">Pretty.line</code></a> to prevent the indentation.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALlenOfArray">lenOfArray</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Call to compute the array length as present in the array type, to an
- integer.
-</div>
-</td></tr>
-<tr><td><a href="Clist.html#VALlength">length</a> [<a href="Clist.html">Clist</a>]</td>
-<td><div class="info">
-Find the length of a clist
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALline">line</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-A document that consists of a mandatory newline.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALlineDirectiveStyle">lineDirectiveStyle</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-How to print line directives
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALlineLength">lineLength</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-The length used when wrapping output lines.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALlittle_endian">little_endian</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Whether the machine is little endian.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALloadBinaryFile">loadBinaryFile</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Read a <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a> in binary form from the filesystem.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALlocUnknown">locUnknown</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Represents a location that cannot be determined
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALlocUnknown">locUnknown</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-An unknown location for use when you need one but you don't have one
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALlog">log</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-Print something to <code class="code">logChannel</code>
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALlogChannel">logChannel</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-A channel for printing log messages
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALlogg">logg</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-same as <a href="Errormsg.html#VALlog"><code class="code">Errormsg.log</code></a> but do not wrap lines
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALlongType">longType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-long
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALlowerConstants">lowerConstants</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Do lower constants (default true)
-</div>
-</td></tr>
-<tr><td><a href="Cillower.html#VALlowerEnumVisitor">lowerEnumVisitor</a> [<a href="Cillower.html">Cillower</a>]</td>
-<td><div class="info">
-Replace enumeration constants with integer constants
-</div>
-</td></tr>
-<tr><td align="left"><br>M</td></tr>
-<tr><td><a href="Cil.html#VALmakeFormalVar">makeFormalVar</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Make a formal variable for a function.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmakeGlobalVar">makeGlobalVar</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Make a global variable.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmakeLocalVar">makeLocalVar</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Make a local variable and add it to a function's slocals (only if insert =
- true, which is the default).
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmakeTempVar">makeTempVar</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Make a temporary variable and add it to a function's slocals.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmakeVarinfo">makeVarinfo</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Make a varinfo.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmakeZeroInit">makeZeroInit</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Make a initializer for zero-ing a data type
-</div>
-</td></tr>
-<tr><td><a href="Clist.html#VALmap">map</a> [<a href="Clist.html">Clist</a>]</td>
-<td><div class="info">
-Map a function over a clist.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmapGlobals">mapGlobals</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Map over all globals, including the global initializer and change things
- in place
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmapNoCopy">mapNoCopy</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Like map but try not to make a copy of the list
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmapNoCopyList">mapNoCopyList</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Like map but each call can return a list.
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALmark">mark</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Mark the beginning of a markup section.
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALmarkup">markup</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Prints a document as markup.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmissingFieldName">missingFieldName</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-This is a constant used as the name of an unnamed bitfield.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmkAddrOf">mkAddrOf</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Make an AddrOf.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmkAddrOrStartOf">mkAddrOrStartOf</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Like mkAddrOf except if the type of lval is an array then it uses
- StartOf.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmkBlock">mkBlock</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Construct a block with no attributes, given a list of statements
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmkCast">mkCast</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Like <a href="Cil.html#VALmkCastT"><code class="code">Cil.mkCastT</code></a> but uses typeOf to get <code class="code">oldt</code>
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmkCastT">mkCastT</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Construct a cast when having the old type of the expression.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmkCompInfo">mkCompInfo</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Creates a a (potentially recursive) composite type.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmkEmptyStmt">mkEmptyStmt</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Returns an empty statement (of kind <code class="code">Instr</code>)
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmkFor">mkFor</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Make a for loop for(start; guard; next) { ...
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmkForIncr">mkForIncr</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Make a for loop for(i=start; i<past; i += incr) { ...
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmkMem">mkMem</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Make a Mem, while optimizing AddrOf.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmkStmt">mkStmt</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Construct a statement, given its kind.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmkStmtOneInstr">mkStmtOneInstr</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Construct a statement consisting of just one instruction
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmkString">mkString</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Make an expression that is a string constant (of pointer type)
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmkWhile">mkWhile</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Make a while loop.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmone">mone</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
--1
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmsvcBuiltins">msvcBuiltins</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-A list of the MSVC built-in functions.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALmsvcMode">msvcMode</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Whether the pretty printer should print output for the MS VC compiler.
-</div>
-</td></tr>
-<tr><td align="left"><br>N</td></tr>
-<tr><td><a href="Dataflow.BackwardsTransfer.html#VALname">name</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
-<td><div class="info">
-For debugging purposes, the name of the analysis
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.ForwardsTransfer.html#VALname">name</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
-<td><div class="info">
-For debugging purposes, the name of the analysis
-</div>
-</td></tr>
-<tr><td><a href="Alpha.html#VALnewAlphaName">newAlphaName</a> [<a href="Alpha.html">Alpha</a>]</td>
-<td><div class="info">
-Create a new name based on a given name.
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALnewHline">newHline</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALnewVID">newVID</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Generate a new variable ID.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALnew_sid">new_sid</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Errormsg.html#VALnewline">newline</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td></td></tr>
-<tr><td><a href="Pretty.html#VALnil">nil</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Constructs an empty document
-</div>
-</td></tr>
-<tr><td><a href="Formatcil.html#VALnoMemoize">noMemoize</a> [<a href="Formatcil.html">Formatcil</a>]</td>
-<td><div class="info">
-If set then will not memoize the parsed patterns
-</div>
-</td></tr>
-<tr><td><a href="Cfg.html#VALnodeList">nodeList</a> [<a href="Cfg.html">Cfg</a>]</td>
-<td><div class="info">
-All of the nodes in a file.
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALnull">null</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-Do not actually print (i.e.
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALnum">num</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-A document that prints an integer in decimal form
-</div>
-</td></tr>
-<tr><td><a href="Cfg.html#VALnumNodes">numNodes</a> [<a href="Cfg.html">Cfg</a>]</td>
-<td><div class="info">
-number of nodes in the CFG
-</div>
-</td></tr>
-<tr><td align="left"><br>O</td></tr>
-<tr><td><a href="Cil.html#VALone">one</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-1
-</div>
-</td></tr>
-<tr><td align="left"><br>P</td></tr>
-<tr><td><a href="Cil.html#VALparseInt">parseInt</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Convert a string representing a C integer literal to an expression.
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALparse_error">parse_error</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALpartitionAttributes">partitionAttributes</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Partition the attributes into classes:name attributes, function type,
- and type attributes
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALpeepHole1">peepHole1</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Similar to <code class="code">peepHole2</code> except that the optimization window consists of
- one statement, not two
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALpeepHole2">peepHole2</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-A peephole optimizer that processes two adjacent statements and possibly
- replaces them both.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALplainCilPrinter">plainCilPrinter</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Errormsg.html#VALpopContext">popContext</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-Removes the last registered context printing function
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALprepareCFG">prepareCFG</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Prepare a function for CFG information computation by
- <a href="Cil.html#VALcomputeCFGInfo"><code class="code">Cil.computeCFGInfo</code></a>.
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.BackwardsTransfer.html#VALpretty">pretty</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
-<td><div class="info">
-Pretty-print the state
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.ForwardsTransfer.html#VALpretty">pretty</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
-<td><div class="info">
-Pretty-print the state
-</div>
-</td></tr>
-<tr><td><a href="Stats.html#VALprint">print</a> [<a href="Stats.html">Stats</a>]</td>
-<td><div class="info">
-Print the current stats preceeded by a message
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALprintAttr">printAttr</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Print an attribute given a pretty printer
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALprintAttrs">printAttrs</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Print a set of attributes given a pretty printer
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALprintBlock">printBlock</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Print a block given a pretty printer.
-</div>
-</td></tr>
-<tr><td><a href="Cfg.html#VALprintCfgChannel">printCfgChannel</a> [<a href="Cfg.html">Cfg</a>]</td>
-<td><div class="info">
-print control flow graph (in dot form) for fundec to channel
-</div>
-</td></tr>
-<tr><td><a href="Cfg.html#VALprintCfgFilename">printCfgFilename</a> [<a href="Cfg.html">Cfg</a>]</td>
-<td><div class="info">
-Print control flow graph (in dot form) for fundec to file
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALprintCilAsIs">printCilAsIs</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Whether to print the CIL as they are, without trying to be smart and
- print nicer code.
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALprintDepth">printDepth</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Specifies the nesting depth of the <code class="code">align</code>/<code class="code">unalign</code> pairs at which
- everything is replaced with ellipsis
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALprintExp">printExp</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Print an expression given a pretty printer
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALprintGlobal">printGlobal</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Print a global given a pretty printer
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALprintIndent">printIndent</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-If false then does not indent
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALprintInit">printInit</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Print an initializer given a pretty printer.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALprintInstr">printInstr</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Print an instruction given a pretty printer
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALprintLval">printLval</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Print an lvalue given a pretty printer
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALprintStmt">printStmt</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Print a statement given a pretty printer.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALprintType">printType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Print a type given a pretty printer
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALprint_CIL_Input">print_CIL_Input</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Whether we print something that will only be used as input to our own
- parser.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALprinterForMaincil">printerForMaincil</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Pretty.html#VALprintf">printf</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Like <a href="Pretty.html#VALfprintf"><code class="code">Pretty.fprintf</code></a> applied to <code class="code">stdout</code>
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALpushContext">pushContext</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-Registers a context printing function
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALpushGlobal">pushGlobal</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-CIL keeps the types at the beginning of the file and the variables at the
- end of the file.
-</div>
-</td></tr>
-<tr><td align="left"><br>R</td></tr>
-<tr><td><a href="Errormsg.html#VALreadingFromStdin">readingFromStdin</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-Records whether the stdin is open for reading the goal *
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALreal">real</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-A document that prints a real number
-</div>
-</td></tr>
-<tr><td><a href="Alpha.html#VALregisterAlphaName">registerAlphaName</a> [<a href="Alpha.html">Alpha</a>]</td>
-<td><div class="info">
-Register a name with an alpha conversion table to ensure that when later
- we call newAlphaName we do not end up generating this one
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALremoveOffset">removeOffset</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Remove ONE offset from the end of an offset sequence.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALremoveOffsetLval">removeOffsetLval</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Remove ONE offset from the end of an lvalue.
-</div>
-</td></tr>
-<tr><td><a href="Stats.html#VALrepeattime">repeattime</a> [<a href="Stats.html">Stats</a>]</td>
-<td><div class="info">
-repeattime is like time but runs the function several times until the total
- running time is greater or equal to the first argument.
-</div>
-</td></tr>
-<tr><td><a href="Stats.html#VALreset">reset</a> [<a href="Stats.html">Stats</a>]</td>
-<td><div class="info">
-Resets all the timings.
-</div>
-</td></tr>
-<tr><td><a href="Clist.html#VALrev">rev</a> [<a href="Clist.html">Clist</a>]</td>
-<td><div class="info">
-Reverse a clist.
-</div>
-</td></tr>
-<tr><td align="left"><br>S</td></tr>
-<tr><td><a href="Errormsg.html#VALs">s</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-Stop the execution by raising an Error.
-</div>
-</td></tr>
-<tr><td><a href="Stats.html#VALsample_pentium_perfcount_10">sample_pentium_perfcount_10</a> [<a href="Stats.html">Stats</a>]</td>
-<td><div class="info">
-Sample the current cycle count, in kilocycles.
-</div>
-</td></tr>
-<tr><td><a href="Stats.html#VALsample_pentium_perfcount_20">sample_pentium_perfcount_20</a> [<a href="Stats.html">Stats</a>]</td>
-<td><div class="info">
-Sample the current cycle count, in megacycles.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALsaveBinaryFile">saveBinaryFile</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Write a <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a> in binary form to the filesystem.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALsaveBinaryFileChannel">saveBinaryFileChannel</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Write a <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a> in binary form to the filesystem.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALseparateStorageModifiers">separateStorageModifiers</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Separate out the storage-modifier name attributes
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALseq">seq</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Formats a sequence.
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALsetCurrentFile">setCurrentFile</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td></td></tr>
-<tr><td><a href="Errormsg.html#VALsetCurrentLine">setCurrentLine</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALsetFormals">setFormals</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Update the formals of a <code class="code">fundec</code> and make sure that the function type
- has the same information.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALsetFunctionType">setFunctionType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Set the types of arguments and results as given by the function type
- passed as the second argument.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALsetFunctionTypeMakeFormals">setFunctionTypeMakeFormals</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Set the type of the function and make formal arguments for them
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALsetHFile">setHFile</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td></td></tr>
-<tr><td><a href="Errormsg.html#VALsetHLine">setHLine</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALsetMaxId">setMaxId</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Update the smaxid after you have populated with locals and formals
- (unless you constructed those using <a href="Cil.html#VALmakeLocalVar"><code class="code">Cil.makeLocalVar</code></a> or
- <a href="Cil.html#VALmakeTempVar"><code class="code">Cil.makeTempVar</code></a>.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALsetTypeAttrs">setTypeAttrs</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALsetTypeSigAttrs">setTypeSigAttrs</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Replace the attributes of a signature (only at top level)
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALshowContext">showContext</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-Show the context stack to stderr
-</div>
-</td></tr>
-<tr><td><a href="Clist.html#VALsingle">single</a> [<a href="Clist.html">Clist</a>]</td>
-<td><div class="info">
-Create a clist containing one element
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALsizeOf">sizeOf</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALsplitFunctionType">splitFunctionType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Given a function type split it into return type,
- arguments, is_vararg and attributes.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALsplitFunctionTypeVI">splitFunctionTypeVI</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Pretty.html#VALsprint">sprint</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Format the document to the given width and emit it as a string
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALstartParsing">startParsing</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td></td></tr>
-<tr><td><a href="Errormsg.html#VALstartParsingFromString">startParsingFromString</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cfg.html#VALstart_id">start_id</a> [<a href="Cfg.html">Cfg</a>]</td>
-<td><div class="info">
-Next statement id that will be assigned.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALstartsWith">startsWith</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-sm: return true if the first is a prefix of the second string
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.BackwardsTransfer.html#VALstmtStartData">stmtStartData</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
-<td><div class="info">
-For each block id, the data at the start.
-</div>
-</td></tr>
-<tr><td><a href="Dataflow.ForwardsTransfer.html#VALstmtStartData">stmtStartData</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
-<td><div class="info">
-For each statement id, the data at the start.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALstripCasts">stripCasts</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Removes casts from this expression, but ignores casts within
- other expression constructs.
-</div>
-</td></tr>
-<tr><td align="left"><br>T</td></tr>
-<tr><td><a href="Formatcil.html#VALtest">test</a> [<a href="Formatcil.html">Formatcil</a>]</td>
-<td><div class="info">
-Just a testing function
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALtext">text</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-A document that prints the given string
-</div>
-</td></tr>
-<tr><td><a href="Stats.html#VALtime">time</a> [<a href="Stats.html">Stats</a>]</td>
-<td><div class="info">
-Time a function and associate the time with the given string.
-</div>
-</td></tr>
-<tr><td><a href="Stats.html#VALtimethis">timethis</a> [<a href="Stats.html">Stats</a>]</td>
-<td></td></tr>
-<tr><td><a href="Clist.html#VALtoList">toList</a> [<a href="Clist.html">Clist</a>]</td>
-<td><div class="info">
-Convert a clist to an ordinary list
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALtypeAddAttributes">typeAddAttributes</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Add some attributes to a type
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALtypeAttrs">typeAttrs</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Returns all the attributes contained in a type.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALtypeOf">typeOf</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Compute the type of an expression
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALtypeOfLval">typeOfLval</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Compute the type of an lvalue
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALtypeOfSizeOf">typeOfSizeOf</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALtypeOffset">typeOffset</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Compute the type of an offset from a base type
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALtypeRemoveAttributes">typeRemoveAttributes</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Remove all attributes with the given names from a type.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALtypeSig">typeSig</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Compute a type signature
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALtypeSigAttrs">typeSigAttrs</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Get the top-level attributes of a signature
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALtypeSigWithAttrs">typeSigWithAttrs</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Like <a href="Cil.html#VALtypeSig"><code class="code">Cil.typeSig</code></a> but customize the incorporation of attributes.
-</div>
-</td></tr>
-<tr><td align="left"><br>U</td></tr>
-<tr><td><a href="Cil.html#VALuintPtrType">uintPtrType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-unsigned int *
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALuintType">uintType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-unsigned int
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALulongType">ulongType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-unsigned long
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALunalign">unalign</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Reverts to the last saved indentation level.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALunderscore_name">underscore_name</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Whether the compiler generates assembly labels by prepending "_" to the
- identifier.
-</div>
-</td></tr>
-<tr><td><a href="Alpha.html#VALundoAlphaChanges">undoAlphaChanges</a> [<a href="Alpha.html">Alpha</a>]</td>
-<td><div class="info">
-Undo the changes to a table
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALunimp">unimp</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Like <a href="Errormsg.html#VALunimp"><code class="code">Errormsg.unimp</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a>is also printed
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALunimp">unimp</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-Similar to <code class="code">error</code> except that its output has the form <code class="code">Unimplemented: ...</code>
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALuniqueVarNames">uniqueVarNames</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Assign unique names to local variables.
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALunmark">unmark</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-The end of a markup section
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALunrollType">unrollType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Unroll a type until it exposes a non
- <code class="code">TNamed</code>.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALunrollTypeDeep">unrollTypeDeep</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Unroll all the TNamed in a type (even under type constructors such as
- <code class="code">TPtr</code>, <code class="code">TFun</code> or <code class="code">TArray</code>.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALupointType">upointType</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALuseLogicalOperators">useLogicalOperators</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Whether to use the logical operands LAnd and LOr.
-</div>
-</td></tr>
-<tr><td align="left"><br>V</td></tr>
-<tr><td><a href="Cil.html#VALvar">var</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Makes an lvalue out of a given variable
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALverboseFlag">verboseFlag</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALvisitCilAttributes">visitCilAttributes</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Visit a list of attributes
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALvisitCilBlock">visitCilBlock</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Visit a block
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALvisitCilExpr">visitCilExpr</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Cil.html#VALvisitCilFile">visitCilFile</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Visit a file.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALvisitCilFileSameGlobals">visitCilFileSameGlobals</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-A visitor for the whole file that does not change the globals (but maybe
- changes things inside the globals).
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALvisitCilFunction">visitCilFunction</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Visit a function definition
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALvisitCilGlobal">visitCilGlobal</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Visit a global
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALvisitCilInit">visitCilInit</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Visit an initializer
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALvisitCilInitOffset">visitCilInitOffset</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Visit an initializer offset
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALvisitCilInstr">visitCilInstr</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Visit an instruction
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALvisitCilLval">visitCilLval</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Visit an lvalue
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALvisitCilOffset">visitCilOffset</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Visit an lvalue or recursive offset
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALvisitCilStmt">visitCilStmt</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Visit a statement
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALvisitCilType">visitCilType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Visit a type
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALvisitCilVarDecl">visitCilVarDecl</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Visit a variable declaration
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALvoidPtrType">voidPtrType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-void *
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALvoidType">voidType</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-void
-</div>
-</td></tr>
-<tr><td align="left"><br>W</td></tr>
-<tr><td><a href="Cil.html#VALwarn">warn</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Like <a href="Errormsg.html#VALwarn"><code class="code">Errormsg.warn</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is also printed
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALwarn">warn</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-Like <a href="Errormsg.html#VALerror"><code class="code">Errormsg.error</code></a> but does not raise the <a href="Errormsg.html#EXCEPTIONError"><code class="code">Errormsg.Error</code></a>
- exception.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALwarnContext">warnContext</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Like <a href="Errormsg.html#VALwarn"><code class="code">Errormsg.warn</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> and context
- is also printed
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALwarnContextOpt">warnContextOpt</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Like <a href="Errormsg.html#VALwarn"><code class="code">Errormsg.warn</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> and context is also
- printed.
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALwarnFlag">warnFlag</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-Set to true if you want to see all warnings.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALwarnLoc">warnLoc</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Like <a href="Cil.html#VALwarn"><code class="code">Cil.warn</code></a> except that it explicitly takes a location argument,
- instead of using the <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a>
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALwarnOpt">warnOpt</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-Like <a href="Errormsg.html#VALwarnOpt"><code class="code">Errormsg.warnOpt</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is also printed.
-</div>
-</td></tr>
-<tr><td><a href="Errormsg.html#VALwarnOpt">warnOpt</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-Like <a href="Errormsg.html#VALwarn"><code class="code">Errormsg.warn</code></a> but optional.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALwcharKind">wcharKind</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-wchar_t (depends on architecture) and is set when you call
- <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a>.
-</div>
-</td></tr>
-<tr><td><a href="Cil.html#VALwcharType">wcharType</a> [<a href="Cil.html">Cil</a>]</td>
-<td></td></tr>
-<tr><td><a href="Errormsg.html#VALwithContext">withContext</a> [<a href="Errormsg.html">Errormsg</a>]</td>
-<td><div class="info">
-To ensure that the context is registered and removed properly, use the
- function below
-</div>
-</td></tr>
-<tr><td><a href="Pretty.html#VALwithPrintDepth">withPrintDepth</a> [<a href="Pretty.html">Pretty</a>]</td>
-<td><div class="info">
-Invokes a thunk, with printDepth temporarily set to the specified value
-</div>
-</td></tr>
-<tr><td align="left"><br>Z</td></tr>
-<tr><td><a href="Cil.html#VALzero">zero</a> [<a href="Cil.html">Cil</a>]</td>
-<td><div class="info">
-0
-</div>
-</td></tr>
-</table><br>
-</body>
-</html>
\ No newline at end of file
diff --git a/cil/doc/api/style.css b/cil/doc/api/style.css
deleted file mode 100644
index 11ed40ce56d888c3e0c62887537fde927f16feb8..0000000000000000000000000000000000000000
--- a/cil/doc/api/style.css
+++ /dev/null
@@ -1,32 +0,0 @@
-a:visited {color : #416DFF; text-decoration : none; }
-a:link {color : #416DFF; text-decoration : none;}
-a:hover {color : Red; text-decoration : none; background-color: #5FFF88}
-a:active {color : Red; text-decoration : underline; }
-.keyword { font-weight : bold ; color : Red }
-.keywordsign { color : #C04600 }
-.superscript { font-size : 4 }
-.subscript { font-size : 4 }
-.comment { color : Green }
-.constructor { color : Blue }
-.type { color : #5C6585 }
-.string { color : Maroon }
-.warning { color : Red ; font-weight : bold }
-.info { margin-left : 3em; margin-right : 3em }
-.code { color : #465F91 ; }
-h1 { font-size : 20pt ; text-align: center; }
-h2 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90BDFF ;padding: 2px; }
-h3 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90DDFF ;padding: 2px; }
-h4 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90EDFF ;padding: 2px; }
-h5 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90FDFF ;padding: 2px; }
-h6 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #C0FFFF ; padding: 2px; }
-div.h7 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #E0FFFF ; padding: 2px; }
-div.h8 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #F0FFFF ; padding: 2px; }
-div.h9 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #FFFFFF ; padding: 2px; }
-.typetable { border-style : hidden }
-.indextable { border-style : hidden }
-.paramstable { border-style : hidden ; padding: 5pt 5pt}
-body { background-color : White }
-tr { background-color : White }
-td.typefieldcomment { background-color : #FFFFFF }
-pre { margin-bottom: 4px }
-div.sig_block {margin-left: 2em}
\ No newline at end of file
diff --git a/cil/doc/api/type_Alpha.html b/cil/doc/api/type_Alpha.html
deleted file mode 100644
index b97c835fc1b99c2432ae49ae38b82ae666ec8c47..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Alpha.html
+++ /dev/null
@@ -1,43 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Alpha</title>
-</head>
-<body>
-<code class="code"><span class="keyword">sig</span><br>
- <span class="keyword">type</span> <span class="keywordsign">'</span>a undoAlphaElement<br>
- <span class="keyword">type</span> <span class="keywordsign">'</span>a alphaTableData<br>
- <span class="keyword">val</span> newAlphaName :<br>
- alphaTable:(string, <span class="keywordsign">'</span>a <span class="constructor">Alpha</span>.alphaTableData <span class="constructor">Pervasives</span>.ref) <span class="constructor">Hashtbl</span>.t <span class="keywordsign">-></span><br>
- undolist:<span class="keywordsign">'</span>a <span class="constructor">Alpha</span>.undoAlphaElement list <span class="constructor">Pervasives</span>.ref option <span class="keywordsign">-></span><br>
- lookupname:string <span class="keywordsign">-></span> data:<span class="keywordsign">'</span>a <span class="keywordsign">-></span> string * <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> registerAlphaName :<br>
- alphaTable:(string, <span class="keywordsign">'</span>a <span class="constructor">Alpha</span>.alphaTableData <span class="constructor">Pervasives</span>.ref) <span class="constructor">Hashtbl</span>.t <span class="keywordsign">-></span><br>
- undolist:<span class="keywordsign">'</span>a <span class="constructor">Alpha</span>.undoAlphaElement list <span class="constructor">Pervasives</span>.ref option <span class="keywordsign">-></span><br>
- lookupname:string <span class="keywordsign">-></span> data:<span class="keywordsign">'</span>a <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> docAlphaTable :<br>
- unit <span class="keywordsign">-></span><br>
- (string, <span class="keywordsign">'</span>a <span class="constructor">Alpha</span>.alphaTableData <span class="constructor">Pervasives</span>.ref) <span class="constructor">Hashtbl</span>.t <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> getAlphaPrefix : lookupname:string <span class="keywordsign">-></span> string<br>
- <span class="keyword">val</span> undoAlphaChanges :<br>
- alphaTable:(string, <span class="keywordsign">'</span>a <span class="constructor">Alpha</span>.alphaTableData <span class="constructor">Pervasives</span>.ref) <span class="constructor">Hashtbl</span>.t <span class="keywordsign">-></span><br>
- undolist:<span class="keywordsign">'</span>a <span class="constructor">Alpha</span>.undoAlphaElement list <span class="keywordsign">-></span> unit<br>
-<span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Cfg.html b/cil/doc/api/type_Cfg.html
deleted file mode 100644
index 996d7739a6dc79325edf2e85d17d023bd70e46cf..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Cfg.html
+++ /dev/null
@@ -1,35 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cfg</title>
-</head>
-<body>
-<code class="code"><span class="keyword">sig</span><br>
- <span class="keyword">val</span> computeFileCFG : <span class="constructor">Cil</span>.file <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> clearFileCFG : <span class="constructor">Cil</span>.file <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> cfgFun : <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> int<br>
- <span class="keyword">val</span> clearCFGinfo : <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> printCfgChannel : <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> printCfgFilename : string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> start_id : int <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> nodeList : <span class="constructor">Cil</span>.stmt list <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> numNodes : int <span class="constructor">Pervasives</span>.ref<br>
-<span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Cil.cilPrinter.html b/cil/doc/api/type_Cil.cilPrinter.html
deleted file mode 100644
index ff117f5d0fc069ae8c96c12057b13d32698fa16c..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Cil.cilPrinter.html
+++ /dev/null
@@ -1,48 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.cilPrinter</title>
-</head>
-<body>
-<code class="code"><span class="keyword">object</span><br>
- <span class="keyword">method</span> dBlock : <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> int <span class="keywordsign">-></span> <span class="constructor">Cil</span>.block <span class="keywordsign">-></span> unit<br>
- <span class="keyword">method</span> dGlobal : <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> <span class="constructor">Cil</span>.global <span class="keywordsign">-></span> unit<br>
- <span class="keyword">method</span> dInit : <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> int <span class="keywordsign">-></span> <span class="constructor">Cil</span>.init <span class="keywordsign">-></span> unit<br>
- <span class="keyword">method</span> dStmt : <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> int <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> unit<br>
- <span class="keyword">method</span> pAttr : <span class="constructor">Cil</span>.attribute <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc * bool<br>
- <span class="keyword">method</span> pAttrParam : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attrparam <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pAttrs : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pBlock : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.block <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pExp : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pFieldDecl : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.fieldinfo <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pGlobal : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.global <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pInit : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.init <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pInstr : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.instr <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pLabel : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.label <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pLineDirective : ?forcefile:bool <span class="keywordsign">-></span> <span class="constructor">Cil</span>.location <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pLval : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.lval <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pOffset : <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> <span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pStmt : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pStmtKind : <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmtkind <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pType : <span class="constructor">Pretty</span>.doc option <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pVDecl : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.varinfo <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pVar : <span class="constructor">Cil</span>.varinfo <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
-<span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Cil.cilVisitor.html b/cil/doc/api/type_Cil.cilVisitor.html
deleted file mode 100644
index efe3d138d28937ab36f22282a47f68ebb86d9ad6..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Cil.cilVisitor.html
+++ /dev/null
@@ -1,43 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.cilVisitor</title>
-</head>
-<body>
-<code class="code"><span class="keyword">object</span><br>
- <span class="keyword">method</span> queueInstr : <span class="constructor">Cil</span>.instr list <span class="keywordsign">-></span> unit<br>
- <span class="keyword">method</span> unqueueInstr : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.instr list<br>
- <span class="keyword">method</span> vattr : <span class="constructor">Cil</span>.attribute <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attribute list <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vattrparam : <span class="constructor">Cil</span>.attrparam <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attrparam <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vblock : <span class="constructor">Cil</span>.block <span class="keywordsign">-></span> <span class="constructor">Cil</span>.block <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vexpr : <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vfunc : <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> <span class="constructor">Cil</span>.fundec <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vglob : <span class="constructor">Cil</span>.global <span class="keywordsign">-></span> <span class="constructor">Cil</span>.global list <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vinit : <span class="constructor">Cil</span>.init <span class="keywordsign">-></span> <span class="constructor">Cil</span>.init <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vinitoffs : <span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> <span class="constructor">Cil</span>.offset <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vinst : <span class="constructor">Cil</span>.instr <span class="keywordsign">-></span> <span class="constructor">Cil</span>.instr list <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vlval : <span class="constructor">Cil</span>.lval <span class="keywordsign">-></span> <span class="constructor">Cil</span>.lval <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> voffs : <span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> <span class="constructor">Cil</span>.offset <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vstmt : <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vtype : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vvdec : <span class="constructor">Cil</span>.varinfo <span class="keywordsign">-></span> <span class="constructor">Cil</span>.varinfo <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vvrbl : <span class="constructor">Cil</span>.varinfo <span class="keywordsign">-></span> <span class="constructor">Cil</span>.varinfo <span class="constructor">Cil</span>.visitAction<br>
-<span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Cil.defaultCilPrinterClass.html b/cil/doc/api/type_Cil.defaultCilPrinterClass.html
deleted file mode 100644
index 75a36eb77b929667d87aa182e9b3c84bd07560b4..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Cil.defaultCilPrinterClass.html
+++ /dev/null
@@ -1,25 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.defaultCilPrinterClass</title>
-</head>
-<body>
-<code class="code"><span class="constructor">Cil</span>.cilPrinter</code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Cil.html b/cil/doc/api/type_Cil.html
deleted file mode 100644
index da6f9e967b30755ccf88688e8f767291f99e17d9..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Cil.html
+++ /dev/null
@@ -1,622 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil</title>
-</head>
-<body>
-<code class="code"><span class="keyword">sig</span><br>
- <span class="keyword">val</span> initCIL : unit <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> cilVersion : string<br>
- <span class="keyword">val</span> cilVersionMajor : int<br>
- <span class="keyword">val</span> cilVersionMinor : int<br>
- <span class="keyword">val</span> cilVersionRevision : int<br>
- <span class="keyword">type</span> file = {<br>
- <span class="keyword">mutable</span> fileName : string;<br>
- <span class="keyword">mutable</span> globals : <span class="constructor">Cil</span>.global list;<br>
- <span class="keyword">mutable</span> globinit : <span class="constructor">Cil</span>.fundec option;<br>
- <span class="keyword">mutable</span> globinitcalled : bool;<br>
- }<br>
- <span class="keyword">and</span> comment = <span class="constructor">Cil</span>.location * string<br>
- <span class="keyword">and</span> global =<br>
- <span class="constructor">GType</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typeinfo * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">GCompTag</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.compinfo * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">GCompTagDecl</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.compinfo * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">GEnumTag</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.enuminfo * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">GEnumTagDecl</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.enuminfo * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">GVarDecl</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.varinfo * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">GVar</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.varinfo * <span class="constructor">Cil</span>.initinfo * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">GFun</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.fundec * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">GAsm</span> <span class="keyword">of</span> string * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">GPragma</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.attribute * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">GText</span> <span class="keyword">of</span> string<br>
- <span class="keyword">and</span> typ =<br>
- <span class="constructor">TVoid</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.attributes<br>
- <span class="keywordsign">|</span> <span class="constructor">TInt</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.ikind * <span class="constructor">Cil</span>.attributes<br>
- <span class="keywordsign">|</span> <span class="constructor">TFloat</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.fkind * <span class="constructor">Cil</span>.attributes<br>
- <span class="keywordsign">|</span> <span class="constructor">TPtr</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typ * <span class="constructor">Cil</span>.attributes<br>
- <span class="keywordsign">|</span> <span class="constructor">TArray</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typ * <span class="constructor">Cil</span>.exp option * <span class="constructor">Cil</span>.attributes<br>
- <span class="keywordsign">|</span> <span class="constructor">TFun</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typ * (string * <span class="constructor">Cil</span>.typ * <span class="constructor">Cil</span>.attributes) list option *<br>
- bool * <span class="constructor">Cil</span>.attributes<br>
- <span class="keywordsign">|</span> <span class="constructor">TNamed</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typeinfo * <span class="constructor">Cil</span>.attributes<br>
- <span class="keywordsign">|</span> <span class="constructor">TComp</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.compinfo * <span class="constructor">Cil</span>.attributes<br>
- <span class="keywordsign">|</span> <span class="constructor">TEnum</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.enuminfo * <span class="constructor">Cil</span>.attributes<br>
- <span class="keywordsign">|</span> <span class="constructor">TBuiltin_va_list</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.attributes<br>
- <span class="keyword">and</span> ikind =<br>
- <span class="constructor">IChar</span><br>
- <span class="keywordsign">|</span> <span class="constructor">ISChar</span><br>
- <span class="keywordsign">|</span> <span class="constructor">IUChar</span><br>
- <span class="keywordsign">|</span> <span class="constructor">IInt</span><br>
- <span class="keywordsign">|</span> <span class="constructor">IUInt</span><br>
- <span class="keywordsign">|</span> <span class="constructor">IShort</span><br>
- <span class="keywordsign">|</span> <span class="constructor">IUShort</span><br>
- <span class="keywordsign">|</span> <span class="constructor">ILong</span><br>
- <span class="keywordsign">|</span> <span class="constructor">IULong</span><br>
- <span class="keywordsign">|</span> <span class="constructor">ILongLong</span><br>
- <span class="keywordsign">|</span> <span class="constructor">IULongLong</span><br>
- <span class="keyword">and</span> fkind = <span class="constructor">FFloat</span> <span class="keywordsign">|</span> <span class="constructor">FDouble</span> <span class="keywordsign">|</span> <span class="constructor">FLongDouble</span><br>
- <span class="keyword">and</span> attribute = <span class="constructor">Attr</span> <span class="keyword">of</span> string * <span class="constructor">Cil</span>.attrparam list<br>
- <span class="keyword">and</span> attributes = <span class="constructor">Cil</span>.attribute list<br>
- <span class="keyword">and</span> attrparam =<br>
- <span class="constructor">AInt</span> <span class="keyword">of</span> int<br>
- <span class="keywordsign">|</span> <span class="constructor">AStr</span> <span class="keyword">of</span> string<br>
- <span class="keywordsign">|</span> <span class="constructor">ACons</span> <span class="keyword">of</span> string * <span class="constructor">Cil</span>.attrparam list<br>
- <span class="keywordsign">|</span> <span class="constructor">ASizeOf</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typ<br>
- <span class="keywordsign">|</span> <span class="constructor">ASizeOfE</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.attrparam<br>
- <span class="keywordsign">|</span> <span class="constructor">ASizeOfS</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typsig<br>
- <span class="keywordsign">|</span> <span class="constructor">AAlignOf</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typ<br>
- <span class="keywordsign">|</span> <span class="constructor">AAlignOfE</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.attrparam<br>
- <span class="keywordsign">|</span> <span class="constructor">AAlignOfS</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typsig<br>
- <span class="keywordsign">|</span> <span class="constructor">AUnOp</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.unop * <span class="constructor">Cil</span>.attrparam<br>
- <span class="keywordsign">|</span> <span class="constructor">ABinOp</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.binop * <span class="constructor">Cil</span>.attrparam * <span class="constructor">Cil</span>.attrparam<br>
- <span class="keywordsign">|</span> <span class="constructor">ADot</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.attrparam * string<br>
- <span class="keyword">and</span> compinfo = {<br>
- <span class="keyword">mutable</span> cstruct : bool;<br>
- <span class="keyword">mutable</span> cname : string;<br>
- <span class="keyword">mutable</span> ckey : int;<br>
- <span class="keyword">mutable</span> cfields : <span class="constructor">Cil</span>.fieldinfo list;<br>
- <span class="keyword">mutable</span> cattr : <span class="constructor">Cil</span>.attributes;<br>
- <span class="keyword">mutable</span> cdefined : bool;<br>
- <span class="keyword">mutable</span> creferenced : bool;<br>
- }<br>
- <span class="keyword">and</span> fieldinfo = {<br>
- <span class="keyword">mutable</span> fcomp : <span class="constructor">Cil</span>.compinfo;<br>
- <span class="keyword">mutable</span> fname : string;<br>
- <span class="keyword">mutable</span> ftype : <span class="constructor">Cil</span>.typ;<br>
- <span class="keyword">mutable</span> fbitfield : int option;<br>
- <span class="keyword">mutable</span> fattr : <span class="constructor">Cil</span>.attributes;<br>
- <span class="keyword">mutable</span> floc : <span class="constructor">Cil</span>.location;<br>
- }<br>
- <span class="keyword">and</span> enuminfo = {<br>
- <span class="keyword">mutable</span> ename : string;<br>
- <span class="keyword">mutable</span> eitems : (string * <span class="constructor">Cil</span>.exp * <span class="constructor">Cil</span>.location) list;<br>
- <span class="keyword">mutable</span> eattr : <span class="constructor">Cil</span>.attributes;<br>
- <span class="keyword">mutable</span> ereferenced : bool;<br>
- }<br>
- <span class="keyword">and</span> typeinfo = {<br>
- <span class="keyword">mutable</span> tname : string;<br>
- <span class="keyword">mutable</span> ttype : <span class="constructor">Cil</span>.typ;<br>
- <span class="keyword">mutable</span> treferenced : bool;<br>
- }<br>
- <span class="keyword">and</span> varinfo = {<br>
- <span class="keyword">mutable</span> vname : string;<br>
- <span class="keyword">mutable</span> vtype : <span class="constructor">Cil</span>.typ;<br>
- <span class="keyword">mutable</span> vattr : <span class="constructor">Cil</span>.attributes;<br>
- <span class="keyword">mutable</span> vstorage : <span class="constructor">Cil</span>.storage;<br>
- <span class="keyword">mutable</span> vglob : bool;<br>
- <span class="keyword">mutable</span> vinline : bool;<br>
- <span class="keyword">mutable</span> vdecl : <span class="constructor">Cil</span>.location;<br>
- <span class="keyword">mutable</span> vid : int;<br>
- <span class="keyword">mutable</span> vaddrof : bool;<br>
- <span class="keyword">mutable</span> vreferenced : bool;<br>
- }<br>
- <span class="keyword">and</span> storage = <span class="constructor">NoStorage</span> <span class="keywordsign">|</span> <span class="constructor">Static</span> <span class="keywordsign">|</span> <span class="constructor">Register</span> <span class="keywordsign">|</span> <span class="constructor">Extern</span><br>
- <span class="keyword">and</span> exp =<br>
- <span class="constructor">Const</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.constant<br>
- <span class="keywordsign">|</span> <span class="constructor">Lval</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.lval<br>
- <span class="keywordsign">|</span> <span class="constructor">SizeOf</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typ<br>
- <span class="keywordsign">|</span> <span class="constructor">SizeOfE</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.exp<br>
- <span class="keywordsign">|</span> <span class="constructor">SizeOfStr</span> <span class="keyword">of</span> string<br>
- <span class="keywordsign">|</span> <span class="constructor">AlignOf</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typ<br>
- <span class="keywordsign">|</span> <span class="constructor">AlignOfE</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.exp<br>
- <span class="keywordsign">|</span> <span class="constructor">UnOp</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.unop * <span class="constructor">Cil</span>.exp * <span class="constructor">Cil</span>.typ<br>
- <span class="keywordsign">|</span> <span class="constructor">BinOp</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.binop * <span class="constructor">Cil</span>.exp * <span class="constructor">Cil</span>.exp * <span class="constructor">Cil</span>.typ<br>
- <span class="keywordsign">|</span> <span class="constructor">CastE</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typ * <span class="constructor">Cil</span>.exp<br>
- <span class="keywordsign">|</span> <span class="constructor">AddrOf</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.lval<br>
- <span class="keywordsign">|</span> <span class="constructor">StartOf</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.lval<br>
- <span class="keyword">and</span> constant =<br>
- <span class="constructor">CInt64</span> <span class="keyword">of</span> int64 * <span class="constructor">Cil</span>.ikind * string option<br>
- <span class="keywordsign">|</span> <span class="constructor">CStr</span> <span class="keyword">of</span> string<br>
- <span class="keywordsign">|</span> <span class="constructor">CWStr</span> <span class="keyword">of</span> int64 list<br>
- <span class="keywordsign">|</span> <span class="constructor">CChr</span> <span class="keyword">of</span> char<br>
- <span class="keywordsign">|</span> <span class="constructor">CReal</span> <span class="keyword">of</span> float * <span class="constructor">Cil</span>.fkind * string option<br>
- <span class="keywordsign">|</span> <span class="constructor">CEnum</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.exp * string * <span class="constructor">Cil</span>.enuminfo<br>
- <span class="keyword">and</span> unop = <span class="constructor">Neg</span> <span class="keywordsign">|</span> <span class="constructor">BNot</span> <span class="keywordsign">|</span> <span class="constructor">LNot</span><br>
- <span class="keyword">and</span> binop =<br>
- <span class="constructor">PlusA</span><br>
- <span class="keywordsign">|</span> <span class="constructor">PlusPI</span><br>
- <span class="keywordsign">|</span> <span class="constructor">IndexPI</span><br>
- <span class="keywordsign">|</span> <span class="constructor">MinusA</span><br>
- <span class="keywordsign">|</span> <span class="constructor">MinusPI</span><br>
- <span class="keywordsign">|</span> <span class="constructor">MinusPP</span><br>
- <span class="keywordsign">|</span> <span class="constructor">Mult</span><br>
- <span class="keywordsign">|</span> <span class="constructor">Div</span><br>
- <span class="keywordsign">|</span> <span class="constructor">Mod</span><br>
- <span class="keywordsign">|</span> <span class="constructor">Shiftlt</span><br>
- <span class="keywordsign">|</span> <span class="constructor">Shiftrt</span><br>
- <span class="keywordsign">|</span> <span class="constructor">Lt</span><br>
- <span class="keywordsign">|</span> <span class="constructor">Gt</span><br>
- <span class="keywordsign">|</span> <span class="constructor">Le</span><br>
- <span class="keywordsign">|</span> <span class="constructor">Ge</span><br>
- <span class="keywordsign">|</span> <span class="constructor">Eq</span><br>
- <span class="keywordsign">|</span> <span class="constructor">Ne</span><br>
- <span class="keywordsign">|</span> <span class="constructor">BAnd</span><br>
- <span class="keywordsign">|</span> <span class="constructor">BXor</span><br>
- <span class="keywordsign">|</span> <span class="constructor">BOr</span><br>
- <span class="keywordsign">|</span> <span class="constructor">LAnd</span><br>
- <span class="keywordsign">|</span> <span class="constructor">LOr</span><br>
- <span class="keyword">and</span> lval = <span class="constructor">Cil</span>.lhost * <span class="constructor">Cil</span>.offset<br>
- <span class="keyword">and</span> lhost = <span class="constructor">Var</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.varinfo <span class="keywordsign">|</span> <span class="constructor">Mem</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">and</span> offset =<br>
- <span class="constructor">NoOffset</span><br>
- <span class="keywordsign">|</span> <span class="constructor">Field</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.fieldinfo * <span class="constructor">Cil</span>.offset<br>
- <span class="keywordsign">|</span> <span class="constructor">Index</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.exp * <span class="constructor">Cil</span>.offset<br>
- <span class="keyword">and</span> init =<br>
- <span class="constructor">SingleInit</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.exp<br>
- <span class="keywordsign">|</span> <span class="constructor">CompoundInit</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typ * (<span class="constructor">Cil</span>.offset * <span class="constructor">Cil</span>.init) list<br>
- <span class="keyword">and</span> initinfo = { <span class="keyword">mutable</span> init : <span class="constructor">Cil</span>.init option; }<br>
- <span class="keyword">and</span> fundec = {<br>
- <span class="keyword">mutable</span> svar : <span class="constructor">Cil</span>.varinfo;<br>
- <span class="keyword">mutable</span> sformals : <span class="constructor">Cil</span>.varinfo list;<br>
- <span class="keyword">mutable</span> slocals : <span class="constructor">Cil</span>.varinfo list;<br>
- <span class="keyword">mutable</span> smaxid : int;<br>
- <span class="keyword">mutable</span> sbody : <span class="constructor">Cil</span>.block;<br>
- <span class="keyword">mutable</span> smaxstmtid : int option;<br>
- <span class="keyword">mutable</span> sallstmts : <span class="constructor">Cil</span>.stmt list;<br>
- }<br>
- <span class="keyword">and</span> block = {<br>
- <span class="keyword">mutable</span> battrs : <span class="constructor">Cil</span>.attributes;<br>
- <span class="keyword">mutable</span> bstmts : <span class="constructor">Cil</span>.stmt list;<br>
- }<br>
- <span class="keyword">and</span> stmt = {<br>
- <span class="keyword">mutable</span> labels : <span class="constructor">Cil</span>.label list;<br>
- <span class="keyword">mutable</span> skind : <span class="constructor">Cil</span>.stmtkind;<br>
- <span class="keyword">mutable</span> sid : int;<br>
- <span class="keyword">mutable</span> succs : <span class="constructor">Cil</span>.stmt list;<br>
- <span class="keyword">mutable</span> preds : <span class="constructor">Cil</span>.stmt list;<br>
- }<br>
- <span class="keyword">and</span> label =<br>
- <span class="constructor">Label</span> <span class="keyword">of</span> string * <span class="constructor">Cil</span>.location * bool<br>
- <span class="keywordsign">|</span> <span class="constructor">Case</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.exp * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">Default</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.location<br>
- <span class="keyword">and</span> stmtkind =<br>
- <span class="constructor">Instr</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.instr list<br>
- <span class="keywordsign">|</span> <span class="constructor">Return</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.exp option * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">Goto</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.stmt <span class="constructor">Pervasives</span>.ref * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">Break</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">Continue</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">If</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.exp * <span class="constructor">Cil</span>.block * <span class="constructor">Cil</span>.block * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">Switch</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.exp * <span class="constructor">Cil</span>.block * <span class="constructor">Cil</span>.stmt list * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">Loop</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.block * <span class="constructor">Cil</span>.location * <span class="constructor">Cil</span>.stmt option * <span class="constructor">Cil</span>.stmt option<br>
- <span class="keywordsign">|</span> <span class="constructor">Block</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.block<br>
- <span class="keywordsign">|</span> <span class="constructor">TryFinally</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.block * <span class="constructor">Cil</span>.block * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">TryExcept</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.block * (<span class="constructor">Cil</span>.instr list * <span class="constructor">Cil</span>.exp) * <span class="constructor">Cil</span>.block *<br>
- <span class="constructor">Cil</span>.location<br>
- <span class="keyword">and</span> instr =<br>
- <span class="constructor">Set</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.lval * <span class="constructor">Cil</span>.exp * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">Call</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.lval option * <span class="constructor">Cil</span>.exp * <span class="constructor">Cil</span>.exp list * <span class="constructor">Cil</span>.location<br>
- <span class="keywordsign">|</span> <span class="constructor">Asm</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.attributes * string list * (string * <span class="constructor">Cil</span>.lval) list *<br>
- (string * <span class="constructor">Cil</span>.exp) list * string list * <span class="constructor">Cil</span>.location<br>
- <span class="keyword">and</span> location = { line : int; file : string; byte : int; }<br>
- <span class="keyword">and</span> typsig =<br>
- <span class="constructor">TSArray</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typsig * int64 option * <span class="constructor">Cil</span>.attribute list<br>
- <span class="keywordsign">|</span> <span class="constructor">TSPtr</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typsig * <span class="constructor">Cil</span>.attribute list<br>
- <span class="keywordsign">|</span> <span class="constructor">TSComp</span> <span class="keyword">of</span> bool * string * <span class="constructor">Cil</span>.attribute list<br>
- <span class="keywordsign">|</span> <span class="constructor">TSFun</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typsig * <span class="constructor">Cil</span>.typsig list * bool * <span class="constructor">Cil</span>.attribute list<br>
- <span class="keywordsign">|</span> <span class="constructor">TSEnum</span> <span class="keyword">of</span> string * <span class="constructor">Cil</span>.attribute list<br>
- <span class="keywordsign">|</span> <span class="constructor">TSBase</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> lowerConstants : bool ref<br>
- <span class="keyword">val</span> insertImplicitCasts : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">type</span> featureDescr = {<br>
- fd_enabled : bool <span class="constructor">Pervasives</span>.ref;<br>
- fd_name : string;<br>
- fd_description : string;<br>
- fd_extraopt : (string * <span class="constructor">Arg</span>.spec * string) list;<br>
- fd_doit : <span class="constructor">Cil</span>.file <span class="keywordsign">-></span> unit;<br>
- fd_post_check : bool;<br>
- }<br>
- <span class="keyword">val</span> compareLoc : <span class="constructor">Cil</span>.location <span class="keywordsign">-></span> <span class="constructor">Cil</span>.location <span class="keywordsign">-></span> int<br>
- <span class="keyword">val</span> emptyFunction : string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.fundec<br>
- <span class="keyword">val</span> setFormals : <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> <span class="constructor">Cil</span>.varinfo list <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> setFunctionType : <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> setFunctionTypeMakeFormals : <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> setMaxId : <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> dummyFunDec : <span class="constructor">Cil</span>.fundec<br>
- <span class="keyword">val</span> dummyFile : <span class="constructor">Cil</span>.file<br>
- <span class="keyword">val</span> saveBinaryFile : <span class="constructor">Cil</span>.file <span class="keywordsign">-></span> string <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> saveBinaryFileChannel : <span class="constructor">Cil</span>.file <span class="keywordsign">-></span> <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> loadBinaryFile : string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.file<br>
- <span class="keyword">val</span> getGlobInit : ?main_name:string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.file <span class="keywordsign">-></span> <span class="constructor">Cil</span>.fundec<br>
- <span class="keyword">val</span> iterGlobals : <span class="constructor">Cil</span>.file <span class="keywordsign">-></span> (<span class="constructor">Cil</span>.global <span class="keywordsign">-></span> unit) <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> foldGlobals : <span class="constructor">Cil</span>.file <span class="keywordsign">-></span> (<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="constructor">Cil</span>.global <span class="keywordsign">-></span> <span class="keywordsign">'</span>a) <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> mapGlobals : <span class="constructor">Cil</span>.file <span class="keywordsign">-></span> (<span class="constructor">Cil</span>.global <span class="keywordsign">-></span> <span class="constructor">Cil</span>.global) <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> new_sid : unit <span class="keywordsign">-></span> int<br>
- <span class="keyword">val</span> prepareCFG : <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> computeCFGInfo : <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> bool <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> copyFunction : <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.fundec<br>
- <span class="keyword">val</span> pushGlobal :<br>
- <span class="constructor">Cil</span>.global <span class="keywordsign">-></span><br>
- types:<span class="constructor">Cil</span>.global list <span class="constructor">Pervasives</span>.ref <span class="keywordsign">-></span><br>
- variables:<span class="constructor">Cil</span>.global list <span class="constructor">Pervasives</span>.ref <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> invalidStmt : <span class="constructor">Cil</span>.stmt<br>
- <span class="keyword">val</span> gccBuiltins : (string, <span class="constructor">Cil</span>.typ * <span class="constructor">Cil</span>.typ list * bool) <span class="constructor">Hashtbl</span>.t<br>
- <span class="keyword">val</span> msvcBuiltins : (string, <span class="constructor">Cil</span>.typ * <span class="constructor">Cil</span>.typ list * bool) <span class="constructor">Hashtbl</span>.t<br>
- <span class="keyword">val</span> makeZeroInit : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.init<br>
- <span class="keyword">val</span> foldLeftCompound :<br>
- doinit:(<span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> <span class="constructor">Cil</span>.init <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>a) <span class="keywordsign">-></span><br>
- ct:<span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> initl:(<span class="constructor">Cil</span>.offset * <span class="constructor">Cil</span>.init) list <span class="keywordsign">-></span> acc:<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> foldLeftCompoundAll :<br>
- doinit:(<span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> <span class="constructor">Cil</span>.init <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>a) <span class="keywordsign">-></span><br>
- ct:<span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> initl:(<span class="constructor">Cil</span>.offset * <span class="constructor">Cil</span>.init) list <span class="keywordsign">-></span> acc:<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> voidType : <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> isVoidType : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> bool<br>
- <span class="keyword">val</span> isVoidPtrType : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> bool<br>
- <span class="keyword">val</span> intType : <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> uintType : <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> longType : <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> ulongType : <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> charType : <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> charPtrType : <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> wcharKind : <span class="constructor">Cil</span>.ikind <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> wcharType : <span class="constructor">Cil</span>.typ <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> charConstPtrType : <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> voidPtrType : <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> intPtrType : <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> uintPtrType : <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> doubleType : <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> upointType : <span class="constructor">Cil</span>.typ <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> typeOfSizeOf : <span class="constructor">Cil</span>.typ <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> isSigned : <span class="constructor">Cil</span>.ikind <span class="keywordsign">-></span> bool<br>
- <span class="keyword">val</span> mkCompInfo :<br>
- bool <span class="keywordsign">-></span><br>
- string <span class="keywordsign">-></span><br>
- (<span class="constructor">Cil</span>.compinfo <span class="keywordsign">-></span><br>
- (string * <span class="constructor">Cil</span>.typ * int option * <span class="constructor">Cil</span>.attributes * <span class="constructor">Cil</span>.location) list) <span class="keywordsign">-></span><br>
- <span class="constructor">Cil</span>.attributes <span class="keywordsign">-></span> <span class="constructor">Cil</span>.compinfo<br>
- <span class="keyword">val</span> copyCompInfo : <span class="constructor">Cil</span>.compinfo <span class="keywordsign">-></span> string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.compinfo<br>
- <span class="keyword">val</span> missingFieldName : string<br>
- <span class="keyword">val</span> compFullName : <span class="constructor">Cil</span>.compinfo <span class="keywordsign">-></span> string<br>
- <span class="keyword">val</span> isCompleteType : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> bool<br>
- <span class="keyword">val</span> unrollType : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> unrollTypeDeep : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> separateStorageModifiers :<br>
- <span class="constructor">Cil</span>.attribute list <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attribute list * <span class="constructor">Cil</span>.attribute list<br>
- <span class="keyword">val</span> isIntegralType : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> bool<br>
- <span class="keyword">val</span> isArithmeticType : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> bool<br>
- <span class="keyword">val</span> isPointerType : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> bool<br>
- <span class="keyword">val</span> isFunctionType : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> bool<br>
- <span class="keyword">val</span> argsToList :<br>
- (string * <span class="constructor">Cil</span>.typ * <span class="constructor">Cil</span>.attributes) list option <span class="keywordsign">-></span><br>
- (string * <span class="constructor">Cil</span>.typ * <span class="constructor">Cil</span>.attributes) list<br>
- <span class="keyword">val</span> isArrayType : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> bool<br>
- <span class="keyword">exception</span> <span class="constructor">LenOfArray</span><br>
- <span class="keyword">val</span> lenOfArray : <span class="constructor">Cil</span>.exp option <span class="keywordsign">-></span> int<br>
- <span class="keyword">val</span> getCompField : <span class="constructor">Cil</span>.compinfo <span class="keywordsign">-></span> string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.fieldinfo<br>
- <span class="keyword">type</span> existsAction = <span class="constructor">ExistsTrue</span> <span class="keywordsign">|</span> <span class="constructor">ExistsFalse</span> <span class="keywordsign">|</span> <span class="constructor">ExistsMaybe</span><br>
- <span class="keyword">val</span> existsType : (<span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.existsAction) <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> bool<br>
- <span class="keyword">val</span> splitFunctionType :<br>
- <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span><br>
- <span class="constructor">Cil</span>.typ * (string * <span class="constructor">Cil</span>.typ * <span class="constructor">Cil</span>.attributes) list option * bool *<br>
- <span class="constructor">Cil</span>.attributes<br>
- <span class="keyword">val</span> splitFunctionTypeVI :<br>
- <span class="constructor">Cil</span>.varinfo <span class="keywordsign">-></span><br>
- <span class="constructor">Cil</span>.typ * (string * <span class="constructor">Cil</span>.typ * <span class="constructor">Cil</span>.attributes) list option * bool *<br>
- <span class="constructor">Cil</span>.attributes<br>
- <span class="keyword">val</span> d_typsig : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typsig <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> typeSig : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typsig<br>
- <span class="keyword">val</span> typeSigWithAttrs :<br>
- ?ignoreSign:bool <span class="keywordsign">-></span><br>
- (<span class="constructor">Cil</span>.attributes <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes) <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typsig<br>
- <span class="keyword">val</span> setTypeSigAttrs : <span class="constructor">Cil</span>.attributes <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typsig <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typsig<br>
- <span class="keyword">val</span> typeSigAttrs : <span class="constructor">Cil</span>.typsig <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes<br>
- <span class="keyword">val</span> makeVarinfo : bool <span class="keywordsign">-></span> string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.varinfo<br>
- <span class="keyword">val</span> makeFormalVar :<br>
- <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> ?where:string <span class="keywordsign">-></span> string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.varinfo<br>
- <span class="keyword">val</span> makeLocalVar :<br>
- <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> ?insert:bool <span class="keywordsign">-></span> string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.varinfo<br>
- <span class="keyword">val</span> makeTempVar : <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> ?name:string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.varinfo<br>
- <span class="keyword">val</span> makeGlobalVar : string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.varinfo<br>
- <span class="keyword">val</span> copyVarinfo : <span class="constructor">Cil</span>.varinfo <span class="keywordsign">-></span> string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.varinfo<br>
- <span class="keyword">val</span> newVID : unit <span class="keywordsign">-></span> int<br>
- <span class="keyword">val</span> addOffsetLval : <span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> <span class="constructor">Cil</span>.lval <span class="keywordsign">-></span> <span class="constructor">Cil</span>.lval<br>
- <span class="keyword">val</span> addOffset : <span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> <span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> <span class="constructor">Cil</span>.offset<br>
- <span class="keyword">val</span> removeOffsetLval : <span class="constructor">Cil</span>.lval <span class="keywordsign">-></span> <span class="constructor">Cil</span>.lval * <span class="constructor">Cil</span>.offset<br>
- <span class="keyword">val</span> removeOffset : <span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> <span class="constructor">Cil</span>.offset * <span class="constructor">Cil</span>.offset<br>
- <span class="keyword">val</span> typeOfLval : <span class="constructor">Cil</span>.lval <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> typeOffset : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> zero : <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> one : <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> mone : <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> kinteger64 : <span class="constructor">Cil</span>.ikind <span class="keywordsign">-></span> int64 <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> kinteger : <span class="constructor">Cil</span>.ikind <span class="keywordsign">-></span> int <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> integer : int <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> isInteger : <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> int64 option<br>
- <span class="keyword">val</span> isConstant : <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> bool<br>
- <span class="keyword">val</span> isZero : <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> bool<br>
- <span class="keyword">val</span> charConstToInt : char <span class="keywordsign">-></span> <span class="constructor">Cil</span>.constant<br>
- <span class="keyword">val</span> constFold : bool <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> constFoldBinOp :<br>
- bool <span class="keywordsign">-></span> <span class="constructor">Cil</span>.binop <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> increm : <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> int <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> var : <span class="constructor">Cil</span>.varinfo <span class="keywordsign">-></span> <span class="constructor">Cil</span>.lval<br>
- <span class="keyword">val</span> mkAddrOf : <span class="constructor">Cil</span>.lval <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> mkAddrOrStartOf : <span class="constructor">Cil</span>.lval <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> mkMem : addr:<span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> off:<span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> <span class="constructor">Cil</span>.lval<br>
- <span class="keyword">val</span> mkString : string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> mkCastT : e:<span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> oldt:<span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> newt:<span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> mkCast : e:<span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> newt:<span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> stripCasts : <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> typeOf : <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> parseInt : string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> mkStmt : <span class="constructor">Cil</span>.stmtkind <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt<br>
- <span class="keyword">val</span> mkBlock : <span class="constructor">Cil</span>.stmt list <span class="keywordsign">-></span> <span class="constructor">Cil</span>.block<br>
- <span class="keyword">val</span> mkStmtOneInstr : <span class="constructor">Cil</span>.instr <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt<br>
- <span class="keyword">val</span> compactStmts : <span class="constructor">Cil</span>.stmt list <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt list<br>
- <span class="keyword">val</span> mkEmptyStmt : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt<br>
- <span class="keyword">val</span> dummyInstr : <span class="constructor">Cil</span>.instr<br>
- <span class="keyword">val</span> dummyStmt : <span class="constructor">Cil</span>.stmt<br>
- <span class="keyword">val</span> mkWhile : guard:<span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> body:<span class="constructor">Cil</span>.stmt list <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt list<br>
- <span class="keyword">val</span> mkForIncr :<br>
- iter:<span class="constructor">Cil</span>.varinfo <span class="keywordsign">-></span><br>
- first:<span class="constructor">Cil</span>.exp <span class="keywordsign">-></span><br>
- stopat:<span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> incr:<span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> body:<span class="constructor">Cil</span>.stmt list <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt list<br>
- <span class="keyword">val</span> mkFor :<br>
- start:<span class="constructor">Cil</span>.stmt list <span class="keywordsign">-></span><br>
- guard:<span class="constructor">Cil</span>.exp <span class="keywordsign">-></span><br>
- next:<span class="constructor">Cil</span>.stmt list <span class="keywordsign">-></span> body:<span class="constructor">Cil</span>.stmt list <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt list<br>
- <span class="keyword">type</span> attributeClass = <span class="constructor">AttrName</span> <span class="keyword">of</span> bool <span class="keywordsign">|</span> <span class="constructor">AttrFunType</span> <span class="keyword">of</span> bool <span class="keywordsign">|</span> <span class="constructor">AttrType</span><br>
- <span class="keyword">val</span> attributeHash : (string, <span class="constructor">Cil</span>.attributeClass) <span class="constructor">Hashtbl</span>.t<br>
- <span class="keyword">val</span> partitionAttributes :<br>
- default:<span class="constructor">Cil</span>.attributeClass <span class="keywordsign">-></span><br>
- <span class="constructor">Cil</span>.attributes <span class="keywordsign">-></span><br>
- <span class="constructor">Cil</span>.attribute list * <span class="constructor">Cil</span>.attribute list * <span class="constructor">Cil</span>.attribute list<br>
- <span class="keyword">val</span> addAttribute : <span class="constructor">Cil</span>.attribute <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes<br>
- <span class="keyword">val</span> addAttributes : <span class="constructor">Cil</span>.attribute list <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes<br>
- <span class="keyword">val</span> dropAttribute : string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes<br>
- <span class="keyword">val</span> dropAttributes : string list <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes<br>
- <span class="keyword">val</span> filterAttributes : string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes<br>
- <span class="keyword">val</span> hasAttribute : string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes <span class="keywordsign">-></span> bool<br>
- <span class="keyword">val</span> typeAttrs : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attribute list<br>
- <span class="keyword">val</span> setTypeAttrs : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> typeAddAttributes : <span class="constructor">Cil</span>.attribute list <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> typeRemoveAttributes : string list <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">type</span> <span class="keywordsign">'</span>a visitAction =<br>
- <span class="constructor">SkipChildren</span><br>
- <span class="keywordsign">|</span> <span class="constructor">DoChildren</span><br>
- <span class="keywordsign">|</span> <span class="constructor">ChangeTo</span> <span class="keyword">of</span> <span class="keywordsign">'</span>a<br>
- <span class="keywordsign">|</span> <span class="constructor">ChangeDoChildrenPost</span> <span class="keyword">of</span> <span class="keywordsign">'</span>a * (<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>a)<br>
- <span class="keyword">class</span> <span class="keyword">type</span> cilVisitor =<br>
- <span class="keyword">object</span><br>
- <span class="keyword">method</span> queueInstr : <span class="constructor">Cil</span>.instr list <span class="keywordsign">-></span> unit<br>
- <span class="keyword">method</span> unqueueInstr : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.instr list<br>
- <span class="keyword">method</span> vattr : <span class="constructor">Cil</span>.attribute <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attribute list <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vattrparam : <span class="constructor">Cil</span>.attrparam <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attrparam <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vblock : <span class="constructor">Cil</span>.block <span class="keywordsign">-></span> <span class="constructor">Cil</span>.block <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vexpr : <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vfunc : <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> <span class="constructor">Cil</span>.fundec <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vglob : <span class="constructor">Cil</span>.global <span class="keywordsign">-></span> <span class="constructor">Cil</span>.global list <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vinit : <span class="constructor">Cil</span>.init <span class="keywordsign">-></span> <span class="constructor">Cil</span>.init <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vinitoffs : <span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> <span class="constructor">Cil</span>.offset <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vinst : <span class="constructor">Cil</span>.instr <span class="keywordsign">-></span> <span class="constructor">Cil</span>.instr list <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vlval : <span class="constructor">Cil</span>.lval <span class="keywordsign">-></span> <span class="constructor">Cil</span>.lval <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> voffs : <span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> <span class="constructor">Cil</span>.offset <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vstmt : <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vtype : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vvdec : <span class="constructor">Cil</span>.varinfo <span class="keywordsign">-></span> <span class="constructor">Cil</span>.varinfo <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">method</span> vvrbl : <span class="constructor">Cil</span>.varinfo <span class="keywordsign">-></span> <span class="constructor">Cil</span>.varinfo <span class="constructor">Cil</span>.visitAction<br>
- <span class="keyword">end</span><br>
- <span class="keyword">class</span> nopCilVisitor : cilVisitor<br>
- <span class="keyword">val</span> visitCilFile : <span class="constructor">Cil</span>.cilVisitor <span class="keywordsign">-></span> <span class="constructor">Cil</span>.file <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> visitCilFileSameGlobals : <span class="constructor">Cil</span>.cilVisitor <span class="keywordsign">-></span> <span class="constructor">Cil</span>.file <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> visitCilGlobal : <span class="constructor">Cil</span>.cilVisitor <span class="keywordsign">-></span> <span class="constructor">Cil</span>.global <span class="keywordsign">-></span> <span class="constructor">Cil</span>.global list<br>
- <span class="keyword">val</span> visitCilFunction : <span class="constructor">Cil</span>.cilVisitor <span class="keywordsign">-></span> <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> <span class="constructor">Cil</span>.fundec<br>
- <span class="keyword">val</span> visitCilExpr : <span class="constructor">Cil</span>.cilVisitor <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> visitCilLval : <span class="constructor">Cil</span>.cilVisitor <span class="keywordsign">-></span> <span class="constructor">Cil</span>.lval <span class="keywordsign">-></span> <span class="constructor">Cil</span>.lval<br>
- <span class="keyword">val</span> visitCilOffset : <span class="constructor">Cil</span>.cilVisitor <span class="keywordsign">-></span> <span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> <span class="constructor">Cil</span>.offset<br>
- <span class="keyword">val</span> visitCilInitOffset : <span class="constructor">Cil</span>.cilVisitor <span class="keywordsign">-></span> <span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> <span class="constructor">Cil</span>.offset<br>
- <span class="keyword">val</span> visitCilInstr : <span class="constructor">Cil</span>.cilVisitor <span class="keywordsign">-></span> <span class="constructor">Cil</span>.instr <span class="keywordsign">-></span> <span class="constructor">Cil</span>.instr list<br>
- <span class="keyword">val</span> visitCilStmt : <span class="constructor">Cil</span>.cilVisitor <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt<br>
- <span class="keyword">val</span> visitCilBlock : <span class="constructor">Cil</span>.cilVisitor <span class="keywordsign">-></span> <span class="constructor">Cil</span>.block <span class="keywordsign">-></span> <span class="constructor">Cil</span>.block<br>
- <span class="keyword">val</span> visitCilType : <span class="constructor">Cil</span>.cilVisitor <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> visitCilVarDecl : <span class="constructor">Cil</span>.cilVisitor <span class="keywordsign">-></span> <span class="constructor">Cil</span>.varinfo <span class="keywordsign">-></span> <span class="constructor">Cil</span>.varinfo<br>
- <span class="keyword">val</span> visitCilInit : <span class="constructor">Cil</span>.cilVisitor <span class="keywordsign">-></span> <span class="constructor">Cil</span>.init <span class="keywordsign">-></span> <span class="constructor">Cil</span>.init<br>
- <span class="keyword">val</span> visitCilAttributes :<br>
- <span class="constructor">Cil</span>.cilVisitor <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attribute list <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attribute list<br>
- <span class="keyword">val</span> msvcMode : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> useLogicalOperators : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> constFoldVisitor : bool <span class="keywordsign">-></span> <span class="constructor">Cil</span>.cilVisitor<br>
- <span class="keyword">type</span> lineDirectiveStyle =<br>
- <span class="constructor">LineComment</span><br>
- <span class="keywordsign">|</span> <span class="constructor">LinePreprocessorInput</span><br>
- <span class="keywordsign">|</span> <span class="constructor">LinePreprocessorOutput</span><br>
- <span class="keyword">val</span> lineDirectiveStyle : <span class="constructor">Cil</span>.lineDirectiveStyle option <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> print_CIL_Input : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> printCilAsIs : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> lineLength : int <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> forgcc : string <span class="keywordsign">-></span> string<br>
- <span class="keyword">val</span> currentLoc : <span class="constructor">Cil</span>.location <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> currentGlobal : <span class="constructor">Cil</span>.global <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> d_loc : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.location <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_thisloc : unit <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_ikind : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.ikind <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_fkind : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.fkind <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_storage : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.storage <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_const : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.constant <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> derefStarLevel : int<br>
- <span class="keyword">val</span> indexLevel : int<br>
- <span class="keyword">val</span> arrowLevel : int<br>
- <span class="keyword">val</span> addrOfLevel : int<br>
- <span class="keyword">val</span> additiveLevel : int<br>
- <span class="keyword">val</span> comparativeLevel : int<br>
- <span class="keyword">val</span> bitwiseLevel : int<br>
- <span class="keyword">val</span> getParenthLevel : <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> int<br>
- <span class="keyword">class</span> <span class="keyword">type</span> cilPrinter =<br>
- <span class="keyword">object</span><br>
- <span class="keyword">method</span> dBlock : <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> int <span class="keywordsign">-></span> <span class="constructor">Cil</span>.block <span class="keywordsign">-></span> unit<br>
- <span class="keyword">method</span> dGlobal : <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> <span class="constructor">Cil</span>.global <span class="keywordsign">-></span> unit<br>
- <span class="keyword">method</span> dInit : <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> int <span class="keywordsign">-></span> <span class="constructor">Cil</span>.init <span class="keywordsign">-></span> unit<br>
- <span class="keyword">method</span> dStmt : <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> int <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> unit<br>
- <span class="keyword">method</span> pAttr : <span class="constructor">Cil</span>.attribute <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc * bool<br>
- <span class="keyword">method</span> pAttrParam : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attrparam <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pAttrs : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pBlock : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.block <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pExp : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pFieldDecl : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.fieldinfo <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pGlobal : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.global <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pInit : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.init <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pInstr : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.instr <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pLabel : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.label <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pLineDirective : ?forcefile:bool <span class="keywordsign">-></span> <span class="constructor">Cil</span>.location <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pLval : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.lval <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pOffset : <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> <span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pStmt : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pStmtKind : <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmtkind <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pType : <span class="constructor">Pretty</span>.doc option <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pVDecl : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.varinfo <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">method</span> pVar : <span class="constructor">Cil</span>.varinfo <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">end</span><br>
- <span class="keyword">class</span> defaultCilPrinterClass : cilPrinter<br>
- <span class="keyword">val</span> defaultCilPrinter : <span class="constructor">Cil</span>.cilPrinter<br>
- <span class="keyword">class</span> plainCilPrinterClass : cilPrinter<br>
- <span class="keyword">val</span> plainCilPrinter : <span class="constructor">Cil</span>.cilPrinter<br>
- <span class="keyword">val</span> printerForMaincil : <span class="constructor">Cil</span>.cilPrinter <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> printType : <span class="constructor">Cil</span>.cilPrinter <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> printExp : <span class="constructor">Cil</span>.cilPrinter <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> printLval : <span class="constructor">Cil</span>.cilPrinter <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.lval <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> printGlobal : <span class="constructor">Cil</span>.cilPrinter <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.global <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> printAttr : <span class="constructor">Cil</span>.cilPrinter <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attribute <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> printAttrs : <span class="constructor">Cil</span>.cilPrinter <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> printInstr : <span class="constructor">Cil</span>.cilPrinter <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.instr <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> printStmt : <span class="constructor">Cil</span>.cilPrinter <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> printBlock : <span class="constructor">Cil</span>.cilPrinter <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.block <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> dumpStmt :<br>
- <span class="constructor">Cil</span>.cilPrinter <span class="keywordsign">-></span> <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> int <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> dumpBlock :<br>
- <span class="constructor">Cil</span>.cilPrinter <span class="keywordsign">-></span> <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> int <span class="keywordsign">-></span> <span class="constructor">Cil</span>.block <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> printInit : <span class="constructor">Cil</span>.cilPrinter <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.init <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> dumpInit :<br>
- <span class="constructor">Cil</span>.cilPrinter <span class="keywordsign">-></span> <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> int <span class="keywordsign">-></span> <span class="constructor">Cil</span>.init <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> d_type : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_exp : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_lval : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.lval <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_offset : <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_init : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.init <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_binop : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.binop <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_unop : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.unop <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_attr : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attribute <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_attrparam : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attrparam <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_attrlist : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_instr : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.instr <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_label : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.label <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_stmt : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_block : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.block <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_global : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.global <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> dn_exp : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> dn_lval : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.lval <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> dn_init : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.init <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> dn_type : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> dn_global : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.global <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> dn_attrlist : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attributes <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> dn_attr : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attribute <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> dn_attrparam : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.attrparam <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> dn_stmt : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> dn_instr : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.instr <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_shortglobal : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.global <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> dumpGlobal :<br>
- <span class="constructor">Cil</span>.cilPrinter <span class="keywordsign">-></span> <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> <span class="constructor">Cil</span>.global <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> dumpFile :<br>
- <span class="constructor">Cil</span>.cilPrinter <span class="keywordsign">-></span> <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.file <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> bug : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc) <span class="constructor">Pervasives</span>.format <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> unimp : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc) <span class="constructor">Pervasives</span>.format <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> error : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc) <span class="constructor">Pervasives</span>.format <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> errorLoc :<br>
- <span class="constructor">Cil</span>.location <span class="keywordsign">-></span> (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc) <span class="constructor">Pervasives</span>.format <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> warn : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc) <span class="constructor">Pervasives</span>.format <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> warnOpt : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc) <span class="constructor">Pervasives</span>.format <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> warnContext : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc) <span class="constructor">Pervasives</span>.format <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> warnContextOpt : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc) <span class="constructor">Pervasives</span>.format <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> warnLoc :<br>
- <span class="constructor">Cil</span>.location <span class="keywordsign">-></span> (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc) <span class="constructor">Pervasives</span>.format <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> d_plainexp : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_plaininit : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.init <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_plainlval : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.lval <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_plaintype : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> uniqueVarNames : <span class="constructor">Cil</span>.file <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> peepHole2 :<br>
- (<span class="constructor">Cil</span>.instr * <span class="constructor">Cil</span>.instr <span class="keywordsign">-></span> <span class="constructor">Cil</span>.instr list option) <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt list <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> peepHole1 :<br>
- (<span class="constructor">Cil</span>.instr <span class="keywordsign">-></span> <span class="constructor">Cil</span>.instr list option) <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt list <span class="keywordsign">-></span> unit<br>
- <span class="keyword">exception</span> <span class="constructor">SizeOfError</span> <span class="keyword">of</span> string * <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> bitsSizeOf : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> int<br>
- <span class="keyword">val</span> sizeOf : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> alignOf_int : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> int<br>
- <span class="keyword">val</span> bitsOffset : <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.offset <span class="keywordsign">-></span> int * int<br>
- <span class="keyword">val</span> char_is_unsigned : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> little_endian : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> underscore_name : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> locUnknown : <span class="constructor">Cil</span>.location<br>
- <span class="keyword">val</span> get_instrLoc : <span class="constructor">Cil</span>.instr <span class="keywordsign">-></span> <span class="constructor">Cil</span>.location<br>
- <span class="keyword">val</span> get_globalLoc : <span class="constructor">Cil</span>.global <span class="keywordsign">-></span> <span class="constructor">Cil</span>.location<br>
- <span class="keyword">val</span> get_stmtLoc : <span class="constructor">Cil</span>.stmtkind <span class="keywordsign">-></span> <span class="constructor">Cil</span>.location<br>
- <span class="keyword">val</span> dExp : <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> dInstr : <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> <span class="constructor">Cil</span>.location <span class="keywordsign">-></span> <span class="constructor">Cil</span>.instr<br>
- <span class="keyword">val</span> dGlobal : <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> <span class="constructor">Cil</span>.location <span class="keywordsign">-></span> <span class="constructor">Cil</span>.global<br>
- <span class="keyword">val</span> mapNoCopy : (<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>a) <span class="keywordsign">-></span> <span class="keywordsign">'</span>a list <span class="keywordsign">-></span> <span class="keywordsign">'</span>a list<br>
- <span class="keyword">val</span> mapNoCopyList : (<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>a list) <span class="keywordsign">-></span> <span class="keywordsign">'</span>a list <span class="keywordsign">-></span> <span class="keywordsign">'</span>a list<br>
- <span class="keyword">val</span> startsWith : string <span class="keywordsign">-></span> string <span class="keywordsign">-></span> bool<br>
- <span class="keyword">type</span> formatArg =<br>
- <span class="constructor">Fe</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.exp<br>
- <span class="keywordsign">|</span> <span class="constructor">Feo</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.exp option<br>
- <span class="keywordsign">|</span> <span class="constructor">Fu</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.unop<br>
- <span class="keywordsign">|</span> <span class="constructor">Fb</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.binop<br>
- <span class="keywordsign">|</span> <span class="constructor">Fk</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.ikind<br>
- <span class="keywordsign">|</span> <span class="constructor">FE</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.exp list<br>
- <span class="keywordsign">|</span> <span class="constructor">Ff</span> <span class="keyword">of</span> (string * <span class="constructor">Cil</span>.typ * <span class="constructor">Cil</span>.attributes)<br>
- <span class="keywordsign">|</span> <span class="constructor">FF</span> <span class="keyword">of</span> (string * <span class="constructor">Cil</span>.typ * <span class="constructor">Cil</span>.attributes) list<br>
- <span class="keywordsign">|</span> <span class="constructor">Fva</span> <span class="keyword">of</span> bool<br>
- <span class="keywordsign">|</span> <span class="constructor">Fv</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.varinfo<br>
- <span class="keywordsign">|</span> <span class="constructor">Fl</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.lval<br>
- <span class="keywordsign">|</span> <span class="constructor">Flo</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.lval option<br>
- <span class="keywordsign">|</span> <span class="constructor">Fo</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.offset<br>
- <span class="keywordsign">|</span> <span class="constructor">Fc</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.compinfo<br>
- <span class="keywordsign">|</span> <span class="constructor">Fi</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.instr<br>
- <span class="keywordsign">|</span> <span class="constructor">FI</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.instr list<br>
- <span class="keywordsign">|</span> <span class="constructor">Ft</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.typ<br>
- <span class="keywordsign">|</span> <span class="constructor">Fd</span> <span class="keyword">of</span> int<br>
- <span class="keywordsign">|</span> <span class="constructor">Fg</span> <span class="keyword">of</span> string<br>
- <span class="keywordsign">|</span> <span class="constructor">Fs</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.stmt<br>
- <span class="keywordsign">|</span> <span class="constructor">FS</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.stmt list<br>
- <span class="keywordsign">|</span> <span class="constructor">FA</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.attributes<br>
- <span class="keywordsign">|</span> <span class="constructor">Fp</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.attrparam<br>
- <span class="keywordsign">|</span> <span class="constructor">FP</span> <span class="keyword">of</span> <span class="constructor">Cil</span>.attrparam list<br>
- <span class="keywordsign">|</span> <span class="constructor">FX</span> <span class="keyword">of</span> string<br>
- <span class="keyword">val</span> d_formatarg : unit <span class="keywordsign">-></span> <span class="constructor">Cil</span>.formatArg <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> lowerConstants : bool <span class="constructor">Pervasives</span>.ref<br>
-<span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Cil.nopCilVisitor.html b/cil/doc/api/type_Cil.nopCilVisitor.html
deleted file mode 100644
index 0ac6c96ba650d97c0caa984f8bfbb0ee5cecf8f4..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Cil.nopCilVisitor.html
+++ /dev/null
@@ -1,25 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.nopCilVisitor</title>
-</head>
-<body>
-<code class="code"><span class="constructor">Cil</span>.cilVisitor</code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Cil.plainCilPrinterClass.html b/cil/doc/api/type_Cil.plainCilPrinterClass.html
deleted file mode 100644
index ecd631718dd3191d78ddcb8ff3b76eb6cb221020..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Cil.plainCilPrinterClass.html
+++ /dev/null
@@ -1,25 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.plainCilPrinterClass</title>
-</head>
-<body>
-<code class="code"><span class="constructor">Cil</span>.cilPrinter</code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Cillower.html b/cil/doc/api/type_Cillower.html
deleted file mode 100644
index a8924ed6ce5caeb590beedc71035989dfa3d2932..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Cillower.html
+++ /dev/null
@@ -1,25 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cillower</title>
-</head>
-<body>
-<code class="code"><span class="keyword">sig</span> <span class="keyword">val</span> lowerEnumVisitor : <span class="constructor">Cil</span>.cilVisitor <span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Clist.html b/cil/doc/api/type_Clist.html
deleted file mode 100644
index c7dbd02fb18fd90b73239b6ca6e489c0c4b05245..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Clist.html
+++ /dev/null
@@ -1,44 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Clist</title>
-</head>
-<body>
-<code class="code"><span class="keyword">sig</span><br>
- <span class="keyword">type</span> <span class="keywordsign">'</span>a clist =<br>
- <span class="constructor">CList</span> <span class="keyword">of</span> <span class="keywordsign">'</span>a list<br>
- <span class="keywordsign">|</span> <span class="constructor">CConsL</span> <span class="keyword">of</span> <span class="keywordsign">'</span>a * <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist<br>
- <span class="keywordsign">|</span> <span class="constructor">CConsR</span> <span class="keyword">of</span> <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist * <span class="keywordsign">'</span>a<br>
- <span class="keywordsign">|</span> <span class="constructor">CSeq</span> <span class="keyword">of</span> <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist * <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist<br>
- <span class="keyword">val</span> toList : <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist <span class="keywordsign">-></span> <span class="keywordsign">'</span>a list<br>
- <span class="keyword">val</span> fromList : <span class="keywordsign">'</span>a list <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist<br>
- <span class="keyword">val</span> single : <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist<br>
- <span class="keyword">val</span> empty : <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist<br>
- <span class="keyword">val</span> append : <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist<br>
- <span class="keyword">val</span> checkBeforeAppend : <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist <span class="keywordsign">-></span> bool<br>
- <span class="keyword">val</span> length : <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist <span class="keywordsign">-></span> int<br>
- <span class="keyword">val</span> map : (<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>b) <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist <span class="keywordsign">-></span> <span class="keywordsign">'</span>b <span class="constructor">Clist</span>.clist<br>
- <span class="keyword">val</span> fold_left : (<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>b <span class="keywordsign">-></span> <span class="keywordsign">'</span>a) <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>b <span class="constructor">Clist</span>.clist <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> iter : (<span class="keywordsign">'</span>a <span class="keywordsign">-></span> unit) <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> rev : (<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>a) <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist<br>
- <span class="keyword">val</span> docCList :<br>
- <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> (<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="constructor">Clist</span>.clist <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
-<span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Dataflow.BackwardsDataFlow.html b/cil/doc/api/type_Dataflow.BackwardsDataFlow.html
deleted file mode 100644
index 78ffeba37e9667ddfdb92d521b6a01cda2f3d67e..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Dataflow.BackwardsDataFlow.html
+++ /dev/null
@@ -1,26 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow.BackwardsDataFlow</title>
-</head>
-<body>
-<code class="code"><span class="keyword">functor</span> (<span class="constructor">T</span> : <span class="constructor">BackwardsTransfer</span>) <span class="keywordsign">-></span><br>
- <span class="keyword">sig</span> <span class="keyword">val</span> compute : <span class="constructor">Cil</span>.stmt list <span class="keywordsign">-></span> unit <span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Dataflow.BackwardsTransfer.html b/cil/doc/api/type_Dataflow.BackwardsTransfer.html
deleted file mode 100644
index 763df7485edabba2062fb02cd701d5122af03256..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Dataflow.BackwardsTransfer.html
+++ /dev/null
@@ -1,44 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow.BackwardsTransfer</title>
-</head>
-<body>
-<code class="code"><span class="keyword">sig</span><br>
- <span class="keyword">val</span> name : string<br>
- <span class="keyword">val</span> debug : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">type</span> t<br>
- <span class="keyword">val</span> pretty : unit <span class="keywordsign">-></span> <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> stmtStartData : <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="constructor">Inthash</span>.t<br>
- <span class="keyword">val</span> combineStmtStartData :<br>
- <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span><br>
- old:<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="keywordsign">-></span> <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t option<br>
- <span class="keyword">val</span> combineSuccessors :<br>
- <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="keywordsign">-></span> <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t<br>
- <span class="keyword">val</span> doStmt : <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="constructor">Dataflow</span>.action<br>
- <span class="keyword">val</span> doInstr :<br>
- <span class="constructor">Cil</span>.instr <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="constructor">Dataflow</span>.action<br>
- <span class="keyword">val</span> filterStmt : <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> bool<br>
-<span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Dataflow.ForwardsDataFlow.html b/cil/doc/api/type_Dataflow.ForwardsDataFlow.html
deleted file mode 100644
index a042cfcee20cf0559d81a67d0984e801c37539d7..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Dataflow.ForwardsDataFlow.html
+++ /dev/null
@@ -1,25 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow.ForwardsDataFlow</title>
-</head>
-<body>
-<code class="code"><span class="keyword">functor</span> (<span class="constructor">T</span> : <span class="constructor">ForwardsTransfer</span>) <span class="keywordsign">-></span> <span class="keyword">sig</span> <span class="keyword">val</span> compute : <span class="constructor">Cil</span>.stmt list <span class="keywordsign">-></span> unit <span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Dataflow.ForwardsTransfer.html b/cil/doc/api/type_Dataflow.ForwardsTransfer.html
deleted file mode 100644
index 1e4d48b7ab271224a14880e211838a546c165cb6..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Dataflow.ForwardsTransfer.html
+++ /dev/null
@@ -1,51 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow.ForwardsTransfer</title>
-</head>
-<body>
-<code class="code"><span class="keyword">sig</span><br>
- <span class="keyword">val</span> name : string<br>
- <span class="keyword">val</span> debug : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">type</span> t<br>
- <span class="keyword">val</span> copy : <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="keywordsign">-></span> <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t<br>
- <span class="keyword">val</span> stmtStartData : <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="constructor">Inthash</span>.t<br>
- <span class="keyword">val</span> pretty : unit <span class="keywordsign">-></span> <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> computeFirstPredecessor :<br>
- <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="keywordsign">-></span> <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t<br>
- <span class="keyword">val</span> combinePredecessors :<br>
- <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span><br>
- old:<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="keywordsign">-></span> <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t option<br>
- <span class="keyword">val</span> doInstr :<br>
- <span class="constructor">Cil</span>.instr <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="constructor">Dataflow</span>.action<br>
- <span class="keyword">val</span> doStmt :<br>
- <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="constructor">Dataflow</span>.stmtaction<br>
- <span class="keyword">val</span> doGuard :<br>
- <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="constructor">Dataflow</span>.guardaction<br>
- <span class="keyword">val</span> filterStmt : <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> bool<br>
-<span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Dataflow.html b/cil/doc/api/type_Dataflow.html
deleted file mode 100644
index fa0347640fe8c70aac5dd9407c6cc5c490327883..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Dataflow.html
+++ /dev/null
@@ -1,85 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow</title>
-</head>
-<body>
-<code class="code"><span class="keyword">sig</span><br>
- <span class="keyword">type</span> <span class="keywordsign">'</span>a action = <span class="constructor">Default</span> <span class="keywordsign">|</span> <span class="constructor">Done</span> <span class="keyword">of</span> <span class="keywordsign">'</span>a <span class="keywordsign">|</span> <span class="constructor">Post</span> <span class="keyword">of</span> (<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>a)<br>
- <span class="keyword">type</span> <span class="keywordsign">'</span>a stmtaction = <span class="constructor">SDefault</span> <span class="keywordsign">|</span> <span class="constructor">SDone</span> <span class="keywordsign">|</span> <span class="constructor">SUse</span> <span class="keyword">of</span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">type</span> <span class="keywordsign">'</span>a guardaction = <span class="constructor">GDefault</span> <span class="keywordsign">|</span> <span class="constructor">GUse</span> <span class="keyword">of</span> <span class="keywordsign">'</span>a <span class="keywordsign">|</span> <span class="constructor">GUnreachable</span><br>
- <span class="keyword">module</span> <span class="keyword">type</span> <span class="constructor">ForwardsTransfer</span> =<br>
- <span class="keyword">sig</span><br>
- <span class="keyword">val</span> name : string<br>
- <span class="keyword">val</span> debug : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">type</span> t<br>
- <span class="keyword">val</span> copy : <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="keywordsign">-></span> <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t<br>
- <span class="keyword">val</span> stmtStartData : <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="constructor">Inthash</span>.t<br>
- <span class="keyword">val</span> pretty : unit <span class="keywordsign">-></span> <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> computeFirstPredecessor :<br>
- <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="keywordsign">-></span> <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t<br>
- <span class="keyword">val</span> combinePredecessors :<br>
- <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span><br>
- old:<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="keywordsign">-></span> <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t option<br>
- <span class="keyword">val</span> doInstr :<br>
- <span class="constructor">Cil</span>.instr <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="constructor">Dataflow</span>.action<br>
- <span class="keyword">val</span> doStmt :<br>
- <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="constructor">Dataflow</span>.stmtaction<br>
- <span class="keyword">val</span> doGuard :<br>
- <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t <span class="constructor">Dataflow</span>.guardaction<br>
- <span class="keyword">val</span> filterStmt : <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> bool<br>
- <span class="keyword">end</span><br>
- <span class="keyword">module</span> <span class="constructor">ForwardsDataFlow</span> :<br>
- <span class="keyword">functor</span> (<span class="constructor">T</span> : <span class="constructor">ForwardsTransfer</span>) <span class="keywordsign">-></span><br>
- <span class="keyword">sig</span> <span class="keyword">val</span> compute : <span class="constructor">Cil</span>.stmt list <span class="keywordsign">-></span> unit <span class="keyword">end</span><br>
- <span class="keyword">module</span> <span class="keyword">type</span> <span class="constructor">BackwardsTransfer</span> =<br>
- <span class="keyword">sig</span><br>
- <span class="keyword">val</span> name : string<br>
- <span class="keyword">val</span> debug : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">type</span> t<br>
- <span class="keyword">val</span> pretty : unit <span class="keywordsign">-></span> <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> stmtStartData : <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="constructor">Inthash</span>.t<br>
- <span class="keyword">val</span> combineStmtStartData :<br>
- <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span><br>
- old:<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="keywordsign">-></span> <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t option<br>
- <span class="keyword">val</span> combineSuccessors :<br>
- <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="keywordsign">-></span> <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t<br>
- <span class="keyword">val</span> doStmt : <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="constructor">Dataflow</span>.action<br>
- <span class="keyword">val</span> doInstr :<br>
- <span class="constructor">Cil</span>.instr <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="keywordsign">-></span><br>
- <span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t <span class="constructor">Dataflow</span>.action<br>
- <span class="keyword">val</span> filterStmt : <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> bool<br>
- <span class="keyword">end</span><br>
- <span class="keyword">module</span> <span class="constructor">BackwardsDataFlow</span> :<br>
- <span class="keyword">functor</span> (<span class="constructor">T</span> : <span class="constructor">BackwardsTransfer</span>) <span class="keywordsign">-></span><br>
- <span class="keyword">sig</span> <span class="keyword">val</span> compute : <span class="constructor">Cil</span>.stmt list <span class="keywordsign">-></span> unit <span class="keyword">end</span><br>
-<span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Dominators.html b/cil/doc/api/type_Dominators.html
deleted file mode 100644
index a9fef53e55a7dcf1d7ecbeaa02682ab248a654f1..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Dominators.html
+++ /dev/null
@@ -1,32 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dominators</title>
-</head>
-<body>
-<code class="code"><span class="keyword">sig</span><br>
- <span class="keyword">val</span> computeIDom : <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt option <span class="constructor">Inthash</span>.t<br>
- <span class="keyword">val</span> getIdom : <span class="constructor">Cil</span>.stmt option <span class="constructor">Inthash</span>.t <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt option<br>
- <span class="keyword">val</span> dominates : <span class="constructor">Cil</span>.stmt option <span class="constructor">Inthash</span>.t <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt <span class="keywordsign">-></span> bool<br>
- <span class="keyword">val</span> findNaturalLoops :<br>
- <span class="constructor">Cil</span>.fundec <span class="keywordsign">-></span><br>
- <span class="constructor">Cil</span>.stmt option <span class="constructor">Inthash</span>.t <span class="keywordsign">-></span> (<span class="constructor">Cil</span>.stmt * <span class="constructor">Cil</span>.stmt list) list<br>
-<span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Errormsg.html b/cil/doc/api/type_Errormsg.html
deleted file mode 100644
index 3ad0a8602c6c85ac50d9cc1cb534eb6dbee44235..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Errormsg.html
+++ /dev/null
@@ -1,64 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Errormsg</title>
-</head>
-<body>
-<code class="code"><span class="keyword">sig</span><br>
- <span class="keyword">val</span> logChannel : <span class="constructor">Pervasives</span>.out_channel <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> debugFlag : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> verboseFlag : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> warnFlag : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">exception</span> <span class="constructor">Error</span><br>
- <span class="keyword">val</span> error : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc, unit) format4 <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> bug : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc, unit) format4 <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> unimp : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc, unit) format4 <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> s : <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>b<br>
- <span class="keyword">val</span> hadErrors : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> warn : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc, unit) format4 <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> warnOpt : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc, unit) format4 <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> log : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc, unit) format4 <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> logg : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc, unit) format4 <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> null : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc, unit) format4 <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> pushContext : (unit <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> popContext : unit <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> showContext : unit <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> withContext : (unit <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span> (<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>b) <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>b<br>
- <span class="keyword">val</span> newline : unit <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> newHline : unit <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> getPosition : unit <span class="keywordsign">-></span> int * string * int<br>
- <span class="keyword">val</span> getHPosition : unit <span class="keywordsign">-></span> int * string<br>
- <span class="keyword">val</span> setHLine : int <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> setHFile : string <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> setCurrentLine : int <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> setCurrentFile : string <span class="keywordsign">-></span> unit<br>
- <span class="keyword">type</span> location = { file : string; line : int; hfile : string; hline : int; }<br>
- <span class="keyword">val</span> d_loc : unit <span class="keywordsign">-></span> <span class="constructor">Errormsg</span>.location <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_hloc : unit <span class="keywordsign">-></span> <span class="constructor">Errormsg</span>.location <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> getLocation : unit <span class="keywordsign">-></span> <span class="constructor">Errormsg</span>.location<br>
- <span class="keyword">val</span> parse_error : string <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> locUnknown : <span class="constructor">Errormsg</span>.location<br>
- <span class="keyword">val</span> readingFromStdin : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> startParsing : ?useBasename:bool <span class="keywordsign">-></span> string <span class="keywordsign">-></span> <span class="constructor">Lexing</span>.lexbuf<br>
- <span class="keyword">val</span> startParsingFromString :<br>
- ?file:string <span class="keywordsign">-></span> ?line:int <span class="keywordsign">-></span> string <span class="keywordsign">-></span> <span class="constructor">Lexing</span>.lexbuf<br>
- <span class="keyword">val</span> finishParsing : unit <span class="keywordsign">-></span> unit<br>
-<span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Formatcil.html b/cil/doc/api/type_Formatcil.html
deleted file mode 100644
index 7c5139b9225fd7f37be4f8b44c49d95c308d0ed9..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Formatcil.html
+++ /dev/null
@@ -1,45 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Formatcil</title>
-</head>
-<body>
-<code class="code"><span class="keyword">sig</span><br>
- <span class="keyword">val</span> cExp : string <span class="keywordsign">-></span> (string * <span class="constructor">Cil</span>.formatArg) list <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp<br>
- <span class="keyword">val</span> cLval : string <span class="keywordsign">-></span> (string * <span class="constructor">Cil</span>.formatArg) list <span class="keywordsign">-></span> <span class="constructor">Cil</span>.lval<br>
- <span class="keyword">val</span> cType : string <span class="keywordsign">-></span> (string * <span class="constructor">Cil</span>.formatArg) list <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ<br>
- <span class="keyword">val</span> cInstr :<br>
- string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.location <span class="keywordsign">-></span> (string * <span class="constructor">Cil</span>.formatArg) list <span class="keywordsign">-></span> <span class="constructor">Cil</span>.instr<br>
- <span class="keyword">val</span> cStmt :<br>
- string <span class="keywordsign">-></span><br>
- (string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.varinfo) <span class="keywordsign">-></span><br>
- <span class="constructor">Cil</span>.location <span class="keywordsign">-></span> (string * <span class="constructor">Cil</span>.formatArg) list <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt<br>
- <span class="keyword">val</span> cStmts :<br>
- string <span class="keywordsign">-></span><br>
- (string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.varinfo) <span class="keywordsign">-></span><br>
- <span class="constructor">Cil</span>.location <span class="keywordsign">-></span> (string * <span class="constructor">Cil</span>.formatArg) list <span class="keywordsign">-></span> <span class="constructor">Cil</span>.stmt list<br>
- <span class="keyword">val</span> dExp : string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.exp <span class="keywordsign">-></span> <span class="constructor">Cil</span>.formatArg list option<br>
- <span class="keyword">val</span> dLval : string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.lval <span class="keywordsign">-></span> <span class="constructor">Cil</span>.formatArg list option<br>
- <span class="keyword">val</span> dType : string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.typ <span class="keywordsign">-></span> <span class="constructor">Cil</span>.formatArg list option<br>
- <span class="keyword">val</span> dInstr : string <span class="keywordsign">-></span> <span class="constructor">Cil</span>.instr <span class="keywordsign">-></span> <span class="constructor">Cil</span>.formatArg list option<br>
- <span class="keyword">val</span> noMemoize : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> test : unit <span class="keywordsign">-></span> unit<br>
-<span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Pretty.MakeMapPrinter.html b/cil/doc/api/type_Pretty.MakeMapPrinter.html
deleted file mode 100644
index 0b9d35ee261f06bbed456ff093287c7323c2a8be..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Pretty.MakeMapPrinter.html
+++ /dev/null
@@ -1,42 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Pretty.MakeMapPrinter</title>
-</head>
-<body>
-<code class="code"><span class="keyword">functor</span><br>
- (<span class="constructor">Map</span> : <span class="keyword">sig</span><br>
- <span class="keyword">type</span> key<br>
- <span class="keyword">type</span> <span class="keywordsign">'</span>a t<br>
- <span class="keyword">val</span> fold :<br>
- (<span class="constructor">Pretty</span>.<span class="constructor">MakeMapPrinter</span>.key <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>b <span class="keywordsign">-></span> <span class="keywordsign">'</span>b) <span class="keywordsign">-></span><br>
- <span class="keywordsign">'</span>a <span class="constructor">Pretty</span>.<span class="constructor">MakeMapPrinter</span>.t <span class="keywordsign">-></span> <span class="keywordsign">'</span>b <span class="keywordsign">-></span> <span class="keywordsign">'</span>b<br>
- <span class="keyword">end</span>) <span class="keywordsign">-></span><br>
- <span class="keyword">sig</span><br>
- <span class="keyword">val</span> docMap :<br>
- ?sep:<span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span><br>
- (<span class="constructor">Map</span>.key <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="constructor">Map</span>.t <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_map :<br>
- ?dmaplet:(<span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span><br>
- string <span class="keywordsign">-></span><br>
- (unit <span class="keywordsign">-></span> <span class="constructor">Map</span>.key <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span><br>
- (unit <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="constructor">Map</span>.t <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Pretty.MakeSetPrinter.html b/cil/doc/api/type_Pretty.MakeSetPrinter.html
deleted file mode 100644
index c5e04661a6bd58bcbaf52334ebd4c2b45f609266..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Pretty.MakeSetPrinter.html
+++ /dev/null
@@ -1,40 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Pretty.MakeSetPrinter</title>
-</head>
-<body>
-<code class="code"><span class="keyword">functor</span><br>
- (<span class="constructor">Set</span> : <span class="keyword">sig</span><br>
- <span class="keyword">type</span> elt<br>
- <span class="keyword">type</span> t<br>
- <span class="keyword">val</span> fold :<br>
- (<span class="constructor">Pretty</span>.<span class="constructor">MakeSetPrinter</span>.elt <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>a) <span class="keywordsign">-></span><br>
- <span class="constructor">Pretty</span>.<span class="constructor">MakeSetPrinter</span>.t <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">end</span>) <span class="keywordsign">-></span><br>
- <span class="keyword">sig</span><br>
- <span class="keyword">val</span> docSet :<br>
- ?sep:<span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span><br>
- (<span class="constructor">Set</span>.elt <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Set</span>.t <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_set :<br>
- string <span class="keywordsign">-></span><br>
- (unit <span class="keywordsign">-></span> <span class="constructor">Set</span>.elt <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Set</span>.t <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Pretty.html b/cil/doc/api/type_Pretty.html
deleted file mode 100644
index fc70f65b24b6123c2fdd56b7d4461f9f843130c0..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Pretty.html
+++ /dev/null
@@ -1,111 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Pretty</title>
-</head>
-<body>
-<code class="code"><span class="keyword">sig</span><br>
- <span class="keyword">type</span> doc<br>
- <span class="keyword">val</span> nil : <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> ( ++ ) : <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> concat : <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> text : string <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> num : int <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> real : float <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> chr : char <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> line : <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> leftflush : <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> break : <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> align : <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> unalign : <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> mark : <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> unmark : <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> indent : int <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> markup : <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> seq :<br>
- sep:<span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span><br>
- doit:(<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span> elements:<span class="keywordsign">'</span>a list <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> docList :<br>
- ?sep:<span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> (<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="keywordsign">'</span>a list <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_list :<br>
- string <span class="keywordsign">-></span> (unit <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="keywordsign">'</span>a list <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> docArray :<br>
- ?sep:<span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span><br>
- (int <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="keywordsign">'</span>a array <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> docOpt : (<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="keywordsign">'</span>a option <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_int32 : int32 <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> f_int32 : unit <span class="keywordsign">-></span> int32 <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_int64 : int64 <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> f_int64 : unit <span class="keywordsign">-></span> int64 <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">module</span> <span class="constructor">MakeMapPrinter</span> :<br>
- <span class="keyword">functor</span><br>
- (<span class="constructor">Map</span> : <span class="keyword">sig</span><br>
- <span class="keyword">type</span> key<br>
- <span class="keyword">type</span> <span class="keywordsign">'</span>a t<br>
- <span class="keyword">val</span> fold :<br>
- (<span class="constructor">Pretty</span>.<span class="constructor">MakeMapPrinter</span>.key <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>b <span class="keywordsign">-></span> <span class="keywordsign">'</span>b) <span class="keywordsign">-></span><br>
- <span class="keywordsign">'</span>a <span class="constructor">Pretty</span>.<span class="constructor">MakeMapPrinter</span>.t <span class="keywordsign">-></span> <span class="keywordsign">'</span>b <span class="keywordsign">-></span> <span class="keywordsign">'</span>b<br>
- <span class="keyword">end</span>) <span class="keywordsign">-></span><br>
- <span class="keyword">sig</span><br>
- <span class="keyword">val</span> docMap :<br>
- ?sep:<span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span><br>
- (<span class="constructor">Map</span>.key <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="constructor">Map</span>.t <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_map :<br>
- ?dmaplet:(<span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span><br>
- string <span class="keywordsign">-></span><br>
- (unit <span class="keywordsign">-></span> <span class="constructor">Map</span>.key <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span><br>
- (unit <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="constructor">Map</span>.t <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">end</span><br>
- <span class="keyword">module</span> <span class="constructor">MakeSetPrinter</span> :<br>
- <span class="keyword">functor</span><br>
- (<span class="constructor">Set</span> : <span class="keyword">sig</span><br>
- <span class="keyword">type</span> elt<br>
- <span class="keyword">type</span> t<br>
- <span class="keyword">val</span> fold :<br>
- (<span class="constructor">Pretty</span>.<span class="constructor">MakeSetPrinter</span>.elt <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>a) <span class="keywordsign">-></span><br>
- <span class="constructor">Pretty</span>.<span class="constructor">MakeSetPrinter</span>.t <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">end</span>) <span class="keywordsign">-></span><br>
- <span class="keyword">sig</span><br>
- <span class="keyword">val</span> docSet :<br>
- ?sep:<span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span><br>
- (<span class="constructor">Set</span>.elt <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Set</span>.t <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> d_set :<br>
- string <span class="keywordsign">-></span><br>
- (unit <span class="keywordsign">-></span> <span class="constructor">Set</span>.elt <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc) <span class="keywordsign">-></span> unit <span class="keywordsign">-></span> <span class="constructor">Set</span>.t <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">end</span><br>
- <span class="keyword">val</span> insert : unit <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc<br>
- <span class="keyword">val</span> dprintf : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc, <span class="constructor">Pretty</span>.doc) format4 <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> gprintf :<br>
- (<span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> <span class="keywordsign">'</span>a) <span class="keywordsign">-></span> (<span class="keywordsign">'</span>b, unit, <span class="constructor">Pretty</span>.doc, <span class="keywordsign">'</span>a) format4 <span class="keywordsign">-></span> <span class="keywordsign">'</span>b<br>
- <span class="keyword">val</span> fprint : <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> width:int <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> sprint : width:int <span class="keywordsign">-></span> <span class="constructor">Pretty</span>.doc <span class="keywordsign">-></span> string<br>
- <span class="keyword">val</span> fprintf :<br>
- <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc) <span class="constructor">Pervasives</span>.format <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> printf : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc) <span class="constructor">Pervasives</span>.format <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> eprintf : (<span class="keywordsign">'</span>a, unit, <span class="constructor">Pretty</span>.doc) <span class="constructor">Pervasives</span>.format <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
- <span class="keyword">val</span> withPrintDepth : int <span class="keywordsign">-></span> (unit <span class="keywordsign">-></span> unit) <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> printDepth : int <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> printIndent : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> fastMode : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> flushOften : bool <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> countNewLines : int <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> auto_printer : string <span class="keywordsign">-></span> <span class="keywordsign">'</span>a<br>
-<span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/api/type_Stats.html b/cil/doc/api/type_Stats.html
deleted file mode 100644
index 77cd218133721a8836b9412f03b2dbab191d7914..0000000000000000000000000000000000000000
--- a/cil/doc/api/type_Stats.html
+++ /dev/null
@@ -1,36 +0,0 @@
-<html><head>
-<link rel="stylesheet" href="style.css" type="text/css">
-<link rel="Start" href="index.html">
-<link title="Index of types" rel=Appendix href="index_types.html">
-<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
-<link title="Index of values" rel=Appendix href="index_values.html">
-<link title="Index of class methods" rel=Appendix href="index_methods.html">
-<link title="Index of classes" rel=Appendix href="index_classes.html">
-<link title="Index of class types" rel=Appendix href="index_class_types.html">
-<link title="Index of modules" rel=Appendix href="index_modules.html">
-<link title="Index of module types" rel=Appendix href="index_module_types.html">
-<link title="Pretty" rel="Chapter" href="Pretty.html">
-<link title="Errormsg" rel="Chapter" href="Errormsg.html">
-<link title="Clist" rel="Chapter" href="Clist.html">
-<link title="Stats" rel="Chapter" href="Stats.html">
-<link title="Cil" rel="Chapter" href="Cil.html">
-<link title="Formatcil" rel="Chapter" href="Formatcil.html">
-<link title="Alpha" rel="Chapter" href="Alpha.html">
-<link title="Cillower" rel="Chapter" href="Cillower.html">
-<link title="Cfg" rel="Chapter" href="Cfg.html">
-<link title="Dataflow" rel="Chapter" href="Dataflow.html">
-<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Stats</title>
-</head>
-<body>
-<code class="code"><span class="keyword">sig</span><br>
- <span class="keyword">val</span> reset : bool <span class="keywordsign">-></span> unit<br>
- <span class="keyword">exception</span> <span class="constructor">NoPerfCount</span><br>
- <span class="keyword">val</span> has_performance_counters : unit <span class="keywordsign">-></span> bool<br>
- <span class="keyword">val</span> sample_pentium_perfcount_20 : unit <span class="keywordsign">-></span> int<br>
- <span class="keyword">val</span> sample_pentium_perfcount_10 : unit <span class="keywordsign">-></span> int<br>
- <span class="keyword">val</span> time : string <span class="keywordsign">-></span> (<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>b) <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>b<br>
- <span class="keyword">val</span> repeattime : float <span class="keywordsign">-></span> string <span class="keywordsign">-></span> (<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>b) <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>b<br>
- <span class="keyword">val</span> print : <span class="constructor">Pervasives</span>.out_channel <span class="keywordsign">-></span> string <span class="keywordsign">-></span> unit<br>
- <span class="keyword">val</span> lastTime : float <span class="constructor">Pervasives</span>.ref<br>
- <span class="keyword">val</span> timethis : (<span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>b) <span class="keywordsign">-></span> <span class="keywordsign">'</span>a <span class="keywordsign">-></span> <span class="keywordsign">'</span>b<br>
-<span class="keyword">end</span></code></body></html>
\ No newline at end of file
diff --git a/cil/doc/changes.html b/cil/doc/changes.html
deleted file mode 100644
index 17ffdf7171a8662abe50a665497410ff38b03a2a..0000000000000000000000000000000000000000
--- a/cil/doc/changes.html
+++ /dev/null
@@ -1,486 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-Changes
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="cil019.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc49">20</A> Changes</H2><A NAME="sec-changes"></A>
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<B>May 20, 2006</B>: <B>Released version 1.3.5</B>
-<LI CLASS="li-itemize"><B>May 19, 2006</B>: <TT>Makefile.cil.in</TT>/<TT>Makefile.cil</TT> have
- been renamed <TT>Makefile.in</TT>/<TT>Makefile</TT>. And <TT>maincil.ml</TT> has
- been renamed <TT>main.ml</TT>.
-<LI CLASS="li-itemize"><B>May 18, 2006</B>: Added a new module <A HREF="api/Cfg.html">Cfg</A> to compute the
- control-flow graph. Unlike the older <A HREF="api/Cil.html#VALcomputeCFGInfo">Cil.computeCFGInfo</A>,
- the new version does not modify the code.
-<LI CLASS="li-itemize"><B>May 18, 2006</B>: Added several new analyses: reaching
- definitions, available expressions, liveness analysis, and dead code
- elimination. See Section <A HREF="ext.html#sec-Extension">8</A>.
-<LI CLASS="li-itemize"><B>May 2, 2006</B>: Added a flag <TT>--noInsertImplicitCasts</TT>.
- When this flag is used, CIL code will only include casts inserted by
- the programmer. Implicit coercions are not changed to explicit casts.
-<LI CLASS="li-itemize"><B>April 16, 2006</B>: Minor improvements to the <TT>--stats</TT>
- flag (Section <A HREF="cil007.html#sec-cilly-asm-options">7.2</A>). We now use Pentium performance
- counters by default, if your processor supports them.
-<LI CLASS="li-itemize"><B>April 10, 2006</B>: Extended <TT>machdep.c</TT> to support
- microcontroller compilers where the struct alignment of integer
- types does not match the size of the type. Thanks to Nathan
- Cooprider for the patch.
-<LI CLASS="li-itemize"><B>April 6, 2006</B>: Fix for global initializers of unions when
- the union field being initialized is not the first one, and for
- missing initializers of unions when the first field is not the
- largest field.
-<LI CLASS="li-itemize"><B>April 6, 2006</B>: Fix for bitfields in the SFI module.
-<LI CLASS="li-itemize"><B>April 6, 2006</B>: Various fixes for gcc attributes.
- <TT>packed</TT>, <TT>section</TT>, and <TT>always_inline</TT> attributes are now
- parsed correctly. Also fixed printing of attributes on enum types.
-<LI CLASS="li-itemize"><B>March 30, 2006</B>: Fix for <TT>rmtemps.ml</TT>, which deletes
- unused inline functions. When in <TT>gcc</TT> mode CIL now leaves all
- inline functions in place, since <TT>gcc</TT> treats these as externally
- visible.
-<LI CLASS="li-itemize"><B>March 15, 2006</B>: Fix for <TT>typeof(<I>e</I>)</TT> when <I>e</I> has type
- <TT>void</TT>.
-<LI CLASS="li-itemize"><B>March 3, 2006</B>: Assume inline assembly instructions can
- fall through for the purposes of adding return statements. Thanks to
- Nathan Cooprider for the patch.
-<LI CLASS="li-itemize"><B>February 27, 2006</B>: Fix for extern inline functions when
- the output of CIL is fed back into CIL.
-<LI CLASS="li-itemize"><B>January 30, 2006</B>: Fix parsing of <TT>switch</TT> without braces.
-<LI CLASS="li-itemize"><B>January 30, 2006</B>: Allow `$' to appear in identifiers.
-<LI CLASS="li-itemize"><B>January 13, 2006</B>: Added support for gcc's alias attribute
- on functions. See Section <A HREF="cil016.html#sec-ugly-gcc">16.2</A>, item 8.
-<LI CLASS="li-itemize"><B>December 9, 2005</B>: Christoph Spiel fixed the Golf and
- Olf modules so that Golf can be used with the points-to analysis.
- He also added performance fixes and cleaned up the documentation.
-<LI CLASS="li-itemize"><B>December 1, 2005</B>: Major rewrite of the ext/callgraph module.
-<LI CLASS="li-itemize"><B>December 1, 2005</B>: Preserve enumeration constants in CIL. Default
-is the old behavior to replace them with integers.
-<LI CLASS="li-itemize"><B>November 30, 2005</B>: Added support for many GCC <TT>__builtin</TT>
- functions.
-<LI CLASS="li-itemize"><B>November 30, 2005</B>: Added the EXTRAFEATURES configure
- option, making it easier to add Features to the build process.
-<LI CLASS="li-itemize"><B>November 23, 2005</B>: In MSVC mode do not remove any locals whose name
- appears as a substring in an inline assembly.
-<LI CLASS="li-itemize"><B>November 23, 2005</B>: Do not add a return to functions that have the
- noreturn attribute.
-<LI CLASS="li-itemize"><B>November 22, 2005</B>: <B>Released version 1.3.4</B>
-<LI CLASS="li-itemize"><B>November 21, 2005</B>: Performance and correctness fixes for
- the Points-to Analysis module. Thanks to Christoph Spiel for the
- patches.
-<LI CLASS="li-itemize"><B>October 5, 2005</B>: CIL now builds on SPARC/Solaris. Thanks
- to Nick Petroni and Remco van Engelen for the patches.
-<LI CLASS="li-itemize"><B>September 26, 2005</B>: CIL no longer uses the `<TT>-I-</TT>' flag
- by default when preprocessing with gcc.
-<LI CLASS="li-itemize"><B>August 24, 2005</B>: Added a command-line option
- “--forceRLArgEval” that forces function arguments to be evaluated
- right-to-left. This is the default behavior in unoptimized gcc and
- MSVC, but the order of evaluation is undefined when using
- optimizations, unless you apply this CIL transformation. This flag
- does not affect the order of evaluation of e.g. binary operators,
- which remains undefined. Thanks to Nathan Cooprider for the patch.
-<LI CLASS="li-itemize"><B>August 9, 2005</B>: Fixed merging when there are more than 20
- input files.
-<LI CLASS="li-itemize"><B>August 3, 2005</B>: When merging, it is now an error to
- declare the same global variable twice with different initializers.
-<LI CLASS="li-itemize"><B>July 27, 2005</B>: Fixed bug in transparent unions.
-<LI CLASS="li-itemize"><B>July 27, 2005</B>: Fixed bug in collectInitializer. Thanks to
- Benjamin Monate for the patch.
-<LI CLASS="li-itemize"><B>July 26, 2005</B>: Better support for extended inline assembly
- in gcc.
-<LI CLASS="li-itemize"><B>July 26, 2005</B>: Added many more gcc __builtin* functions
- to CIL. Most are treated as Call instructions, but a few are
- translated into expressions so that they can be used in global
- initializers. For example, “<TT>__builtin_offsetof(t, field)</TT>” is
- rewritten as “<TT>&((t*)0)->field</TT>”, the traditional way of calculating
- an offset.
-<LI CLASS="li-itemize"><B>July 18, 2005</B>: Fixed bug in the constant folding of shifts
- when the second argument was negative or too large.
-<LI CLASS="li-itemize"><B>July 18, 2005</B>: Fixed bug where casts were not always
- inserted in function calls.
-<LI CLASS="li-itemize"><B>June 10, 2005</B>: Fixed bug in the code that makes implicit
- returns explicit. We weren't handling switch blocks correctly.
-<LI CLASS="li-itemize"><B>June 1, 2005</B>: <B>Released version 1.3.3</B>
-<LI CLASS="li-itemize"><B>May 31, 2005</B>: Fixed handling of noreturn attribute for function
- pointers.
-<LI CLASS="li-itemize"><B>May 30, 2005</B>: Fixed bugs in the handling of constructors in gcc.
-<LI CLASS="li-itemize"><B>May 30, 2005</B>: Fixed bugs in the generation of global variable IDs.
-<LI CLASS="li-itemize"><B>May 27, 2005</B>: Reimplemented the translation of function calls so
- that we can intercept some builtins. This is important for the uses of
- __builtin_constant_p in constants.
-<LI CLASS="li-itemize"><B>May 27, 2005</B>: Export the plainCilPrinter, for debugging.
-<LI CLASS="li-itemize"><B>May 27, 2005</B>: Fixed bug with printing of const attribute for
- arrays.
-<LI CLASS="li-itemize"><B>May 27, 2005</B>: Fixed bug in generation of type signatures. Now they
- should not contain expressions anymore, so you can use structural equality.
- This used to lead to Out_of_Memory exceptions.
-<LI CLASS="li-itemize"><B>May 27, 2005</B>: Fixed bug in type comparisons using
- TBuiltin_va_list.
-<LI CLASS="li-itemize"><B>May 27, 2005</B>: Improved the constant folding in array lengths and
- case expressions.
-<LI CLASS="li-itemize"><B>May 27, 2005</B>: Added the <TT>__builtin_frame_address</TT> to the set
- of gcc builtins.
-<LI CLASS="li-itemize"><B>May 27, 2005</B>: Added the CIL project to SourceForge.
-<LI CLASS="li-itemize"><B>April 23, 2005</B>: The cattr field was not visited.
-<LI CLASS="li-itemize"><B>March 6, 2005</B>: Debian packaging support
-<LI CLASS="li-itemize"><B>February 16, 2005</B>: Merger fixes.
-<LI CLASS="li-itemize"><B>February 11, 2005</B>: Fixed a bug in <TT>--dopartial</TT>. Thanks to
-Nathan Cooprider for this fix.
-<LI CLASS="li-itemize"><B>January 31, 2005</B>: Make sure the input file is closed even if a
- parsing error is encountered.
-<LI CLASS="li-itemize"><B>January 11, 2005</B>: <B>Released version 1.3.2</B>
-<LI CLASS="li-itemize"><B>January 11, 2005</B>: Fixed printing of integer constants whose
- integer kind is shorter than an int.
-<LI CLASS="li-itemize"><B>January 11, 2005</B>: Added checks for negative size arrays and arrays
- too big.
-<LI CLASS="li-itemize"><B>January 10, 2005</B>: Added support for GCC attribute “volatile” for
- tunctions (as a synonim for noreturn).
-<LI CLASS="li-itemize"><B>January 10, 2005</B>: Improved the comparison of array sizes when
- comparing array types.
-<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed handling of shell metacharacters in the
- cilly command lione.
-<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed dropping of cast in initialization of
- local variable with the result of a function call.
-<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed some structural comparisons that were
- broken in the Ocaml 3.08.
-<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed the <TT>unrollType</TT> function to not forget
- attributes.
-<LI CLASS="li-itemize"><B>January 10, 2005</B>: Better keeping track of locations of function
- prototypes and definitions.
-<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed bug with the expansion of enumeration
- constants in attributes.
-<LI CLASS="li-itemize"><B>October 18, 2004</B>: Fixed a bug in cabsvisit.ml. CIl would wrap a
- BLOCK around a single atom unnecessarily.
-<LI CLASS="li-itemize"><B>August 7, 2004</B>: <B>Released version 1.3.1</B>
-<LI CLASS="li-itemize"><B>August 4, 2004</B>: Fixed a bug in splitting of structs using
- <TT>--dosimplify</TT>
-<LI CLASS="li-itemize"><B>July 29, 2004</B>: Minor changes to the type typeSig (type signatures)
- to ensure that they do not contain types, so that you can do structural
- comparison without danger of nontermination.
-<LI CLASS="li-itemize"><B>July 28, 2004</B>: Ocaml version 3.08 is required. Numerous small
- changes while porting to Ocaml 3.08.
-<LI CLASS="li-itemize"><B>July 7, 2004</B>: <B>Released version 1.2.6</B>
-<LI CLASS="li-itemize"><B>July 2, 2004</B>: Character constants such as <TT>'c'</TT> should
- have type <TT>int</TT>, not <TT>char</TT>. Added a utility function
- <TT>Cil.charConstToInt</TT> that sign-extends chars greater than 128, if needed.
-<LI CLASS="li-itemize"><B>July 2, 2004</B>: Fixed a bug that was casting values to int
- before applying the logical negation operator !. This caused
- problems for floats, and for integer types bigger than <TT>int</TT>.
-<LI CLASS="li-itemize"><B>June 13, 2004</B>: Added the field <TT>sallstmts</TT> to a function
- description, to hold all statements in the function.
-<LI CLASS="li-itemize"><B>June 13, 2004</B>: Added new extensions for data flow analyses, and
- for computing dominators.
-<LI CLASS="li-itemize"><B>June 10, 2004</B>: Force initialization of CIL at the start of
-Cabs2cil.
-<LI CLASS="li-itemize"><B>June 9, 2004</B>: Added support for GCC <TT>__attribute_used__</TT>
-<LI CLASS="li-itemize"><B>April 7, 2004</B>: <B>Released version 1.2.5</B>
-<LI CLASS="li-itemize"><B>April 7, 2004</B>: Allow now to run ./configure CC=cl and set the MSVC
-compiler to be the default. The MSVC driver will now select the default name
-of the .exe file like the CL compiler.
-<LI CLASS="li-itemize"><B>April 7, 2004</B>: Fixed a bug in the driver. The temporary files are
-deleted by the Perl script before the CL compiler gets to them?
-<LI CLASS="li-itemize"><B>April 7, 2004</B>: Added the - form of arguments to the MSVC driver.
-<LI CLASS="li-itemize"><B>April 7, 2004</B>: Added a few more GCC-specific string escapes, (, [,
-{, %, E.
-<LI CLASS="li-itemize"><B>April 7, 2004</B>: Fixed bug with continuation lines in MSVC.
-<LI CLASS="li-itemize"><B>April 6, 2004</B>: Fixed embarassing bug in the parser: the precedence
- of casts and unary operators was switched.
-<LI CLASS="li-itemize"><B>April 5, 2004</B>: Fixed a bug involving statements mixed between
-declarations containing initializers. Now we make sure that the initializers
-are run in the proper order with respect to the statements.
-<LI CLASS="li-itemize"><B>April 5, 2004</B>: Fixed a bug in the merger. The merger was keeping
-separate alpha renaming talbes (namespaces) for variables and types. This
-means that it might end up with a type and a variable named the same way, if
-they come from different files, which breaks an important CIL invariant.
-<LI CLASS="li-itemize"><B>March 11, 2004</B> : Fixed a bug in the Cil.copyFunction function. The
-new local variables were not getting fresh IDs.
-<LI CLASS="li-itemize"><B>March 5, 2004</B>: Fixed a bug in the handling of static function
- prototypes in a block scope. They used to be renamed. Now we just consider
- them global.
-<LI CLASS="li-itemize"><B>February 20, 2004</B>: <B>Released version 1.2.4</B>
-<LI CLASS="li-itemize"><B>February 15, 2004</B>: Changed the parser to allow extra semicolons
- after field declarations.
-<LI CLASS="li-itemize"><B>February 14, 2004</B>: Changed the Errormsg functions: error, unimp,
-bug to not raise an exception. Instead they just set Errormsg.hadErrors.
-<LI CLASS="li-itemize"><B>February 13, 2004</B>: Change the parsing of attributes to recognize
- enumeration constants.
-<LI CLASS="li-itemize"><B>February 10, 2004</B>: In some versions of <TT>gcc</TT> the identifier
- _{thread is an identifier and in others it is a keyword. Added code
- during configuration to detect which is the case.
-<LI CLASS="li-itemize"><B>January 7, 2004</B>: <B>Released version 1.2.3</B>
-<LI CLASS="li-itemize"><B>January 7, 2004</B>: Changed the alpha renamer to be less
-conservative. It will remember all versions of a name that were seen and will
-only create a new name if we have not seen one.
-<LI CLASS="li-itemize"><B>December 30, 2003</B> : Extended the <TT>cilly</TT> command to understand
- better linker command options <TT>-lfoo</TT>.
-<LI CLASS="li-itemize"><B>December 5, 2003</B>: Added markup commands to the pretty-printer
-module. Also, changed the “@<” left-flush command into “@''.
-<LI CLASS="li-itemize"><B>December 4, 2003</B>: Wide string literals are now handled
-directly by Cil (rather than being exploded into arrays). This is
-apparently handy for Microsoft Device Driver APIs that use intrinsic
-functions that require literal constant wide-string arguments.
-<LI CLASS="li-itemize"><B>December 3, 2003</B>: Added support for structured exception handling
- extensions for the Microsoft compilers.
-<LI CLASS="li-itemize"><B>December 1, 2003</B>: Fixed a Makefile bug in the generation of the
-Cil library (e.g., <TT>cil.cma</TT>) that was causing it to be unusable. Thanks
-to KEvin Millikin for pointing out this bug.
-<LI CLASS="li-itemize"><B>November 26, 2003</B>: Added support for linkage specifications
- (extern “C”).
-<LI CLASS="li-itemize"><B>November 26, 2003</B>: Added the ocamlutil directory to contain some
-utilities shared with other projects.
-<LI CLASS="li-itemize"><B>November 25, 2003</B>: <B>Released version 1.2.2</B>
-<LI CLASS="li-itemize"><B>November 24, 2003</B>: Fixed a bug that allowed a static local to
- conflict with a global with the same name that is declared later in the
- file.
-<LI CLASS="li-itemize"><B>November 24, 2003</B>: Removed the <TT>--keep</TT> option of the <TT>cilly</TT>
- driver and replaced it with <TT>--save-temps</TT>.
-<LI CLASS="li-itemize"><B>November 24, 2003</B>: Added printing of what CIL features are being
- run.
-<LI CLASS="li-itemize"><B>November 24, 2003</B>: Fixed a bug that resulted in attributes being
- dropped for integer types.
-<LI CLASS="li-itemize"><B>November 11, 2003</B>: Fixed a bug in the visitor for enumeration
- definitions.
-<LI CLASS="li-itemize"><B>October 24, 2003</B>: Fixed a problem in the configuration script. It
- was not recognizing the Ocaml version number for beta versions.
-<LI CLASS="li-itemize"><B>October 15, 2003</B>: Fixed a problem in version 1.2.1 that was
- preventing compilation on OCaml 3.04.
-<LI CLASS="li-itemize"><B>September 17, 2003: Released version 1.2.1.</B>
-<LI CLASS="li-itemize"><B>September 7, 2003</B>: Redesigned the interface for choosing
- <TT>#line</TT> directive printing styles. Cil.printLn and
- Cil.printLnComment have been merged into Cil.lineDirectiveStyle.
-<LI CLASS="li-itemize"><B>August 8, 2003</B>: Do not silently pad out functions calls with
-arguments to match the prototype.
-<LI CLASS="li-itemize"><B>August 1, 2003</B>: A variety of fixes suggested by Steve Chamberlain:
-initializers for externs, prohibit float literals in enum, initializers for
-unsized arrays were not working always, an overflow problem in Ocaml, changed
-the processing of attributes before struct specifiers<BR>
-<BR>
-<LI CLASS="li-itemize"><B>July 14, 2003</B>: Add basic support for GCC's "__thread" storage
-qualifier. If given, it will appear as a "thread" attribute at the top of the
-type of the declared object. Treatment is very similar to "__declspec(...)"
-in MSVC<BR>
-<BR>
-<LI CLASS="li-itemize"><B>July 8, 2003</B>: Fixed some of the __alignof computations. Fixed
- bug in the designated initializers for arrays (Array.get error).
-<LI CLASS="li-itemize"><B>July 8, 2003</B>: Fixed infinite loop bug (Stack Overflow) in the
- visitor for __alignof.
-<LI CLASS="li-itemize"><B>July 8, 2003</B>: Fixed bug in the conversion to CIL. A function or
- array argument of
- the GCC __typeof() was being converted to pointer type. Instead, it should
- be left alone, just like for sizeof.
-<LI CLASS="li-itemize"><B>July 7, 2003</B>: New Escape module provides utility functions
- for escaping characters and strings in accordance with C lexical
- rules.<BR>
-<BR>
-<LI CLASS="li-itemize"><B>July 2, 2003</B>: Relax CIL's rules for when two enumeration types are
-considered compatible. Previously CIL considered two enums to be compatible if
-they were the same enum. Now we follow the C99 standard.<BR>
-<BR>
-<LI CLASS="li-itemize"><B>June 28, 2003</B>: In the Formatparse module, Eric Haugh found and
- fixed a bug in the handling of lvalues of the form “lv->field.more”.<BR>
-<BR>
-<LI CLASS="li-itemize"><B>June 28, 2003</B>: Extended the handling of gcc command lines
-arguments in the Perl scripts. <BR>
-<BR>
-<LI CLASS="li-itemize"><B>June 23, 2003</B>: In Rmtmps module, simplified the API for
- customizing the root set. Clients may supply a predicate that
- returns true for each root global. Modifying various
- “<TT>referenced</TT>” fields directly is no longer supported.<BR>
-<BR>
-<LI CLASS="li-itemize"><B>June 17, 2003</B>: Reimplement internal utility routine
- <TT>Cil.escape_char</TT>. Faster and better. <BR>
-<BR>
-<LI CLASS="li-itemize"><B>June 14, 2003</B>: Implemented support for <TT>__attribute__s</TT>
-appearing between "struct" and the struct tag name (also for unions and
-enums), since gcc supports this as documented in section 4.30 of the gcc
-(2.95.3) manual<BR>
-<BR>
-<LI CLASS="li-itemize"><B>May 30, 2003</B>: Released the regression tests.
-<LI CLASS="li-itemize"><B>May 28, 2003</B>: <B>Released version 1.1.2</B>
-<LI CLASS="li-itemize"><B>May 26, 2003</B>: Add the <TT>simplify</TT> module that compiles CIL
-expressions into simpler expressions, similar to those that appear in a
-3-address intermediate language.
-<LI CLASS="li-itemize"><B>May 26, 2003</B>: Various fixes and improvements to the pointer
-analysis modules.
-<LI CLASS="li-itemize"><B>May 26, 2003</B>: Added optional consistency checking for
-transformations.
-<LI CLASS="li-itemize"><B>May 25, 2003</B>: Added configuration support for big endian machines.
-Now <A HREF="api/Cil.html#VALlittle_endian">Cil.little_endian</A> can be used to test whether the machine is
-little endian or not.
-<LI CLASS="li-itemize"><B>May 22, 2003</B>: Fixed a bug in the handling of inline functions. The
-CIL merger used to turn these functions into “static”, which is incorrect.
-<LI CLASS="li-itemize"><B>May 22, 2003</B>: Expanded the CIL consistency checker to verify
-undesired sharing relationships between data structures.
-<LI CLASS="li-itemize"><B>May 22, 2003</B>: Fixed bug in the <TT>oneret</TT> CIL module: it was
-mishandling certain labeled return statements.
-<LI CLASS="li-itemize"><B>May 5, 2003</B>: <B>Released version 1.0.11</B>
-<LI CLASS="li-itemize"><B>May 5, 2003</B>: OS X (powerpc/darwin) support for CIL. Special
-thanks to Jeff Foster, Andy Begel and Tim Leek.
-<LI CLASS="li-itemize"><B>April 30, 2003</B>: Better description of how to use CIL for your
-analysis.
-<LI CLASS="li-itemize"><B>April 28, 2003</B>: Fixed a bug with <TT>--dooneRet</TT> and
-<TT>--doheapify</TT>. Thanks, Manos Renieris.
-<LI CLASS="li-itemize"><B>April 16, 2003</B>: Reworked management of
- temporary/intermediate output files in Perl driver scripts. Default
- behavior is now to remove all such files. To keep intermediate
- files, use one of the following existing flags:
- <UL CLASS="itemize"><LI CLASS="li-itemize">
- <TT>--keepmerged</TT> for the single-file merge of all sources
- <LI CLASS="li-itemize"><TT>--keep=<<I>dir</I></TT><TT>></TT> for various other CIL and
- CCured output files
- <LI CLASS="li-itemize"><TT>--save-temps</TT> for various gcc intermediate files; MSVC
- has no equivalent option
- </UL>
- As part of this change, some intermediate files have changed their
- names slightly so that new suffixes are always preceded by a
- period. For example, CCured output that used to appear in
- “<TT>foocured.c</TT>” now appears in “<TT>foo.cured.c</TT>”.
-<LI CLASS="li-itemize"><B>April 7, 2003</B>: Changed the representation of the <A HREF="api/Cil.html#VALGVar">Cil.GVar</A>
-global constructor. Now it is possible to update the initializer without
-reconstructing the global (which in turn it would require reconstructing the
-list of globals that make up a program). We did this because it is often
-tempting to use <A HREF="api/Cil.html#VALvisitCilFileSameGlobals">Cil.visitCilFileSameGlobals</A> and the <A HREF="api/Cil.html#VALGVar">Cil.GVar</A>
-was the only global that could not be updated in place.
-<LI CLASS="li-itemize"><B>April 6, 2003</B>: Reimplemented parts of the cilly.pl script to make
-it more robust in the presence of complex compiler arguments.
-<LI CLASS="li-itemize"><B>March 10, 2003</B>: <B>Released version 1.0.9</B>
-<LI CLASS="li-itemize"><B>March 10, 2003</B>: Unified and documented a large number of CIL
-Library Modules: oneret, simplemem, makecfg, heapify, stackguard, partial.
-Also documented the main client interface for the pointer analysis.
-<LI CLASS="li-itemize"><B>February 18, 2003</B>: Fixed a bug in logwrites that was causing it
-to produce invalid C code on writes to bitfields. Thanks, David Park.
-<LI CLASS="li-itemize"><B>February 15, 2003</B>: <B>Released version 1.0.8</B>
-<LI CLASS="li-itemize"><B>February 15, 2003</B>: PDF versions of the manual and API are
-available for those who would like to print them out.
-<LI CLASS="li-itemize"><B>February 14, 2003</B>: CIL now comes bundled with alias analyses.
-<LI CLASS="li-itemize"><B>February 11, 2003</B>: Added support for adding/removing options from
- <TT>./configure</TT>.
-<LI CLASS="li-itemize"><B>February 3, 2003</B>: <B>Released version 1.0.7</B>
-<LI CLASS="li-itemize"><B>February 1, 2003</B>: Some bug fixes in the handling of variable
-argument functions in new versions of <TT>gcc</TT> And <TT>glibc</TT>.
-<LI CLASS="li-itemize"><B>January 29, 2003</B>: Added the logical AND and OR operators.
-Exapanded the translation to CIL to handle more complicated initializers
-(including those that contain logical operators).
-<LI CLASS="li-itemize"><B>January 28, 2003</B>: <B>Released version 1.0.6</B>
-<LI CLASS="li-itemize"><B>January 28, 2003</B>: Added support for the new handling of
-variable-argument functions in new versions of <TT>glibc</TT>.
-<LI CLASS="li-itemize"><B>January 19, 2003</B>: Added support for declarations in interpreted
- constructors. Relaxed the semantics of the patterns for variables.
-<LI CLASS="li-itemize"><B>January 17, 2003</B>: Added built-in prototypes for the gcc built-in
- functions. Changed the <TT>pGlobal</TT> method in the printers to print the
- carriage return as well.
-<LI CLASS="li-itemize"><B>January 9, 2003</B>: Reworked lexer and parser's strategy for
- tracking source file names and line numbers to more closely match
- typical native compiler behavior. The visible CIL interface is
- unchanged.
-<LI CLASS="li-itemize"><B>January 9, 2003</B>: Changed the interface to the alpha convertor. Now
-you can pass a list where it will record undo information that you can use to
-revert the changes that it makes to the scope tables.
-<LI CLASS="li-itemize"><B>January 6, 2003</B>: <B>Released version 1.0.5</B>
-<LI CLASS="li-itemize"><B>January 4, 2003</B>: Changed the interface for the Formatcil module.
- Now the placeholders in the pattern have names. Also expanded the
- documentation of the Formatcil module.
- Now the placeholders in the pattern have names.
-<LI CLASS="li-itemize"><B>January 3, 2003</B>: Extended the <TT>rmtmps</TT> module to also remove
- unused labels that are generated in the conversion to CIL. This reduces the
- number of warnings that you get from <TT>cgcc</TT> afterwards.
-<LI CLASS="li-itemize"><B>December 17, 2002</B>: Fixed a few bugs in CIL related to the
- representation of string literals. The standard says that a string literal
- is an array. In CIL, a string literal has type pointer to character. This is
- Ok, except as an argument of sizeof. To support this exception, we have
- added to CIL the expression constructor SizeOfStr. This allowed us to fix
- bugs with computing <TT>sizeof("foo bar")</TT> and <TT>sizeof((char*)"foo bar")</TT>
- (the former is 8 and the latter is 4).<BR>
-<BR>
-<LI CLASS="li-itemize"><B>December 8, 2002</B>: Fixed a few bugs in the lexer and parser
- relating to hex and octal escapes in string literals. Also fixed
- the dependencies between the lexer and parser.
-<LI CLASS="li-itemize"><B>December 5, 2002</B>: Fixed visitor bugs that were causing
- some attributes not to be visited and some queued instructions to be
- dropped.
-<LI CLASS="li-itemize"><B>December 3, 2002</B>: Added a transformation to catch stack
- overflows. Fixed the heapify transformation.
-<LI CLASS="li-itemize"><B>October 14, 2002</B>: CIL is now available under the BSD license
-(see the License section or the file LICENSE). <B>Released version 1.0.4</B>
-<LI CLASS="li-itemize"><B>October 9, 2002</B>: More FreeBSD configuration changes, support
-for the GCC-ims <TT>__signed</TT> and <TT>__volatile</TT>. Thanks to Axel
-Simon for pointing out these problems. <B>Released version 1.0.3</B>
-<LI CLASS="li-itemize"><B>October 8, 2002</B>: FreeBSD configuration and porting fixes.
-Thanks to Axel Simon for pointing out these problems.
-<LI CLASS="li-itemize"><B>September 10, 2002</B>: Fixed bug in conversion to CIL. Now we drop
-all “const” qualifiers from the types of locals, even from the fields of
-local structures or elements of arrays.
-<LI CLASS="li-itemize"><B>September 7, 2002</B>: Extended visitor interface to distinguish visitng
- offsets inside lvalues from offsets inside initializer lists.
-<LI CLASS="li-itemize"><B>September 7, 2002</B>: <B>Released version 1.0.1</B>
-<LI CLASS="li-itemize"><B>September 6, 2002</B>: Extended the patcher with the <TT>ateof</TT> flag.
-<LI CLASS="li-itemize"><B>September 4, 2002</B>: Fixed bug in the elaboration to CIL. In some
-cases constant folding of <TT>||</TT> and <TT>&&</TT> was computed wrong.
-<LI CLASS="li-itemize"><B>September 3, 2002</B>: Fixed the merger documentation.
-<LI CLASS="li-itemize"><B>August 29, 2002</B>: <B>Released version 1.0.0.</B>
-<LI CLASS="li-itemize"><B>August 29, 2002</B>: Started numbering versions with a major nubmer,
-minor and revisions. Released version 1.0.0.
-<LI CLASS="li-itemize"><B>August 25, 2002</B>: Fixed the implementation of the unique
-identifiers for global variables and composites. Now those identifiers are
-globally unique.
-<LI CLASS="li-itemize"><B>August 24, 2002</B>: Added to the machine-dependent configuration the
-<TT>sizeofvoid</TT>. It is 1 on gcc and 0 on MSVC. Extended the implementation of
-<TT>Cil.bitsSizeOf</TT> to handle this (it was previously returning an error when
-trying to compute the size of <TT>void</TT>).
-<LI CLASS="li-itemize"><B>August 24, 2002</B>: Changed the representation of structure and
-unions to distinguish between undefined structures and those that are defined
-to be empty (allowed on gcc). The sizeof operator is undefined for the former
-and returns 0 for the latter.
-<LI CLASS="li-itemize"><B>August 22, 2002</B>: Apply a patch from Richard H. Y. to support
-FreeBSD installations. Thanks, Richard!
-<LI CLASS="li-itemize"><B>August 12, 2002</B>: Fixed a bug in the translation of wide-character
-strings. Now this translation matches that of the underlying compiler. Changed
-the implementation of the compiler dependencies.
-<LI CLASS="li-itemize"><B>May 25, 2002</B>: Added interpreted constructors and destructors.
-<LI CLASS="li-itemize"><B>May 17, 2002</B>: Changed the representation of functions to move the
-“inline” information to the varinfo. This way we can print the “inline”
-even in declarations which is what gcc does.
-<LI CLASS="li-itemize"><B>May 15, 2002</B>: Changed the visitor for initializers to make two
-tail-recursive passes (the second is a <TT>List.rev</TT> and only done if one of
-the initializers change). This prevents <TT>Stack_Overflow</TT> for large
-initializers. Also improved the processing of initializers when converting to
-CIL.
-<LI CLASS="li-itemize"><B>May 15, 2002</B>: Changed the front-end to allow the use of <TT>MSVC</TT>
-mode even on machines that do not have MSVC. The machine-dependent parameters
-for GCC will be used in that case.
-<LI CLASS="li-itemize"><B>May 11, 2002</B>: Changed the representation of formals in function
-types. Now the function type is purely functional.
-<LI CLASS="li-itemize"><B>May 4, 2002</B>: Added the function
-<A HREF="api/Cil.html#VALvisitCilFileSameGlobals">Cil.visitCilFileSameGlobals</A> and changed <A HREF="api/Cil.html#VALvisitCilFile">Cil.visitCilFile</A> to be
-tail recursive. This prevents stack overflow on huge files.
-<LI CLASS="li-itemize"><B>February 28, 2002</B>: Changed the significance of the
-<TT>CompoundInit</TT> in <A HREF="api/Cil.html#TYPEinit">Cil.init</A> to allow for missing initializers at the
-end of an array initializer. Added the API function
-<A HREF="api/Cil.html#VALfoldLeftCompoundAll">Cil.foldLeftCompoundAll</A>.
-</UL>
-<HR>
-<A HREF="cil019.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/cil.css b/cil/doc/cil.css
deleted file mode 100644
index 7466cf4d96b3561d9e317936cec4e338adf30d41..0000000000000000000000000000000000000000
--- a/cil/doc/cil.css
+++ /dev/null
@@ -1,10 +0,0 @@
-
-.toc{list-style:none;}
-.title{margin:auto;text-align:center}
-.center{text-align:center;margin-left:auto;margin-right:auto;}
-.flushleft{text-align:left;margin-left:0ex;margin-right:auto;}
-.flushright{text-align:right;margin-left:auto;margin-right:0ex;}
-DIV TABLE{margin-left:inherit;margin-right:inherit;}
-PRE{text-align:left;margin-left:0ex;margin-right:auto;}
-BLOCKQUOTE{margin-left:4ex;margin-right:4ex;text-align:left;}
-.part{margin:auto;text-align:center}
diff --git a/cil/doc/cil.html b/cil/doc/cil.html
deleted file mode 100644
index 4d912d331146d8df855b68ff3dd376756861f388..0000000000000000000000000000000000000000
--- a/cil/doc/cil.html
+++ /dev/null
@@ -1,3532 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-
-<HEAD>
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-<STYLE type="text/css">
-.toc{list-style:none;}
-.title{margin:auto;text-align:center}
-.center{text-align:center;margin-left:auto;margin-right:auto;}
-.flushleft{text-align:left;margin-left:0ex;margin-right:auto;}
-.flushright{text-align:right;margin-left:auto;margin-right:0ex;}
-DIV TABLE{margin-left:inherit;margin-right:inherit;}
-PRE{text-align:left;margin-left:0ex;margin-right:auto;}
-BLOCKQUOTE{margin-left:4ex;margin-right:4ex;text-align:left;}
-.part{margin:auto;text-align:center}
-</STYLE>
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-</HEAD>
-
-<BODY >
-<!--HEVEA command line is: /usr/bin/hevea -exec xxdate.exe ../../cilpp -->
-<!--HTMLHEAD-->
-<!--ENDHTML-->
-<!--PREFIX <ARG ></ARG>-->
-<!--CUT DEF section 1 -->
-
-
-
-<TABLE CLASS="title">
-<TR><TD></TD>
-</TR></TABLE><BR>
-<!--TOC section Introduction-->
-
-<H2 CLASS="section"><A NAME="htoc1">1</A> Introduction</H2><!--SEC END -->
-
-New: CIL now has a Source Forge page:
- <A HREF="javascript:loadTop('http://sourceforge.net/projects/cil')">http://sourceforge.net/projects/cil</A>. <BR>
-<BR>
-CIL (<B>C</B> <B>I</B>ntermediate <B>L</B>anguage) is a high-level representation
-along with a set of tools that permit easy analysis and source-to-source
-transformation of C programs.<BR>
-<BR>
-CIL is both lower-level than abstract-syntax trees, by clarifying ambiguous
-constructs and removing redundant ones, and also higher-level than typical
-intermediate languages designed for compilation, by maintaining types and a
-close relationship with the source program. The main advantage of CIL is that
-it compiles all valid C programs into a few core constructs with a very clean
-semantics. Also CIL has a syntax-directed type system that makes it easy to
-analyze and manipulate C programs. Furthermore, the CIL front-end is able to
-process not only ANSI-C programs but also those using Microsoft C or GNU C
-extensions. If you do not use CIL and want instead to use just a C parser and
-analyze programs expressed as abstract-syntax trees then your analysis will
-have to handle a lot of ugly corners of the language (let alone the fact that
-parsing C itself is not a trivial task). See Section <A HREF="#sec-simplec">16</A> for some
-examples of such extreme programs that CIL simplifies for you.<BR>
-<BR>
-In essence, CIL is a highly-structured, “clean” subset of C. CIL features a
-reduced number of syntactic and conceptual forms. For example, all looping
-constructs are reduced to a single form, all function bodies are given
-explicit <TT>return</TT> statements, syntactic sugar like <TT>"->"</TT> is
-eliminated and function arguments with array types become pointers. (For an
-extensive list of how CIL simplifies C programs, see Section <A HREF="#sec-cabs2cil">4</A>.)
-This reduces the number of cases that must be considered when manipulating a C
-program. CIL also separates type declarations from code and flattens scopes
-within function bodies. This structures the program in a manner more amenable
-to rapid analysis and transformation. CIL computes the types of all program
-expressions, and makes all type promotions and casts explicit. CIL supports
-all GCC and MSVC extensions except for nested functions and complex numbers.
-Finally, CIL organizes C's imperative features into expressions, instructions
-and statements based on the presence and absence of side-effects and
-control-flow. Every statement can be annotated with successor and predecessor
-information. Thus CIL provides an integrated program representation that can
-be used with routines that require an AST (e.g. type-based analyses and
-pretty-printers), as well as with routines that require a CFG (e.g., dataflow
-analyses). CIL also supports even lower-level representations (e.g.,
-three-address code), see Section <A HREF="#sec-Extension">8</A>. <BR>
-<BR>
-CIL comes accompanied by a number of Perl scripts that perform generally
-useful operations on code:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-A <A HREF="#sec-driver">driver</A> which behaves as either the <TT>gcc</TT> or
-Microsoft VC compiler and can invoke the preprocessor followed by the CIL
-application. The advantage of this script is that you can easily use CIL and
-the analyses written for CIL with existing make files.
-<LI CLASS="li-itemize">A <A HREF="#sec-merger">whole-program merger</A> that you can use as a
-replacement for your compiler and it learns all the files you compile when you
-make a project and merges all of the preprocessed source files into a single
-one. This makes it easy to do whole-program analysis.
-<LI CLASS="li-itemize">A <A HREF="#sec-patcher">patcher</A> makes it easy to create modified
-copies of the system include files. The CIL driver can then be told to use
-these patched copies instead of the standard ones.
-</UL>
-CIL has been tested very extensively. It is able to process the SPECINT95
-benchmarks, the Linux kernel, GIMP and other open-source projects. All of
-these programs are compiled to the simple CIL and then passed to <TT>gcc</TT> and
-they still run! We consider the compilation of Linux a major feat especially
-since Linux contains many of the ugly GCC extensions (see Section <A HREF="#sec-ugly-gcc">16.2</A>).
-This adds to about 1,000,000 lines of code that we tested it on. It is also
-able to process the few Microsoft NT device drivers that we have had access
-to. CIL was tested against GCC's c-torture testsuite and (except for the tests
-involving complex numbers and inner functions, which CIL does not currently
-implement) CIL passes most of the tests. Specifically CIL fails 23 tests out
-of the 904 c-torture tests that it should pass. GCC itself fails 19 tests. A
-total of 1400 regression test cases are run automatically on each change to
-the CIL sources.<BR>
-<BR>
-CIL is relatively independent on the underlying machine and compiler. When
-you build it CIL will configure itself according to the underlying compiler.
-However, CIL has only been tested on Intel x86 using the gcc compiler on Linux
-and cygwin and using the MS Visual C compiler. (See below for specific
-versions of these compilers that we have used CIL for.)<BR>
-<BR>
-The largest application we have used CIL for is
-<A HREF="javascript:loadTop('../ccured/index.html')">CCured</A>, a compiler that compiles C code into
-type-safe code by analyzing your pointer usage and inserting runtime checks in
-the places that cannot be guaranteed statically to be type safe. <BR>
-<BR>
-You can also use CIL to “compile” code that uses GCC extensions (e.g. the
-Linux kernel) into standard C code.<BR>
-<BR>
-CIL also comes accompanies by a growing library of extensions (see
-Section <A HREF="#sec-Extension">8</A>). You can use these for your projects or as examples of
-using CIL. <BR>
-<BR>
-<TT>PDF</TT> versions of <A HREF="CIL.pdf">this manual</A> and the
-<A HREF="CIL-API.pdf">CIL API</A> are available. However, we recommend the
-<TT>HTML</TT> versions because the postprocessed code examples are easier to
-view. <BR>
-<BR>
-If you use CIL in your project, we would appreciate letting us know. If you
-want to cite CIL in your research writings, please refer to the paper “CIL:
-Intermediate Language and Tools for Analysis and Transformation of C
-Programs” by George C. Necula, Scott McPeak, S.P. Rahul and Westley Weimer,
-in “Proceedings of Conference on Compilier Construction”, 2002.<BR>
-<BR>
-<!--TOC section Installation-->
-
-<H2 CLASS="section"><A NAME="htoc2">2</A> Installation</H2><!--SEC END -->
-
-You will need OCaml release 3.08 or higher to build CIL. CIL has been tested
-on Linux and on Windows (where it can behave at either Microsoft Visual C or
-gcc).<BR>
-<BR>
-If you want to use CIL on Windows then you must get a complete installation
-of <TT>cygwin</TT> and the source-code OCaml distribution and compile it yourself
-using the cygwin tools (as opposed to getting the Win32 native-code version of
-OCaml). If you have not done this before then take a look
-<A HREF="../ccured/setup.html">here</A>. (Don't need to worry about <TT>cvs</TT> and
-<TT>ssh</TT> unless you will need to use the master CVS repository for CIL.)
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
-Download the CIL <A HREF="distrib">distribution</A> (latest version is
-<A HREF="distrib/cil-1.3.5.tar.gz"><TT>distrib/cil-1.3.5.tar.gz</TT></A>). See the Section <A HREF="#sec-changes">20</A> for recent changes to the CIL distribution.
-<LI CLASS="li-enumerate">Unzip and untar the source distribution. This will create a directory
- called <TT>cil</TT> whose structure is explained below.<BR>
-<TT>tar xvfz cil-1.3.5.tar.gz</TT>
-<LI CLASS="li-enumerate">Enter the <TT>cil</TT> directory and run the <TT>configure</TT> script and then
- GNU make to build the distribution. If you are on Windows, at least the
- <TT>configure</TT> step must be run from within <TT>bash</TT>.<BR>
- <CODE>cd cil</CODE><BR>
- <CODE>./configure</CODE><BR>
- <CODE>make</CODE><BR>
- <CODE>make quicktest</CODE><BR>
-<LI CLASS="li-enumerate">You should now find <TT>cilly.asm.exe</TT> in a
-subdirectory of <TT>obj</TT>. The name of the subdirectory is either <TT>x86_WIN32</TT>
-if you are using <TT>cygwin</TT> on Windows or <TT>x86_LINUX</TT> if you are using
-Linux (although you should be using instead the Perl wrapper <TT>bin/cilly</TT>).
-Note that we do not have an <TT>install</TT> make target and you should use Cil
-from the development directory.
-<LI CLASS="li-enumerate">If you decide to use CIL, <B>please</B>
-<A HREF="mailto:necula@cs.berkeley.edu">send us a note</A>. This will help recharge
-our batteries after more than a year of development. And of course, do send us
-your bug reports as well.</OL>
-The <TT>configure</TT> script tries to find appropriate defaults for your system.
-You can control its actions by passing the following arguments:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>CC=foo</TT> Specifies the path for the <TT>gcc</TT> executable. By default
-whichever version is in the PATH is used. If <TT>CC</TT> specifies the Microsoft
-<TT>cl</TT> compiler, then that compiler will be set as the default one. Otherwise,
-the <TT>gcc</TT> compiler will be the default.
-</UL>
-CIL requires an underlying C compiler and preprocessor. CIL depends on the
-underlying compiler and machine for the sizes and alignment of types.The
-installation procedure for CIL queries the underlying compiler for
-architecture and compiler dependent configuration parameters, such as the size
-of a pointer or the particular alignment rules for structure fields. (This
-means, of course, that you should re-run <TT>./configure</TT> when you move CIL to
-another machine.)<BR>
-<BR>
-We have tested CIL on the following compilers:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-On Windows, <TT>cl</TT> compiler version 12.00.8168 (MSVC 6),
- 13.00.9466 (MSVC .Net), and 13.10.3077 (MSVC .Net 2003). Run <TT>cl</TT>
- with no arguments to get the compiler version.
-<LI CLASS="li-itemize">On Windows, using <TT>cygwin</TT> and <TT>gcc</TT> version 2.95.3, 3.0,
- 3.2, 3.3, and 3.4.
-<LI CLASS="li-itemize">On Linux, using <TT>gcc</TT> version 2.95.3, 3.0, 3.2, 3.3, and 4.0.
-</UL>
-Others have successfully used CIL with Mac OS X (on both PowerPC and
-x86), Solaris, and *BSD. If you make any changes to the build
-system in order to run CIL on your platform, please send us a patch.<BR>
-<BR>
- <!--TOC section Distribution Contents-->
-
-<H2 CLASS="section"><A NAME="htoc3">3</A> Distribution Contents</H2><!--SEC END -->
-
-The file <A HREF="distrib/cil-1.3.5.tar.gz"><TT>distrib/cil-1.3.5.tar.gz</TT></A>
-contains the complete source CIL distribution,
-consisting of the following files:<BR>
-<TABLE CELLSPACING=2 CELLPADDING=0>
-<TR><TD ALIGN=left NOWRAP>Filename</TD>
-<TD ALIGN=left NOWRAP>Description</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>Makefile.in</TT></TD>
-<TD ALIGN=left NOWRAP><TT>configure</TT> source for the
- Makefile that builds CIL</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>configure</TT></TD>
-<TD ALIGN=left NOWRAP>The configure script</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>configure.in</TT></TD>
-<TD ALIGN=left NOWRAP>The <TT>autoconf</TT> source for <TT>configure</TT></TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>config.guess</TT>, <TT>config.sub</TT>, <TT>install-sh</TT></TD>
-<TD ALIGN=left NOWRAP>stuff required by
- <TT>configure</TT></TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP> </TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>doc/</TT></TD>
-<TD ALIGN=left NOWRAP>HTML documentation of the CIL API</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>obj/</TT></TD>
-<TD ALIGN=left NOWRAP>Directory that will contain the compiled
- CIL modules and executables</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>bin/cilly.in</TT></TD>
-<TD ALIGN=left NOWRAP>The <TT>configure</TT> source for a Perl script
- that can be invoked with the
- same arguments as either <TT>gcc</TT> or
- Microsoft Visual C and will convert the
- program to CIL, perform some simple
- transformations, emit it and compile it as
- usual.</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>lib/CompilerStub.pm</TT></TD>
-<TD ALIGN=left NOWRAP>A Perl class that can be used to write code
- that impersonates a compiler. <TT>cilly</TT>
- uses it.</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>lib/Merger.pm</TT></TD>
-<TD ALIGN=left NOWRAP>A subclass of <TT>CompilerStub.pm</TT> that can
- be used to merge source files into a single
- source file.<TT>cilly</TT>
- uses it.</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>bin/patcher.in</TT></TD>
-<TD ALIGN=left NOWRAP>A Perl script that applies specified patches
- to standard include files.</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP> </TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/check.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>Checks the well-formedness of a CIL file</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/cil.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>Definition of CIL abstract syntax and
- utilities for manipulating it</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/clist.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>Utilities for efficiently managing lists
- that need to be concatenated often</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/errormsg.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>Utilities for error reporting</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/ext/heapify.ml</TT></TD>
-<TD ALIGN=left NOWRAP>A CIL transformation that moves array local
- variables from the stack to the heap</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/ext/logcalls.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>A CIL transformation that logs every
- function call</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/ext/sfi.ml</TT></TD>
-<TD ALIGN=left NOWRAP>A CIL transformation that can log every
- memory read and write</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/frontc/clexer.mll</TT></TD>
-<TD ALIGN=left NOWRAP>The lexer</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/frontc/cparser.mly</TT></TD>
-<TD ALIGN=left NOWRAP>The parser</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/frontc/cabs.ml</TT></TD>
-<TD ALIGN=left NOWRAP>The abstract syntax</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/frontc/cprint.ml</TT></TD>
-<TD ALIGN=left NOWRAP>The pretty printer for CABS</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/frontc/cabs2cil.ml</TT></TD>
-<TD ALIGN=left NOWRAP>The elaborator to CIL</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/main.ml</TT></TD>
-<TD ALIGN=left NOWRAP>The <TT>cilly</TT> application</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/pretty.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>Utilities for pretty printing</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/rmtmps.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>A CIL tranformation that removes unused
- types, variables and inlined functions</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/stats.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>Utilities for maintaining timing statistics</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/testcil.ml</TT></TD>
-<TD ALIGN=left NOWRAP>A random test of CIL (against the resident
- C compiler)</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/trace.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>Utilities useful for printing debugging
- information</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP> </TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>ocamlutil/</TT></TD>
-<TD ALIGN=left NOWRAP>Miscellaneous libraries that are not
- specific to CIL.</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>ocamlutil/Makefile.ocaml</TT></TD>
-<TD ALIGN=left NOWRAP>A file that is included by <TT>Makefile</TT></TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>ocamlutil/Makefile.ocaml.build</TT></TD>
-<TD ALIGN=left NOWRAP>A file that is included by <TT>Makefile</TT></TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>ocamlutil/perfcount.c</TT></TD>
-<TD ALIGN=left NOWRAP>C code that links with src/stats.ml
- and reads Intel performance
- counters.</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP> </TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>obj/@ARCHOS@/feature_config.ml</TT></TD>
-<TD ALIGN=left NOWRAP>File generated by the Makefile
- describing which extra “features”
- to compile. See Section <A HREF="#sec-cil">5</A></TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>obj/@ARCHOS@/machdep.ml</TT></TD>
-<TD ALIGN=left NOWRAP>File generated by the Makefile containing
- information about your architecture,
- such as the size of a pointer</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/machdep.c</TT></TD>
-<TD ALIGN=left NOWRAP>C program that generates
- <TT>machdep.ml</TT> files</TD>
-</TR></TABLE><BR>
-<!--TOC section Compiling C to CIL-->
-
-<H2 CLASS="section"><A NAME="htoc4">4</A> Compiling C to CIL</H2><!--SEC END -->
-<A NAME="sec-cabs2cil"></A>
-In this section we try to describe a few of the many transformations that are
-applied to a C program to convert it to CIL. The module that implements this
-conversion is about 5000 lines of OCaml code. In contrast a simple program
-transformation that instruments all functions to keep a shadow stack of the
-true return address (thus preventing stack smashing) is only 70 lines of code.
-This example shows that the analysis is so much simpler because it has to
-handle only a few simple C constructs and also because it can leverage on CIL
-infrastructure such as visitors and pretty-printers.<BR>
-<BR>
-In no particular order these are a few of the most significant ways in which
-C programs are compiled into CIL:
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
-CIL will eliminate all declarations for unused entities. This means that
-just because your hello world program includes <TT>stdio.h</TT> it does not mean
-that your analysis has to handle all the ugly stuff from <TT>stdio.h</TT>.<BR>
-<BR>
-<LI CLASS="li-enumerate">Type specifiers are interpreted and normalized:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-int long signed x;
-signed long extern x;
-long static int long y;
-
-// Some code that uses these declaration, so that CIL does not remove them
-int main() { return x + y; }
-</FONT></PRE>
-See the <A HREF="examples/ex1.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Anonymous structure and union declarations are given a name.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- struct { int x; } s;
-</FONT></PRE>
-See the <A HREF="examples/ex2.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Nested structure tag definitions are pulled apart. This means that all
-structure tag definitions can be found by a simple scan of the globals.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-struct foo {
- struct bar {
- union baz {
- int x1;
- double x2;
- } u1;
- int y;
- } s1;
- int z;
-} f;
-</FONT></PRE>
-See the <A HREF="examples/ex3.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">All structure, union, enumeration definitions and the type definitions
-from inners scopes are moved to global scope (with appropriate renaming). This
-facilitates moving around of the references to these entities.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-int main() {
- struct foo {
- int x; } foo;
- {
- struct foo {
- double d;
- };
- return foo.x;
- }
-}
-</FONT></PRE>
-See the <A HREF="examples/ex4.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Prototypes are added for those functions that are called before being
-defined. Furthermore, if a prototype exists but does not specify the type of
-parameters that is fixed. But CIL will not be able to add prototypes for those
-functions that are neither declared nor defined (but are used!).
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int f(); // Prototype without arguments
- int f(double x) {
- return g(x);
- }
- int g(double x) {
- return x;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex5.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Array lengths are computed based on the initializers or by constant
-folding.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int a1[] = {1,2,3};
- int a2[sizeof(int) >= 4 ? 8 : 16];
-</FONT></PRE>
-See the <A HREF="examples/ex6.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Enumeration tags are computed using constant folding:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-int main() {
- enum {
- FIVE = 5,
- SIX, SEVEN,
- FOUR = FIVE - 1,
- EIGHT = sizeof(double)
- } x = FIVE;
- return x;
-}
-
-</FONT></PRE>
-See the <A HREF="examples/ex7.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Initializers are normalized to include specific initialization for the
-missing elements:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int a1[5] = {1,2,3};
- struct foo { int x, y; } s1 = { 4 };
-</FONT></PRE>
-See the <A HREF="examples/ex8.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Initializer designators are interpreted and eliminated. Subobjects are
-properly marked with braces. CIL implements
-the whole ISO C99 specification for initializer (neither GCC nor MSVC do) and
-a few GCC extensions.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- struct foo {
- int x, y;
- int a[5];
- struct inner {
- int z;
- } inner;
- } s = { 0, .inner.z = 3, .a[1 ... 2] = 5, 4, y : 8 };
-</FONT></PRE>
-See the <A HREF="examples/ex9.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">String initializers for arrays of characters are processed
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-char foo[] = "foo plus bar";
-</FONT></PRE>
-See the <A HREF="examples/ex10.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">String constants are concatenated
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-char *foo = "foo " " plus " " bar ";
-</FONT></PRE>
-See the <A HREF="examples/ex11.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Initializers for local variables are turned into assignments. This is in
-order to separate completely the declarative part of a function body from the
-statements. This has the unfortunate effect that we have to drop the <TT>const</TT>
-qualifier from local variables !
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x = 5;
- struct foo { int f1, f2; } a [] = {1, 2, 3, 4, 5 };
-</FONT></PRE>
-See the <A HREF="examples/ex12.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Local variables in inner scopes are pulled to function scope (with
-appropriate renaming). Local scopes thus disappear. This makes it easy to find
-and operate on all local variables in a function.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x = 5;
- int main() {
- int x = 6;
- {
- int x = 7;
- return x;
- }
- return x;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex13.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Global declarations in local scopes are moved to global scope:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x = 5;
- int main() {
- int x = 6;
- {
- static int x = 7;
- return x;
- }
- return x;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex14.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Return statements are added for functions that are missing them. If the
-return type is not a base type then a <TT>return</TT> without a value is added.
-The guaranteed presence of return statements makes it easy to implement a
-transformation that inserts some code to be executed immediately before
-returning from a function.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int foo() {
- int x = 5;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex15.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">One of the most significant transformations is that expressions that
-contain side-effects are separated into statements.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x, f(int);
- return (x ++ + f(x));
-</FONT></PRE>
-See the <A HREF="examples/ex16.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-Internally, the <TT>x ++</TT> statement is turned into an assignment which the
-pretty-printer prints like the original. CIL has only three forms of basic
-statements: assignments, function calls and inline assembly.<BR>
-<BR>
-<LI CLASS="li-enumerate">Shortcut evaluation of boolean expressions and the <TT>?:</TT> operator are
-compiled into explicit conditionals:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x;
- int y = x ? 2 : 4;
- int z = x || y;
- // Here we duplicate the return statement
- if(x && y) { return 0; } else { return 1; }
- // To avoid excessive duplication, CIL uses goto's for
- // statement that have more than 5 instructions
- if(x && y || z) { x ++; y ++; z ++; x ++; y ++; return z; }
-</FONT></PRE>
-See the <A HREF="examples/ex17.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">GCC's conditional expression with missing operands are also compiled
-into conditionals:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int f();;
- return f() ? : 4;
-</FONT></PRE>
-See the <A HREF="examples/ex18.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">All forms of loops (<TT>while</TT>, <TT>for</TT> and <TT>do</TT>) are compiled
-internally as a single <TT>while(1)</TT> looping construct with explicit <TT>break</TT>
-statement for termination. For simple <TT>while</TT> loops the pretty printer is
-able to print back the original:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x, y;
- for(int i = 0; i<5; i++) {
- if(i == 5) continue;
- if(i == 4) break;
- i += 2;
- }
- while(x < 5) {
- if(x == 3) continue;
- x ++;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex19.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">GCC's block expressions are compiled away. (That's right there is an
-infinite loop in this code.)
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x = 5, y = x;
- int z = ({ x++; L: y -= x; y;});
- return ({ goto L; 0; });
-</FONT></PRE>
-See the <A HREF="examples/ex20.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">CIL contains support for both MSVC and GCC inline assembly (both in one
-internal construct)<BR>
-<BR>
-<LI CLASS="li-enumerate">CIL compiles away the GCC extension that allows many kinds of constructs
-to be used as lvalues:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x, y, z;
- return &(x ? y : z) - & (x ++, x);
-</FONT></PRE>
-See the <A HREF="examples/ex21.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">All types are computed and explicit casts are inserted for all
-promotions and conversions that a compiler must insert:<BR>
-<BR>
-<LI CLASS="li-enumerate">CIL will turn old-style function definition (without prototype) into
-new-style definitions. This will make the compiler less forgiving when
-checking function calls, and will catch for example cases when a function is
-called with too few arguments. This happens in old-style code for the purpose
-of implementing variable argument functions.<BR>
-<BR>
-<LI CLASS="li-enumerate">Since CIL sees the source after preprocessing the code after CIL does
-not contain the comments and the preprocessing directives.<BR>
-<BR>
-<LI CLASS="li-enumerate">CIL will remove from the source file those type declarations, local
-variables and inline functions that are not used in the file. This means that
-your analysis does not have to see all the ugly stuff that comes from the
-header files:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-#include <stdio.h>
-
-typedef int unused_type;
-
-static char unused_static (void) { return 0; }
-
-int main() {
- int unused_local;
- printf("Hello world\n"); // Only printf will be kept from stdio.h
-}
-</FONT></PRE>
-See the <A HREF="examples/ex22.txt">CIL output</A> for this
-code fragment</OL>
-<!--TOC section How to Use CIL-->
-
-<H2 CLASS="section"><A NAME="htoc5">5</A> How to Use CIL</H2><!--SEC END -->
-<A NAME="sec-cil"></A><!--NAME cilly.html-->
-<BR>
-<BR>
-There are two predominant ways to use CIL to write a program analysis or
-transformation. The first is to phrase your analysis as a module that is
-called by our existing driver. The second is to use CIL as a stand-alone
-library. We highly recommend that you use <TT>cilly</TT>, our driver. <BR>
-<BR>
-<!--TOC subsection Using <TT>cilly</TT>, the CIL driver-->
-
-<H3 CLASS="subsection"><A NAME="htoc6">5.1</A> Using <TT>cilly</TT>, the CIL driver</H3><!--SEC END -->
-
-The most common way to use CIL is to write an Ocaml module containing your
-analysis and transformation, which you then link into our boilerplate
-driver application called <TT>cilly</TT>. <TT>cilly</TT> is a Perl script that
-processes and mimics <TT>GCC</TT> and <TT>MSVC</TT> command-line arguments and then
-calls <TT>cilly.byte.exe</TT> or <TT>cilly.asm.exe</TT> (CIL's Ocaml executable). <BR>
-<BR>
-An example of such module is <TT>logwrites.ml</TT>, a transformation that is
-distributed with CIL and whose purpose is to instrument code to print the
-addresses of memory locations being written. (We plan to release a
-C-language interface to CIL so that you can write your analyses in C
-instead of Ocaml.) See Section <A HREF="#sec-Extension">8</A> for a survey of other example
-modules. <BR>
-<BR>
-Assuming that you have written <TT>/home/necula/logwrites.ml</TT>,
-here is how you use it:
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">Modify <TT>logwrites.ml</TT> so that it includes a CIL “feature
- descriptor” like this:
-<PRE CLASS="verbatim">
-let feature : featureDescr =
- { fd_name = "logwrites";
- fd_enabled = ref false;
- fd_description = "generation of code to log memory writes";
- fd_extraopt = [];
- fd_doit =
- (function (f: file) ->
- let lwVisitor = new logWriteVisitor in
- visitCilFileSameGlobals lwVisitor f)
- }
-</PRE>The <TT>fd_name</TT> field names the feature and its associated
- command-line arguments. The <TT>fd_enabled</TT> field is a <TT>bool ref</TT>.
- “<TT>fd_doit</TT>” will be invoked if <TT>!fd_enabled</TT> is true after
- argument parsing, so initialize the ref cell to true if you want
- this feature to be enabled by default.<BR>
-<BR>
-When the user passes the <TT>--dologwrites</TT>
- command-line option to <TT>cilly</TT>, the variable associated with the
- <TT>fd_enabled</TT> flag is set and the <TT>fd_doit</TT> function is called
- on the <TT>Cil.file</TT> that represents the merger (see Section <A HREF="#sec-merger">13</A>) of
- all C files listed as arguments. <BR>
-<BR>
-<LI CLASS="li-enumerate">Invoke <TT>configure</TT> with the arguments
-<PRE CLASS="verbatim">
-./configure EXTRASRCDIRS=/home/necula EXTRAFEATURES=logwrites
-</PRE>
- This step works if each feature is packaged into its own ML file, and the
-name of the entry point in the file is <TT>feature</TT>.<BR>
-<BR>
-An alternative way to specify the new features is to change the build files
-yourself, as explained below. You'll need to use this method if a single
-feature is split across multiple files.
-<OL CLASS="enumerate" type=a><LI CLASS="li-enumerate">
- Put <TT>logwrites.ml</TT> in the <TT>src</TT> or <TT>src/ext</TT> directory. This
- will make sure that <TT>make</TT> can find it. If you want to put it in some
- other directory, modify <TT>Makefile.in</TT> and add to <TT>SOURCEDIRS</TT> your
- directory. Alternately, you can create a symlink from <TT>src</TT> or
- <TT>src/ext</TT> to your file.<BR>
-<BR>
-<LI CLASS="li-enumerate">Modify the <TT>Makefile.in</TT> and add your module to the
- <TT>CILLY_MODULES</TT> or
- <TT>CILLY_LIBRARY_MODULES</TT> variables. The order of the modules matters. Add
- your modules somewhere after <TT>cil</TT> and before <TT>main</TT>.<BR>
-<BR>
-<LI CLASS="li-enumerate">If you have any helper files for your module, add those to
- the makefile in the same way. e.g.:
-<PRE CLASS="verbatim">
-CILLY_MODULES = $(CILLY_LIBRARY_MODULES) \
- myutilities1 myutilities2 logwrites \
- main
-</PRE>
- Again, order is important: <TT>myutilities2.ml</TT> will be able to refer
- to Myutilities1 but not Logwrites. If you have any ocamllex or ocamlyacc
- files, add them to both <TT>CILLY_MODULES</TT> and either <TT>MLLS</TT> or
- <TT>MLYS</TT>.<BR>
-<BR>
-<LI CLASS="li-enumerate">Modify <TT>main.ml</TT> so that your new feature descriptor appears in
- the global list of CIL features.
-<PRE CLASS="verbatim">
-let features : C.featureDescr list =
- [ Logcalls.feature;
- Oneret.feature;
- Heapify.feature1;
- Heapify.feature2;
- makeCFGFeature;
- Partial.feature;
- Simplemem.feature;
- Logwrites.feature; (* add this line to include the logwrites feature! *)
- ]
- @ Feature_config.features
-</PRE>
- Features are processed in the order they appear on this list. Put
- your feature last on the list if you plan to run any of CIL's
- built-in features (such as makeCFGfeature) before your own.</OL><BR>
-Standard code in <TT>cilly</TT> takes care of adding command-line arguments,
- printing the description, and calling your function automatically.
- Note: do not worry about introducing new bugs into CIL by adding a single
- line to the feature list. <BR>
-<BR>
-<LI CLASS="li-enumerate">Now you can invoke the <TT>cilly</TT> application on a preprocessed file, or
- instead use the <TT>cilly</TT> driver which provides a convenient compiler-like
- interface to <TT>cilly</TT>. See Section <A HREF="#sec-driver">7</A> for details using <TT>cilly</TT>.
- Remember to enable your analysis by passing the right argument (e.g.,
- <TT>--dologwrites</TT>). </OL>
-<!--TOC subsection Using CIL as a library-->
-
-<H3 CLASS="subsection"><A NAME="htoc7">5.2</A> Using CIL as a library</H3><!--SEC END -->
-
-CIL can also be built as a library that is called from your stand-alone
-application. Add <TT>cil/src</TT>, <TT>cil/src/frontc</TT>, <TT>cil/obj/x86_LINUX</TT>
-(or <TT>cil/obj/x86_WIN32</TT>) to your Ocaml project <TT>-I</TT> include paths.
-Building CIL will also build the library <TT>cil/obj/*/cil.cma</TT> (or
-<TT>cil/obj/*/cil.cmxa</TT>). You can then link your application against that
-library. <BR>
-<BR>
-You can call the <TT>Frontc.parse: string -> unit -> Cil.file</TT> function with
-the name of a file containing the output of the C preprocessor.
-The <TT>Mergecil.merge: Cil.file list -> string -> Cil.file</TT> function merges
-multiple files. You can then invoke your analysis function on the resulting
-<TT>Cil.file</TT> data structure. You might want to call
-<TT>Rmtmps.removeUnusedTemps</TT> first to clean up the prototypes and variables
-that are not used. Then you can call the function <TT>Cil.dumpFile:
-cilPrinter -> out_channel -> Cil.file -> unit</TT> to print the file to a
-given output channel. A good <TT>cilPrinter</TT> to use is
-<TT>defaultCilPrinter</TT>. <BR>
-<BR>
-Check out <TT>src/main.ml</TT> and <TT>bin/cilly</TT> for other good ideas
-about high-level file processing. Again, we highly recommend that you just
-our <TT>cilly</TT> driver so that you can avoid spending time re-inventing the
-wheel to provide drop-in support for standard <TT>makefile</TT>s. <BR>
-<BR>
-Here is a concrete example of compiling and linking your project against
-CIL. Imagine that your program analysis or transformation is contained in
-the single file <TT>main.ml</TT>.
-<PRE CLASS="verbatim">
-$ ocamlopt -c -I $(CIL)/obj/x86_LINUX/ main.ml
-$ ocamlopt -ccopt -L$(CIL)/obj/x86_LINUX/ -o main unix.cmxa str.cmxa \
- $(CIL)/obj/x86_LINUX/cil.cmxa main.cmx
-</PRE>
-The first line compiles your analysis, the second line links it against CIL
-(as a library) and the Ocaml Unix library. For more information about
-compiling and linking Ocaml programs, see the Ocaml home page
-at <A HREF="javascript:loadTop('http://caml.inria.fr/ocaml/')">http://caml.inria.fr/ocaml/</A>. <BR>
-<BR>
-In the next section we give an overview of the API that you can use
-to write your analysis and transformation. <BR>
-<BR>
-<!--TOC section CIL API Documentation-->
-
-<H2 CLASS="section"><A NAME="htoc8">6</A> CIL API Documentation</H2><!--SEC END -->
-<A NAME="sec-api"></A>
-The CIL API is documented in the file <TT>src/cil.mli</TT>. We also have an
-<A HREF="api/index.html">online documentation</A> extracted from <TT>cil.mli</TT>. We
-index below the main types that are used to represent C programs in CIL:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<A HREF="api/index_types.html">An index of all types</A>
-<LI CLASS="li-itemize"><A HREF="api/index_values.html">An index of all values</A>
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEfile">Cil.file</A> is the representation of a file.
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEglobal">Cil.global</A> is the representation of a global declaration or
-definitions. Values for <A HREF="api/Cil.html#VALemptyFunction">operating on globals</A>.
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEtyp">Cil.typ</A> is the representation of a type.
-Values for <A HREF="api/Cil.html#VALvoidType">operating on types</A>.
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEcompinfo">Cil.compinfo</A> is the representation of a structure or a union
-type
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEfieldinfo">Cil.fieldinfo</A> is the representation of a field in a structure
-or a union
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEenuminfo">Cil.enuminfo</A> is the representation of an enumeration type.
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEvarinfo">Cil.varinfo</A> is the representation of a variable
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEfundec">Cil.fundec</A> is the representation of a function
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPElval">Cil.lval</A> is the representation of an lvalue.
-Values for <A HREF="api/Cil.html#VALmakeVarInfo">operating on lvalues</A>.
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEexp">Cil.exp</A> is the representation of an expression without
-side-effects.
-Values for <A HREF="api/Cil.html#VALzero">operating on expressions</A>.
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEinstr">Cil.instr</A> is the representation of an instruction (with
-side-effects but without control-flow)
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEstmt">Cil.stmt</A> is the representation of a control-flow statements.
-Values for <A HREF="api/Cil.html#VALmkStmt">operating on statements</A>.
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEattribute">Cil.attribute</A> is the representation of attributes.
-Values for <A HREF="api/Cil.html#TYPEattributeClass">operating on attributes</A>.
-</UL>
-<!--TOC subsection Using the visitor-->
-
-<H3 CLASS="subsection"><A NAME="htoc9">6.1</A> Using the visitor</H3><!--SEC END -->
-<A NAME="sec-visitor"></A>
-One of the most useful tools exported by the CIL API is an implementation of
-the visitor pattern for CIL programs. The visiting engine scans depth-first
-the structure of a CIL program and at each node is queries a user-provided
-visitor structure whether it should do one of the following operations:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-Ignore this node and all its descendants
-<LI CLASS="li-itemize">Descend into all of the children and when done rebuild the node if any
-of the children have changed.
-<LI CLASS="li-itemize">Replace the subtree rooted at the node with another tree.
-<LI CLASS="li-itemize">Replace the subtree with another tree, then descend into the children
-and rebuild the node if necessary and then invoke a user-specified function.
-<LI CLASS="li-itemize">In addition to all of the above actions then visitor can specify that
-some instructions should be queued to be inserted before the current
-instruction or statement being visited.
-</UL>
-By writing visitors you can customize the program traversal and
-transformation. One major limitation of the visiting engine is that it does
-not propagate information from one node to another. Each visitor must use its
-own private data to achieve this effect if necessary. <BR>
-<BR>
-Each visitor is an object that is an instance of a class of type <A HREF="api/Cil.cilVisitor.html#.">Cil.cilVisitor..</A>
-The most convenient way to obtain such classes is to specialize the
-<A HREF="api/Cil.nopCilVisitor.html#c">Cil.nopCilVisitor.c</A>lass (which just traverses the tree doing
-nothing). Any given specialization typically overrides only a few of the
-methods. Take a look for example at the visitor defined in the module
-<TT>logwrites.ml</TT>. Another, more elaborate example of a visitor is the
-[copyFunctionVisitor] defined in <TT>cil.ml</TT>.<BR>
-<BR>
-Once you have defined a visitor you can invoke it with one of the functions:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<A HREF="api/Cil.html#VALvisitCilFile">Cil.visitCilFile</A> or <A HREF="api/Cil.html#VALvisitCilFileSameGlobals">Cil.visitCilFileSameGlobals</A> - visit a file
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilGlobal">Cil.visitCilGlobal</A> - visit a global
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilFunction">Cil.visitCilFunction</A> - visit a function definition
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilExp">Cil.visitCilExp</A> - visit an expression
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilLval">Cil.visitCilLval</A> - visit an lvalue
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilInstr">Cil.visitCilInstr</A> - visit an instruction
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilStmt">Cil.visitCilStmt</A> - visit a statement
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilType">Cil.visitCilType</A> - visit a type. Note that this does not visit
-the files of a composite type. use visitGlobal to visit the [GCompTag] that
-defines the fields.
-</UL>
-Some transformations may want to use visitors to insert additional
-instructions before statements and instructions. To do so, pass a list of
-instructions to the <A HREF="api/Cil.html#VALqueueInstr">Cil.queueInstr</A> method of the specialized
-object. The instructions will automatically be inserted before that
-instruction in the transformed code. The <A HREF="api/Cil.html#VALunqueueInstr">Cil.unqueueInstr</A> method
-should not normally be called by the user. <BR>
-<BR>
-<!--TOC subsection Interpreted Constructors and Deconstructors-->
-
-<H3 CLASS="subsection"><A NAME="htoc10">6.2</A> Interpreted Constructors and Deconstructors</H3><!--SEC END -->
-
-Interpreted constructors and deconstructors are a facility for constructing
-and deconstructing CIL constructs using a pattern with holes that can be
-filled with a variety of kinds of elements. The pattern is a string that uses
-the C syntax to represent C language elements. For example, the following
-code:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-Formatcil.cType "void * const (*)(int x)"
-</FONT></PRE>
-is an alternative way to construct the internal representation of the type of pointer to function
-with an integer argument and a void * const as result:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-TPtr(TFun(TVoid [Attr("const", [])],
- [ ("x", TInt(IInt, []), []) ], false, []), [])
-</FONT></PRE>
-The advantage of the interpreted constructors is that you can use familiar C
-syntax to construct CIL abstract-syntax trees. <BR>
-<BR>
-You can construct this way types, lvalues, expressions, instructions and
-statements. The pattern string can also contain a number of placeholders that
-are replaced during construction with CIL items passed as additional argument
-to the construction function. For example, the <TT>%e:id</TT> placeholder means
-that the argument labeled “id” (expected to be of form <TT>Fe exp</TT>) will
-supply the expression to replace the placeholder. For example, the following
-code constructs an increment instruction at location <TT>loc</TT>:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-Formatcil.cInstr "%v:x = %v:x + %e:something"
- loc
- [ ("something", Fe some_exp);
- ("x", Fv some_varinfo) ]
-</FONT></PRE>
-An alternative way to construct the same CIL instruction is:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-Set((Var some_varinfo, NoOffset),
- BinOp(PlusA, Lval (Var some_varinfo, NoOffset),
- some_exp, intType),
- loc)
-</FONT></PRE>
-See <A HREF="api/Cil.html#TYPEformatArg">Cil.formatArg</A> for a definition of the placeholders that are
-understood.<BR>
-<BR>
-A dual feature is the interpreted deconstructors. This can be used to test
-whether a CIL construct has a certain form:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-Formatcil.dType "void * const (*)(int x)" t
-</FONT></PRE>
-will test whether the actual argument <TT>t</TT> is indeed a function pointer of
-the required type. If it is then the result is <TT>Some []</TT> otherwise it is
-<TT>None</TT>. Furthermore, for the purpose of the interpreted deconstructors
-placeholders in patterns match anything of the right type. For example,
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-Formatcil.dType "void * (*)(%F:t)" t
-</FONT></PRE>
-will match any function pointer type, independent of the type and number of
-the formals. If the match succeeds the result is <TT>Some [ FF forms ]</TT> where
-<TT>forms</TT> is a list of names and types of the formals. Note that each member
-in the resulting list corresponds positionally to a placeholder in the
-pattern.<BR>
-<BR>
-The interpreted constructors and deconstructors do not support the complete C
-syntax, but only a substantial fragment chosen to simplify the parsing. The
-following is the syntax that is supported:
-<PRE CLASS="verbatim">
-Expressions:
- E ::= %e:ID | %d:ID | %g:ID | n | L | ( E ) | Unop E | E Binop E
- | sizeof E | sizeof ( T ) | alignof E | alignof ( T )
- | & L | ( T ) E
-
-Unary operators:
- Unop ::= + | - | ~ | %u:ID
-
-Binary operators:
- Binop ::= + | - | * | / | << | >> | & | ``|'' | ^
- | == | != | < | > | <= | >= | %b:ID
-
-Lvalues:
- L ::= %l:ID | %v:ID Offset | * E | (* E) Offset | E -> ident Offset
-
-Offsets:
- Offset ::= empty | %o:ID | . ident Offset | [ E ] Offset
-
-Types:
- T ::= Type_spec Attrs Decl
-
-Type specifiers:
- Type_spec ::= void | char | unsigned char | short | unsigned short
- | int | unsigned int | long | unsigned long | %k:ID | float
- | double | struct %c:ID | union %c:ID
-
-
-Declarators:
- Decl ::= * Attrs Decl | Direct_decl
-
-
-Direct declarators:
- Direct_decl ::= empty | ident | ( Attrs Decl )
- | Direct_decl [ Exp_opt ]
- | ( Attrs Decl )( Parameters )
-
-Optional expressions
- Exp_opt ::= empty | E | %eo:ID
-
-Formal parameters
- Parameters ::= empty | ... | %va:ID | %f:ID | T | T , Parameters
-
-List of attributes
- Attrs ::= empty | %A:ID | Attrib Attrs
-
-Attributes
- Attrib ::= const | restrict | volatile | __attribute__ ( ( GAttr ) )
-
-GCC Attributes
- GAttr ::= ident | ident ( AttrArg_List )
-
-Lists of GCC Attribute arguments:
- AttrArg_List ::= AttrArg | %P:ID | AttrArg , AttrArg_List
-
-GCC Attribute arguments
- AttrArg ::= %p:ID | ident | ident ( AttrArg_List )
-
-Instructions
- Instr ::= %i:ID ; | L = E ; | L Binop= E | Callres L ( Args )
-
-Actual arguments
- Args ::= empty | %E:ID | E | E , Args
-
-Call destination
- Callres ::= empty | L = | %lo:ID
-
-Statements
- Stmt ::= %s:ID | if ( E ) then Stmt ; | if ( E ) then Stmt else Stmt ;
- | return Exp_opt | break ; | continue ; | { Stmt_list }
- | while (E ) Stmt | Instr_list
-
-Lists of statements
- Stmt_list ::= empty | %S:ID | Stmt Stmt_list
- | Type_spec Attrs Decl ; Stmt_list
- | Type_spec Attrs Decl = E ; Stmt_list
- | Type_spec Attrs Decl = L (Args) ; Stmt_list
-
-List of instructions
- Instr_list ::= Instr | %I:ID | Instr Instr_list
-</PRE>
-Notes regarding the syntax:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-In the grammar description above non-terminals are written with
-uppercase initial<BR>
-<BR>
-<LI CLASS="li-itemize">All of the patterns consist of the <TT>%</TT> character followed by one or
-two letters, followed by “:” and an indentifier. For each such
-pattern there is a corresponding constructor of the <A HREF="api/Cil.html#TYPEformatArg">Cil.formatArg</A>
-type, whose name is the letter 'F' followed by the same one or two letters as
-in the pattern. That constructor is used by the user code to pass a
-<A HREF="api/Cil.html#TYPEformatArg">Cil.formatArg</A> actual argument to the interpreted constructor and by
-the interpreted deconstructor to return what was matched for a pattern.<BR>
-<BR>
-<LI CLASS="li-itemize">If the pattern name is uppercase, it designates a list of the elements
-designated by the corresponding lowercase pattern. E.g. %E designated lists
-of expressions (as in the actual arguments of a call).<BR>
-<BR>
-<LI CLASS="li-itemize">The two-letter patterns whose second letter is “o” designate an
-optional element. E.g. %eo designates an optional expression (as in the
-length of an array). <BR>
-<BR>
-<LI CLASS="li-itemize">Unlike in calls to <TT>printf</TT>, the pattern %g is used for strings. <BR>
-<BR>
-<LI CLASS="li-itemize">The usual precedence and associativity rules as in C apply <BR>
-<BR>
-<LI CLASS="li-itemize">The pattern string can contain newlines and comments, using both the
-<TT>/* ... */</TT> style as well as the <TT>//</TT> one. <BR>
-<BR>
-<LI CLASS="li-itemize">When matching a “cast” pattern of the form <TT>( T ) E</TT>, the
-deconstructor will match even expressions that do not have the actual cast but
-in that case the type is matched against the type of the expression. E.g. the
-patters <TT>"(int)%e"</TT> will match any expression of type <TT>int</TT> whether it
-has an explicit cast or not. <BR>
-<BR>
-<LI CLASS="li-itemize">The %k pattern is used to construct and deconstruct an integer type of
-any kind. <BR>
-<BR>
-<LI CLASS="li-itemize">Notice that the syntax of types and declaration are the same (in order
-to simplify the parser). This means that technically you can write a whole
-declaration instead of a type in the cast. In this case the name that you
-declare is ignored.<BR>
-<BR>
-<LI CLASS="li-itemize">In lists of formal parameters and lists of attributes, an empty list in
-the pattern matches any formal parameters or attributes. <BR>
-<BR>
-<LI CLASS="li-itemize">When matching types, uses of named types are unrolled to expose a real
-type before matching. <BR>
-<BR>
-<LI CLASS="li-itemize">The order of the attributes is ignored during matching. The the pattern
-for a list of attributes contains %A then the resulting <TT>formatArg</TT> will be
-bound to <B>all</B> attributes in the list. For example, the pattern <TT>"const
-%A"</TT> matches any list of attributes that contains <TT>const</TT> and binds the
-corresponding placeholder to the entire list of attributes, including
-<TT>const</TT>. <BR>
-<BR>
-<LI CLASS="li-itemize">All instruction-patterns must be terminated by semicolon<BR>
-<BR>
-<LI CLASS="li-itemize">The autoincrement and autodecrement instructions are not supported. Also
-not supported are complex expressions, the <TT>&&</TT> and <TT>||</TT> shortcut
-operators, and a number of other more complex instructions or statements. In
-general, the patterns support only constructs that can be represented directly
-in CIL.<BR>
-<BR>
-<LI CLASS="li-itemize">The pattern argument identifiers are not used during deconstruction.
-Instead, the result contains a sequence of values in the same order as the
-appearance of pattern arguments in the pattern.<BR>
-<BR>
-<LI CLASS="li-itemize">You can mix statements with declarations. For each declaration a new
- temporary will be constructed (using a function you provive). You can then
- refer to that temporary by name in the rest of the pattern.<BR>
-<BR>
-<LI CLASS="li-itemize">The <TT>%v:</TT> pattern specifier is optional.
-</UL>
-The following function are defined in the <TT>Formatcil</TT> module for
-constructing and deconstructing:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<A HREF="api/Formatcil.html#VALcExp">Formatcil.cExp</A> constructs <A HREF="api/Cil.html#TYPEexp">Cil.exp</A>.
-<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALcType">Formatcil.cType</A> constructs <A HREF="api/Cil.html#TYPEtyp">Cil.typ</A>.
-<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALcLval">Formatcil.cLval</A> constructs <A HREF="api/Cil.html#TYPElval">Cil.lval</A>.
-<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALcInstr">Formatcil.cInstr</A> constructs <A HREF="api/Cil.html#TYPEinstr">Cil.instr</A>.
-<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALcStmt">Formatcil.cStmt</A> and <A HREF="api/Formatcil.html#VALcStmts">Formatcil.cStmts</A> construct <A HREF="api/Cil.html#TYPEstmt">Cil.stmt</A>.
-<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALdExp">Formatcil.dExp</A> deconstructs <A HREF="api/Cil.html#TYPEexp">Cil.exp</A>.
-<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALdType">Formatcil.dType</A> deconstructs <A HREF="api/Cil.html#TYPEtyp">Cil.typ</A>.
-<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALdLval">Formatcil.dLval</A> deconstructs <A HREF="api/Cil.html#TYPElval">Cil.lval</A>.
-<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALdInstr">Formatcil.dInstr</A> deconstructs <A HREF="api/Cil.html#TYPElval">Cil.lval</A>.
-</UL>
-Below is an example using interpreted constructors. This example generates
-the CIL representation of code that scans an array backwards and initializes
-every even-index element with an expression:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-Formatcil.cStmts
- loc
- "int idx = sizeof(array) / sizeof(array[0]) - 1;
- while(idx >= 0) {
- // Some statements to be run for all the elements of the array
- %S:init
- if(! (idx & 1))
- array[idx] = %e:init_even;
- /* Do not forget to decrement the index variable */
- idx = idx - 1;
- }"
- (fun n t -> makeTempVar myfunc ~name:n t)
- [ ("array", Fv myarray);
- ("init", FS [stmt1; stmt2; stmt3]);
- ("init_even", Fe init_expr_for_even_elements) ]
-</FONT></PRE>
-To write the same CIL statement directly in CIL would take much more effort.
-Note that the pattern is parsed only once and the result (a function that
-takes the arguments and constructs the statement) is memoized. <BR>
-<BR>
-<!--TOC subsubsection Performance considerations for interpreted constructors-->
-
-<H4 CLASS="subsubsection"><A NAME="htoc11">6.2.1</A> Performance considerations for interpreted constructors</H4><!--SEC END -->
-
-Parsing the patterns is done with a LALR parser and it takes some time. To
-improve performance the constructors and deconstructors memoize the parsed
-patterns and will only compile a pattern once. Also all construction and
-deconstruction functions can be applied partially to the pattern string to
-produce a function that can be later used directly to construct or
-deconstruct. This function appears to be about two times slower than if the
-construction is done using the CIL constructors (without memoization the
-process would be one order of magnitude slower.) However, the convenience of
-interpreted constructor might make them a viable choice in many situations
-when performance is not paramount (e.g. prototyping).<BR>
-<BR>
-<!--TOC subsection Printing and Debugging support-->
-
-<H3 CLASS="subsection"><A NAME="htoc12">6.3</A> Printing and Debugging support</H3><!--SEC END -->
-
-The Modules <A HREF="api/Pretty.html">Pretty</A> and <A HREF="api/Errormsg.html">Errormsg</A> contain respectively
-utilities for pretty printing and reporting errors and provide a convenient
-<TT>printf</TT>-like interface. <BR>
-<BR>
-Additionally, CIL defines for each major type a pretty-printing function that
-you can use in conjunction with the <A HREF="api/Pretty.html">Pretty</A> interface. The
-following are some of the pretty-printing functions:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<A HREF="api/Cil.html#VALd_exp">Cil.d_exp</A> - print an expression
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_type">Cil.d_type</A> - print a type
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_lval">Cil.d_lval</A> - print an lvalue
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_global">Cil.d_global</A> - print a global
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_stmt">Cil.d_stmt</A> - print a statment
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_instr">Cil.d_instr</A> - print an instruction
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_init">Cil.d_init</A> - print an initializer
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_attr">Cil.d_attr</A> - print an attribute
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_attrlist">Cil.d_attrlist</A> - print a set of attributes
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_loc">Cil.d_loc</A> - print a location
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_ikind">Cil.d_ikind</A> - print an integer kind
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_fkind">Cil.d_fkind</A> - print a floating point kind
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_const">Cil.d_const</A> - print a constant
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_storage">Cil.d_storage</A> - print a storage specifier
-</UL>
-You can even customize the pretty-printer by creating instances of
-<A HREF="api/Cil.cilPrinter.html#.">Cil.cilPrinter..</A> Typically such an instance extends
-<A HREF="api/Cil.html#VALdefaultCilPrinter">Cil.defaultCilPrinter</A>. Once you have a customized pretty-printer you
-can use the following printing functions:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<A HREF="api/Cil.html#VALprintExp">Cil.printExp</A> - print an expression
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintType">Cil.printType</A> - print a type
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintLval">Cil.printLval</A> - print an lvalue
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintGlobal">Cil.printGlobal</A> - print a global
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintStmt">Cil.printStmt</A> - print a statment
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintInstr">Cil.printInstr</A> - print an instruction
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintInit">Cil.printInit</A> - print an initializer
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintAttr">Cil.printAttr</A> - print an attribute
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintAttrs">Cil.printAttrs</A> - print a set of attributes
-</UL>
-CIL has certain internal consistency invariants. For example, all references
-to a global variable must point to the same <TT>varinfo</TT> structure. This
-ensures that one can rename the variable by changing the name in the
-<TT>varinfo</TT>. These constraints are mentioned in the API documentation. There
-is also a consistency checker in file <TT>src/check.ml</TT>. If you suspect that
-your transformation is breaking these constraints then you can pass the
-<TT>--check</TT> option to cilly and this will ensure that the consistency checker
-is run after each transformation. <BR>
-<BR>
-<!--TOC subsection Attributes-->
-
-<H3 CLASS="subsection"><A NAME="htoc13">6.4</A> Attributes</H3><!--SEC END -->
-<A NAME="sec-attrib"></A>
-In CIL you can attach attributes to types and to names (variables, functions
-and fields). Attributes are represented using the type <A HREF="api/Cil.html#TYPEattribute">Cil.attribute</A>.
-An attribute consists of a name and a number of arguments (represented using
-the type <A HREF="api/Cil.html#TYPEattrparam">Cil.attrparam</A>). Almost any expression can be used as an
-attribute argument. Attributes are stored in lists sorted by the name of the
-attribute. To maintain list ordering, use the functions
-<A HREF="api/Cil.html#VALtypeAttrs">Cil.typeAttrs</A> to retrieve the attributes of a type and the functions
-<A HREF="api/Cil.html#VALaddAttribute">Cil.addAttribute</A> and <A HREF="api/Cil.html#VALaddAttributes">Cil.addAttributes</A> to add attributes.
-Alternatively you can use <A HREF="api/Cil.html#VALtypeAddAttributes">Cil.typeAddAttributes</A> to add an attribute to
-a type (and return the new type).<BR>
-<BR>
-GCC already has extensive support for attributes, and CIL extends this
-support to user-defined attributes. A GCC attribute has the syntax:
-<PRE CLASS="verbatim">
- gccattribute ::= __attribute__((attribute)) (Note the double parentheses)
-</PRE>
- Since GCC and MSVC both support various flavors of each attribute (with or
-without leading or trailing _) we first strip ALL leading and trailing _
-from the attribute name (but not the identified in [ACons] parameters in
-<A HREF="api/Cil.html#TYPEattrparam">Cil.attrparam</A>). When we print attributes, for GCC we add two leading
-and two trailing _; for MSVC we add just two leading _.<BR>
-<BR>
-There is support in CIL so that you can control the printing of attributes
-(see <A HREF="api/Cil.html#VALsetCustomPrintAttribute">Cil.setCustomPrintAttribute</A> and
-<A HREF="api/Cil.html#VALsetCustomPrintAttributeScope">Cil.setCustomPrintAttributeScope</A>). This custom-printing support is now
-used to print the "const" qualifier as "<TT>const</TT>" and not as
-"<TT>__attribute__((const))</TT>".<BR>
-<BR>
-The attributes are specified in declarations. This is unfortunate since the C
-syntax for declarations is already quite complicated and after writing the
-parser and elaborator for declarations I am convinced that few C programmers
-understand it completely. Anyway, this seems to be the easiest way to support
-attributes. <BR>
-<BR>
-Name attributes must be specified at the very end of the declaration, just
-before the <TT>=</TT> for the initializer or before the <TT>,</TT> the separates a
-declaration in a group of declarations or just before the <TT>;</TT> that
-terminates the declaration. A name attribute for a function being defined can
-be specified just before the brace that starts the function body.<BR>
-<BR>
-For example (in the following examples <TT>A1</TT>,...,<TT>An</TT> are type attributes
-and <TT>N</TT> is a name attribute (each of these uses the <TT>__attribute__</TT> syntax):
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x N;
- int x N, * y N = 0, z[] N;
- extern void exit() N;
- int fact(int x) N { ... }
-</FONT></PRE>
-Type attributes can be specified along with the type using the following
- rules:
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
- The type attributes for a base type (int, float, named type, reference
- to struct or union or enum) must be specified immediately following the
- type (actually it is Ok to mix attributes with the specification of the
- type, in between unsigned and int for example).<BR>
-<BR>
-For example:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int A1 x N; /* A1 applies to the type int. An example is an attribute
- "even" restricting the type int to even values. */
- struct foo A1 A2 x; // Both A1 and A2 apply to the struct foo type
-</FONT></PRE><BR>
-<BR>
-<LI CLASS="li-enumerate">The type attributes for a pointer type must be specified immediately
- after the * symbol.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- /* A pointer (A1) to an int (A2) */
- int A2 * A1 x;
- /* A pointer (A1) to a pointer (A2) to a float (A3) */
- float A3 * A2 * A1 x;
-</FONT></PRE>
-Note: The attributes for base types and for pointer types are a strict
- extension of the ANSI C type qualifiers (const, volatile and restrict). In
- fact CIL treats these qualifiers as attributes. <BR>
-<BR>
-<LI CLASS="li-enumerate">The attributes for a function type or for an array type can be
- specified using parenthesized declarators.<BR>
-<BR>
-For example:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- /* A function (A1) from int (A2) to float (A3) */
- float A3 (A1 f)(int A2);
-
- /* A pointer (A1) to a function (A2) that returns an int (A3) */
- int A3 (A2 * A1 pfun)(void);
-
- /* An array (A1) of int (A2) */
- int A2 (A1 x0)[]
-
- /* Array (A1) of pointers (A2) to functions (A3) that take an int (A4) and
- * return a pointer (A5) to int (A6) */
- int A6 * A5 (A3 * A2 (A1 x1)[5])(int A4);
-
-
- /* A function (A4) that takes a float (A5) and returns a pointer (A6) to an
- * int (A7) */
- extern int A7 * A6 (A4 x2)(float A5 x);
-
- /* A function (A1) that takes a int (A2) and that returns a pointer (A3) to
- * a function (A4) that takes a float (A5) and returns a pointer (A6) to an
- * int (A7) */
- int A7 * A6 (A4 * A3 (A1 x3)(int A2 x))(float A5) {
- return & x2;
- }
-</FONT></PRE></OL>
-Note: ANSI C does not allow the specification of type qualifiers for function
-and array types, although it allows for the parenthesized declarator. With
-just a bit of thought (looking at the first few examples above) I hope that
-the placement of attributes for function and array types will seem intuitive.<BR>
-<BR>
-This extension is not without problems however. If you want to refer just to
-a type (in a cast for example) then you leave the name out. But this leads to
-strange conflicts due to the parentheses that we introduce to scope the
-attributes. Take for example the type of x0 from above. It should be written
-as:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int A2 (A1 )[]
-</FONT></PRE>
-But this will lead most C parsers into deep confusion because the parentheses
-around A1 will be confused for parentheses of a function designator. To push
-this problem around (I don't know a solution) whenever we are about to print a
-parenthesized declarator with no name but with attributes, we comment out the
-attributes so you can see them (for whatever is worth) without confusing the
-compiler. For example, here is how we would print the above type:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int A2 /*(A1 )*/[]
-</FONT></PRE>
-<!--TOC paragraph Handling of predefined GCC attributes-->
-
-<H5 CLASS="paragraph">Handling of predefined GCC attributes</H5><!--SEC END -->
-
-GCC already supports attributes in a lot of places in declarations. The only
-place where we support attributes and GCC does not is right before the { that
-starts a function body. <BR>
-<BR>
-GCC classifies its attributes in attributes for functions, for variables and
-for types, although the latter category is only usable in definition of struct
-or union types and is not nearly as powerful as the CIL type attributes. We
-have made an effort to reclassify GCC attributes as name and type attributes
-(they only apply for function types). Here is what we came up with:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
- GCC name attributes:<BR>
-<BR>
-section, constructor, destructor, unused, weak, no_instrument_function,
- noreturn, alias, no_check_memory_usage, dllinport, dllexport, exception,
- model<BR>
-<BR>
-Note: the "noreturn" attribute would be more appropriately qualified as a
- function type attribute. But we classify it as a name attribute to make
- it easier to support a similarly named MSVC attribute. <BR>
-<BR>
-<LI CLASS="li-itemize">GCC function type attributes:<BR>
-<BR>
-fconst (printed as "const"), format, regparm, stdcall,
- cdecl, longcall<BR>
-<BR>
-I was not able to completely decipher the position in which these attributes
- must go. So, the CIL elaborator knows these names and applies the following
- rules:
- <UL CLASS="itemize"><LI CLASS="li-itemize">
- All of the name attributes that appear in the specifier part (i.e. at
- the beginning) of a declaration are associated with all declared names. <BR>
-<BR>
-<LI CLASS="li-itemize">All of the name attributes that appear at the end of a declarator are
- associated with the particular name being declared.<BR>
-<BR>
-<LI CLASS="li-itemize">More complicated is the handling of the function type attributes, since
- there can be more than one function in a single declaration (a function
- returning a pointer to a function). Lacking any real understanding of how
- GCC handles this, I attach the function type attribute to the "nearest"
- function. This means that if a pointer to a function is "nearby" the
- attribute will be correctly associated with the function. In truth I pray
- that nobody uses declarations as that of x3 above.
- </UL>
-</UL>
-<!--TOC paragraph Handling of predefined MSVC attributes-->
-
-<H5 CLASS="paragraph">Handling of predefined MSVC attributes</H5><!--SEC END -->
-
-MSVC has two kinds of attributes, declaration modifiers to be printed before
- the storage specifier using the notation "<TT>__declspec(...)</TT>" and a few
- function type attributes, printed almost as our CIL function type
- attributes. <BR>
-<BR>
-The following are the name attributes that are printed using
- <TT>__declspec</TT> right before the storage designator of the declaration:
- thread, naked, dllimport, dllexport, noreturn<BR>
-<BR>
-The following are the function type attributes supported by MSVC:
- fastcall, cdecl, stdcall<BR>
-<BR>
-It is not worth going into the obscure details of where MSVC accepts these
- type attributes. The parser thinks it knows these details and it pulls
- these attributes from wherever they might be placed. The important thing
- is that MSVC will accept if we print them according to the rules of the CIL
- attributes ! <BR>
-<BR>
-<!--TOC section The CIL Driver-->
-
-<H2 CLASS="section"><A NAME="htoc14">7</A> The CIL Driver</H2><!--SEC END -->
-<A NAME="sec-driver"></A>
-We have packaged CIL as an application <TT>cilly</TT> that contains certain
-example modules, such as <TT>logwrites.ml</TT> (a module
-that instruments code to print the addresses of memory locations being
-written). Normally, you write another module like that, add command-line
-options and an invocation of your module in <TT>src/main.ml</TT>. Once you compile
-CIL you will obtain the file <TT>obj/cilly.asm.exe</TT>. <BR>
-<BR>
-We wrote a driver for this executable that makes it easy to invoke your
-analysis on existing C code with very little manual intervention. This driver
-is <TT>bin/cilly</TT> and is quite powerful. Note that the <TT>cilly</TT> script
-is configured during installation with the path where CIL resides. This means
-that you can move it to any place you want. <BR>
-<BR>
-A simple use of the driver is:
-<PRE CLASS="verbatim">
-bin/cilly --save-temps -D HAPPY_MOOD -I myincludes hello.c -o hello
-</PRE>
-<FONT COLOR=blue>--save-temps</FONT> tells CIL to save the resulting output files in the
-current directory. Otherwise, they'll be put in <TT>/tmp</TT> and deleted
-automatically. Not that this is the only CIL-specific flag in the
-list – the other flags use <TT>gcc</TT>'s syntax.<BR>
-<BR>
-This performs the following actions:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-preprocessing using the -D and -I arguments with the resulting
- file left in <TT>hello.i</TT>,
-<LI CLASS="li-itemize">the invocation of the <TT>cilly.asm</TT> application which parses <TT>hello.i</TT>
- converts it to CIL and the pretty-prints it to <TT>hello.cil.c</TT>
-<LI CLASS="li-itemize">another round of preprocessing with the result placed in <TT>hello.cil.i</TT>
-<LI CLASS="li-itemize">the true compilation with the result in <TT>hello.cil.o</TT>
-<LI CLASS="li-itemize">a linking phase with the result in <TT>hello</TT>
-</UL>
-Note that <TT>cilly</TT> behaves like the <TT>gcc</TT> compiler. This makes it
-easy to use it with existing <TT>Makefiles</TT>:
-<PRE CLASS="verbatim">
-make CC="bin/cilly" LD="bin/cilly"
-</PRE>
- <TT>cilly</TT> can also behave as the Microsoft Visual C compiler, if the first
- argument is <TT>--mode=MSVC</TT>:
-<PRE CLASS="verbatim">
-bin/cilly --mode=MSVC /D HAPPY_MOOD /I myincludes hello.c /Fe hello.exe
-</PRE>
- (This in turn will pass a <TT>--MSVC</TT> flag to the underlying <TT>cilly.asm</TT>
- process which will make it understand the Microsoft Visual C extensions)<BR>
-<BR>
-<TT>cilly</TT> can also behave as the archiver <TT>ar</TT>, if it is passed an
-argument <TT>--mode=AR</TT>. Note that only the <TT>cr</TT> mode is supported (create a
-new archive and replace all files in there). Therefore the previous version of
-the archive is lost. <BR>
-<BR>
-Furthermore, <TT>cilly</TT> allows you to pass some arguments on to the
-underlying <TT>cilly.asm</TT> process. As a general rule all arguments that start
-with <TT>--</TT> and that <TT>cilly</TT> itself does not process, are passed on. For
-example,
-<PRE CLASS="verbatim">
-bin/cilly --dologwrites -D HAPPY_MOOD -I myincludes hello.c -o hello.exe
-</PRE>
- will produce a file <TT>hello.cil.c</TT> that prints all the memory addresses
-written by the application. <BR>
-<BR>
-The most powerful feature of <TT>cilly</TT> is that it can collect all the
-sources in your project, merge them into one file and then apply CIL. This
-makes it a breeze to do whole-program analysis and transformation. All you
-have to do is to pass the <TT>--merge</TT> flag to <TT>cilly</TT>:
-<PRE CLASS="verbatim">
-make CC="bin/cilly --save-temps --dologwrites --merge"
-</PRE>
- You can even leave some files untouched:
-<PRE CLASS="verbatim">
-make CC="bin/cilly --save-temps --dologwrites --merge --leavealone=foo --leavealone=bar"
-</PRE>
- This will merge all the files except those with the basename <TT>foo</TT> and
-<TT>bar</TT>. Those files will be compiled as usual and then linked in at the very
-end. <BR>
-<BR>
-The sequence of actions performed by <TT>cilly</TT> depends on whether merging
-is turned on or not:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-If merging is off
- <OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
- For every file <TT>file.c</TT> to compile
- <OL CLASS="enumerate" type=a><LI CLASS="li-enumerate">
- Preprocess the file with the given arguments to
- produce <TT>file.i</TT>
- <LI CLASS="li-enumerate">Invoke <TT>cilly.asm</TT> to produce a <TT>file.cil.c</TT>
- <LI CLASS="li-enumerate">Preprocess to <TT>file.cil.i</TT>
- <LI CLASS="li-enumerate">Invoke the underlying compiler to produce <TT>file.cil.o</TT>
- </OL>
- <LI CLASS="li-enumerate">Link the resulting objects
- </OL>
-<LI CLASS="li-itemize">If merging is on
- <OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
- For every file <TT>file.c</TT> to compile
- <OL CLASS="enumerate" type=a><LI CLASS="li-enumerate">
- Preprocess the file with the given arguments to
- produce <TT>file.i</TT>
- <LI CLASS="li-enumerate">Save the preprocessed source as <TT>file.o</TT>
- </OL>
- <LI CLASS="li-enumerate">When linking executable <TT>hello.exe</TT>, look at every object
- file that must be linked and see if it actually
- contains preprocessed source. Pass all those files to a
- special merging application (described in
- Section <A HREF="#sec-merger">13</A>) to produce <TT>hello.exe_comb.c</TT>
- <LI CLASS="li-enumerate">Invoke <TT>cilly.asm</TT> to produce a <TT>hello.exe_comb.cil.c</TT>
- <LI CLASS="li-enumerate">Preprocess to <TT>hello.exe_comb.cil.i</TT>
- <LI CLASS="li-enumerate">Invoke the underlying compiler to produce <TT>hello.exe_comb.cil.o</TT>
- <LI CLASS="li-enumerate">Invoke the actual linker to produce <TT>hello.exe</TT>
- </OL>
-</UL>
-Note that files that you specify with <TT>--leavealone</TT> are not merged and
-never presented to CIL. They are compiled as usual and then are linked in at
-the end. <BR>
-<BR>
-And a final feature of <TT>cilly</TT> is that it can substitute copies of the
-system's include files:
-<PRE CLASS="verbatim">
-make CC="bin/cilly --includedir=myinclude"
-</PRE>
- This will force the preprocessor to use the file <TT>myinclude/xxx/stdio.h</TT>
-(if it exists) whenever it encounters <TT>#include <stdio.h></TT>. The <TT>xxx</TT> is
-a string that identifies the compiler version you are using. This modified
-include files should be produced with the patcher script (see
-Section <A HREF="#sec-patcher">14</A>).<BR>
-<BR>
-<!--TOC subsection <TT>cilly</TT> Options-->
-
-<H3 CLASS="subsection"><A NAME="htoc15">7.1</A> <TT>cilly</TT> Options</H3><!--SEC END -->
-
-Among the options for the <TT>cilly</TT> you can put anything that can normally
-go in the command line of the compiler that <TT>cilly</TT> is impersonating.
-<TT>cilly</TT> will do its best to pass those options along to the appropriate
-subprocess. In addition, the following options are supported (a complete and
-up-to-date list can always be obtained by running <TT>cilly --help</TT>):
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>--mode=mode</TT> This must be the first argument if present. It makes
-<TT>cilly</TT> behave as a given compiled. The following modes are recognized:
- <UL CLASS="itemize"><LI CLASS="li-itemize">
- GNUCC - the GNU C Compiler. This is the default.
- <LI CLASS="li-itemize">MSVC - the Microsoft Visual C compiler. Of course, you should
- pass only MSVC valid options in this case.
- <LI CLASS="li-itemize">AR - the archiver <TT>ar</TT>. Only the mode <TT>cr</TT> is supported and
- the original version of the archive is lost.
- </UL>
-<LI CLASS="li-itemize"><TT>--help</TT> Prints a list of the options supported.
-<LI CLASS="li-itemize"><TT>--verbose</TT> Prints lots of messages about what is going on.
-<LI CLASS="li-itemize"><TT>--stages</TT> Less than <TT>--verbose</TT> but lets you see what <TT>cilly</TT>
- is doing.
-<LI CLASS="li-itemize"><TT>--merge</TT> This tells <TT>cilly</TT> to first attempt to collect into one
-source file all of the sources that make your application, and then to apply
-<TT>cilly.asm</TT> on the resulting source. The sequence of actions in this case is
-described above and the merger itself is described in Section <A HREF="#sec-merger">13</A>.<BR>
-<BR>
-<LI CLASS="li-itemize"><TT>--leavealone=xxx</TT>. Do not merge and do not present to CIL the files
-whose basename is "xxx". These files are compiled as usual and linked in at
-the end.
-<LI CLASS="li-itemize"><TT>--includedir=xxx</TT>. Override the include files with those in the given
-directory. The given directory is the same name that was given an an argument
-to the patcher (see Section <A HREF="#sec-patcher">14</A>). In particular this means that
-that directory contains subdirectories named based on the current compiler
-version. The patcher creates those directories.
-<LI CLASS="li-itemize"><TT>--usecabs</TT>. Do not CIL, but instead just parse the source and print
-its AST out. This should looked like the preprocessed file. This is useful
-when you suspect that the conversion to CIL phase changes the meaning of the
-program.
-<LI CLASS="li-itemize"><TT>--save-temps=xxx</TT>. Temporary files are preserved in the xxx
- directory. For example, the output of CIL will be put in a file
- named <TT>*.cil.c</TT>.
-<LI CLASS="li-itemize"><TT>--save-temps</TT>. Temporay files are preserved in the current directory.
-</UL>
-<!--TOC subsection <TT>cilly.asm</TT> Options-->
-
-<H3 CLASS="subsection"><A NAME="htoc16">7.2</A> <TT>cilly.asm</TT> Options</H3><!--SEC END -->
-
- <A NAME="sec-cilly-asm-options"></A>
-All of the options that start with <TT>--</TT> and are not understood by
-<TT>cilly</TT> are passed on to <TT>cilly.asm</TT>. <TT>cilly</TT> also passes along to
-<TT>cilly.asm</TT> flags such as <TT>--MSVC</TT> that both need to know
-about. The following options are supported:<BR>
-<BR>
- <B>General Options:</B>
-<UL CLASS="itemize"><LI CLASS="li-itemize">
- <TT>--version</TT> output version information and exit
- <LI CLASS="li-itemize"><TT>--verbose</TT> Print lots of random stuff. This is passed on from cilly
- <LI CLASS="li-itemize"><TT>--warnall</TT> Show all warnings.
- <LI CLASS="li-itemize"><TT>--debug=xxx</TT> turns on debugging flag xxx
- <LI CLASS="li-itemize"><TT>--nodebug=xxx</TT> turns off debugging flag xxx
- <LI CLASS="li-itemize"><TT>--flush</TT> Flush the output streams often (aids debugging).
- <LI CLASS="li-itemize"><TT>--check</TT> Run a consistency check over the CIL after every operation.
- <LI CLASS="li-itemize"><TT>--nocheck</TT> turns off consistency checking of CIL.
- <LI CLASS="li-itemize"><TT>--noPrintLn</TT> Don't output #line directives in the output.
- <LI CLASS="li-itemize"><TT>--commPrintLn</TT> Print #line directives in the output, but
- put them in comments.
- <LI CLASS="li-itemize"><TT>--log=xxx</TT> Set the name of the log file. By default stderr is used
- <LI CLASS="li-itemize"><TT>--MSVC</TT> Enable MSVC compatibility. Default is GNU.
- <LI CLASS="li-itemize"><TT>--ignore-merge-conflicts</TT> ignore merging conflicts.
- <LI CLASS="li-itemize"><TT>--extrafiles=filename</TT>: the name of a file that contains
- a list of additional files to process, separated by whitespace.
- <LI CLASS="li-itemize"><TT>--stats</TT> Print statistics about the running time of the
- parser, conversion to CIL, etc. Also prints memory-usage
- statistics. You can time parts of your own code as well. Calling
- (<TT>Stats.time “label” func arg</TT>) will evaluate <TT>(func arg)</TT>
- and remember how long this takes. If you call <TT>Stats.time</TT>
- repeatedly with the same label, CIL will report the aggregate
- time.<BR>
-<BR>
-If available, CIL uses the x86 performance counters for these
- stats. This is very precise, but results in “wall-clock time.”
- To report only user-mode time, find the call to <TT>Stats.reset</TT> in
- <TT>main.ml</TT>, and change it to <TT>Stats.reset false</TT>.<BR>
-<BR>
-<B>Lowering Options</B>
- <LI CLASS="li-itemize"><TT>--noLowerConstants</TT> do not lower constant expressions.
- <LI CLASS="li-itemize"><TT>--noInsertImplicitCasts</TT> do not insert implicit casts.
- <LI CLASS="li-itemize"><TT>--forceRLArgEval</TT> Forces right to left evaluation of function arguments.
- <LI CLASS="li-itemize"><TT>--disallowDuplication</TT> Prevent small chunks of code from being duplicated.
- <LI CLASS="li-itemize"><TT>--keepunused</TT> Do not remove the unused variables and types.
- <LI CLASS="li-itemize"><TT>--rmUnusedInlines</TT> Delete any unused inline functions. This is the default in MSVC mode.<BR>
-<BR>
-<B>Output Options:</B>
- <LI CLASS="li-itemize"><TT>--printCilAsIs</TT> Do not try to simplify the CIL when
- printing. Without this flag, CIL will attempt to produce prettier
- output by e.g. changing <TT>while(1)</TT> into more meaningful loops.
- <LI CLASS="li-itemize"><TT>--noWrap</TT> do not wrap long lines when printing
- <LI CLASS="li-itemize"><TT>--out=xxx</TT> the name of the output CIL file. <TT>cilly</TT>
- sets this for you.
- <LI CLASS="li-itemize"><TT>--mergedout=xxx</TT> specify the name of the merged file
- <LI CLASS="li-itemize"><TT>--cabsonly=xxx</TT> CABS output file name
-<BR>
-<BR>
- <B>Selected features.</B> See Section <A HREF="#sec-Extension">8</A> for more information.
-<LI CLASS="li-itemize"><TT>--dologcalls</TT>. Insert code in the processed source to print the name of
-functions as are called. Implemented in <TT>src/ext/logcalls.ml</TT>.
-<LI CLASS="li-itemize"><TT>--dologwrites</TT>. Insert code in the processed source to print the
-address of all memory writes. Implemented in <TT>src/ext/logwrites.ml</TT>.
-<LI CLASS="li-itemize"><TT>--dooneRet</TT>. Make each function have at most one 'return'.
-Implemented in <TT>src/ext/oneret.ml</TT>.
-<LI CLASS="li-itemize"><TT>--dostackGuard</TT>. Instrument function calls and returns to
-maintain a separate stack for return addresses. Implemeted in
-<TT>src/ext/heapify.ml</TT>.
-<LI CLASS="li-itemize"><TT>--domakeCFG</TT>. Make the program look more like a CFG. Implemented
-in <TT>src/cil.ml</TT>.
-<LI CLASS="li-itemize"><TT>--dopartial</TT>. Do interprocedural partial evaluation and
-constant folding. Implemented in <TT>src/ext/partial.ml</TT>.
-<LI CLASS="li-itemize"><TT>--dosimpleMem</TT>. Simplify all memory expressions. Implemented in
-<TT>src/ext/simplemem.ml</TT>. <BR>
-<BR>
-For an up-to-date list of available options, run <TT>cilly.asm --help</TT>. </UL>
-<!--TOC section Library of CIL Modules-->
-
-<H2 CLASS="section"><A NAME="htoc17">8</A> Library of CIL Modules</H2><!--SEC END -->
- <A NAME="sec-Extension"></A><!--NAME ext.html-->
-<BR>
-<BR>
-We are developing a suite of modules that use CIL for program analyses and
-transformations that we have found useful. You can use these modules directly
-on your code, or generally as inspiration for writing similar modules. A
-particularly big and complex application written on top of CIL is CCured
-(<A HREF="../ccured/index.html"><TT>../ccured/index.html</TT></A>).<BR>
-<BR>
-<!--TOC subsection Control-Flow Graphs-->
-
-<H3 CLASS="subsection"><A NAME="htoc18">8.1</A> Control-Flow Graphs</H3><!--SEC END -->
- <A NAME="sec-cfg"></A>
-The <A HREF="api/Cil.html#TYPEstmt">Cil.stmt</A> datatype includes fields for intraprocedural
-control-flow information: the predecessor and successor statements of
-the current statement. This information is not computed by default.
-If you want to use the control-flow graph, or any of the extensions in
-this section that require it, you have to explicitly ask CIL to
-compute the CFG.<BR>
-<BR>
-<!--TOC subsubsection The CFG module (new in CIL 1.3.5)-->
-
-<H4 CLASS="subsubsection"><A NAME="htoc19">8.1.1</A> The CFG module (new in CIL 1.3.5)</H4><!--SEC END -->
-
-The best way to compute the CFG is with the CFG module. Just invoke
-<A HREF="api/Cfg.html#VALcomputeFileCFG">Cfg.computeFileCFG</A> on your file. The <A HREF="api/Cfg.html">Cfg</A> API
-describes the rest of actions you can take with this module, including
-computing the CFG for one function at a time, or printing the CFG in
-<TT>dot</TT> form.<BR>
-<BR>
-<!--TOC subsubsection Simplified control flow-->
-
-<H4 CLASS="subsubsection"><A NAME="htoc20">8.1.2</A> Simplified control flow</H4><!--SEC END -->
-
-CIL can reduce high-level C control-flow constructs like <TT>switch</TT> and
-<TT>continue</TT> to lower-level <TT>goto</TT>s. This completely eliminates some
-possible classes of statements from the program and may make the result
-easier to analyze (e.g., it simplifies data-flow analysis).<BR>
-<BR>
-You can invoke this transformation on the command line with
-<TT>--domakeCFG</TT> or programatically with <A HREF="api/Cil.html#VALprepareCFG">Cil.prepareCFG</A>.
-After calling Cil.prepareCFG, you can use <A HREF="api/Cil.html#VALcomputeCFGInfo">Cil.computeCFGInfo</A>
-to compute the CFG information and find the successor and predecessor
-of each statement.<BR>
-<BR>
-For a concrete example, you can see how <TT>cilly --domakeCFG</TT>
-transforms the following code (note the fall-through in case 1):
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int foo (int predicate) {
- int x = 0;
- switch (predicate) {
- case 0: return 111;
- case 1: x = x + 1;
- case 2: return (x+3);
- case 3: break;
- default: return 222;
- }
- return 333;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex23.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<!--TOC subsection Data flow analysis framework-->
-
-<H3 CLASS="subsection"><A NAME="htoc21">8.2</A> Data flow analysis framework</H3><!--SEC END -->
-
-The <A HREF="api/Dataflow.html">Dataflow</A> module (click for the ocamldoc) contains a
-parameterized framework for forward and backward data flow
-analyses. You provide the transfer functions and this module does the
-analysis. You must compute control-flow information (Section <A HREF="#sec-cfg">8.1</A>)
-before invoking the Dataflow module.<BR>
-<BR>
-<!--TOC subsection Dominators-->
-
-<H3 CLASS="subsection"><A NAME="htoc22">8.3</A> Dominators</H3><!--SEC END -->
-
-The module <A HREF="api/Dominators.html">Dominators</A> contains the computation of immediate
- dominators. It uses the <A HREF="api/Dataflow.html">Dataflow</A> module. <BR>
-<BR>
-<!--TOC subsection Points-to Analysis-->
-
-<H3 CLASS="subsection"><A NAME="htoc23">8.4</A> Points-to Analysis</H3><!--SEC END -->
-
-The module <TT>ptranal.ml</TT> contains two interprocedural points-to
-analyses for CIL: <TT>Olf</TT> and <TT>Golf</TT>. <TT>Olf</TT> is the default.
-(Switching from <TT>olf.ml</TT> to <TT>golf.ml</TT> requires a change in
-<TT>Ptranal</TT> and a recompiling <TT>cilly</TT>.)<BR>
-<BR>
-The analyses have the following characteristics:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-Not based on C types (inferred pointer relationships are sound
- despite most kinds of C casts)
-<LI CLASS="li-itemize">One level of subtyping
-<LI CLASS="li-itemize">One level of context sensitivity (Golf only)
-<LI CLASS="li-itemize">Monomorphic type structures
-<LI CLASS="li-itemize">Field insensitive (fields of structs are conflated)
-<LI CLASS="li-itemize">Demand-driven (points-to queries are solved on demand)
-<LI CLASS="li-itemize">Handle function pointers
-</UL>
-The analysis itself is factored into two components: <TT>Ptranal</TT>,
-which walks over the CIL file and generates constraints, and <TT>Olf</TT>
-or <TT>Golf</TT>, which solve the constraints. The analysis is invoked
-with the function <TT>Ptranal.analyze_file: Cil.file ->
- unit</TT>. This function builds the points-to graph for the CIL file
-and stores it internally. There is currently no facility for clearing
-internal state, so <TT>Ptranal.analyze_file</TT> should only be called
-once.<BR>
-<BR>
-The constructed points-to graph supports several kinds of queries,
-including alias queries (may two expressions be aliased?) and
-points-to queries (to what set of locations may an expression point?).<BR>
-<BR>
-The main interface with the alias analysis is as follows:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>Ptranal.may_alias: Cil.exp -> Cil.exp -> bool</TT>. If
- <TT>true</TT>, the two expressions may have the same value.
-<LI CLASS="li-itemize"><TT>Ptranal.resolve_lval: Cil.lval -> (Cil.varinfo
- list)</TT>. Returns the list of variables to which the given
- left-hand value may point.
-<LI CLASS="li-itemize"><TT>Ptranal.resolve_exp: Cil.exp -> (Cil.varinfo list)</TT>.
- Returns the list of variables to which the given expression may
- point.
-<LI CLASS="li-itemize"><TT>Ptranal.resolve_funptr: Cil.exp -> (Cil.fundec
- list)</TT>. Returns the list of functions to which the given
- expression may point.
-</UL>
-The precision of the analysis can be customized by changing the values
-of several flags:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>Ptranal.no_sub: bool ref</TT>.
- If <TT>true</TT>, subtyping is disabled. Associated commandline option:
- <B>--ptr_unify</B>.
-<LI CLASS="li-itemize"><TT>Ptranal.analyze_mono: bool ref</TT>.
- (Golf only) If <TT>true</TT>, context sensitivity is disabled and the
- analysis is effectively monomorphic. Commandline option:
- <B>--ptr_mono</B>.
-<LI CLASS="li-itemize"><TT>Ptranal.smart_aliases: bool ref</TT>.
- (Golf only) If <TT>true</TT>, “smart” disambiguation of aliases is
- enabled. Otherwise, aliases are computed by intersecting points-to
- sets. This is an experimental feature.
-<LI CLASS="li-itemize"><TT>Ptranal.model_strings: bool ref</TT>.
- Make the alias analysis model string constants by treating them as
- pointers to chars. Commandline option: <B>--ptr_model_strings</B>
-<LI CLASS="li-itemize"><TT>Ptranal.conservative_undefineds: bool ref</TT>.
- Make the most pessimistic assumptions about globals if an undefined
- function is present. Such a function can write to every global
- variable. Commandline option: <B>--ptr_conservative</B>
-</UL>
-In practice, the best precision/efficiency tradeoff is achieved by
-setting <TT>Ptranal.no_sub</TT> to <TT>false</TT>, <TT>Ptranal.analyze_mono</TT> to
-<TT>true</TT>, and <TT>Ptranal.smart_aliases</TT> to <TT>false</TT>. These are the
-default values of the flags.<BR>
-<BR>
-There are also a few flags that can be used to inspect or serialize
-the results of the analysis.
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>Ptranal.debug_may_aliases</TT>.
- Print the may-alias relationship of each pair of expressions in the
- program. Commandline option: <B>--ptr_may_aliases</B>.
-<LI CLASS="li-itemize"><TT>Ptranal.print_constraints: bool ref</TT>.
- If <TT>true</TT>, the analysis will print each constraint as it is
- generated.
-<LI CLASS="li-itemize"><TT>Ptranal.print_types: bool ref</TT>.
- If <TT>true</TT>, the analysis will print the inferred type of each
- variable in the program.<BR>
-<BR>
-If <TT>Ptranal.analyze_mono</TT> and <TT>Ptranal.no_sub</TT> are both
- <TT>true</TT>, this output is sufficient to reconstruct the points-to
- graph. One nice feature is that there is a pretty printer for
- recursive types, so the print routine does not loop.
-<LI CLASS="li-itemize"><TT>Ptranal.compute_results: bool ref</TT>.
- If <TT>true</TT>, the analysis will print out the points-to set of each
- variable in the program. This will essentially serialize the
- points-to graph.
-</UL>
-<!--TOC subsection StackGuard-->
-
-<H3 CLASS="subsection"><A NAME="htoc24">8.5</A> StackGuard</H3><!--SEC END -->
-
-The module <TT>heapify.ml</TT> contains a transformation similar to the one
-described in “StackGuard: Automatic Adaptive Detection and Prevention of
-Buffer-Overflow Attacks”, <EM>Proceedings of the 7th USENIX Security
-Conference</EM>. In essence it modifies the program to maintain a separate
-stack for return addresses. Even if a buffer overrun attack occurs the
-actual correct return address will be taken from the special stack. <BR>
-<BR>
-Although it does work, this CIL module is provided mainly as an example of
-how to perform a simple source-to-source program analysis and
-transformation. As an optimization only functions that contain a dangerous
-local array make use of the special return address stack. <BR>
-<BR>
-For a concrete example, you can see how <TT>cilly --dostackGuard</TT>
-transforms the following dangerous code:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int dangerous() {
- char array[10];
- scanf("%s",array); // possible buffer overrun!
- }
-
- int main () {
- return dangerous();
- }
-</FONT></PRE>
-See the <A HREF="examples/ex24.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<!--TOC subsection Heapify-->
-
-<H3 CLASS="subsection"><A NAME="htoc25">8.6</A> Heapify</H3><!--SEC END -->
-
-The module <TT>heapify.ml</TT> also contains a transformation that moves all
-dangerous local arrays to the heap. This also prevents a number of buffer
-overruns. <BR>
-<BR>
-For a concrete example, you can see how <TT>cilly --doheapify</TT>
-transforms the following dangerous code:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int dangerous() {
- char array[10];
- scanf("%s",array); // possible buffer overrun!
- }
-
- int main () {
- return dangerous();
- }
-</FONT></PRE>
-See the <A HREF="examples/ex25.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<!--TOC subsection One Return-->
-
-<H3 CLASS="subsection"><A NAME="htoc26">8.7</A> One Return</H3><!--SEC END -->
-
-The module <TT>oneret.ml</TT> contains a transformation the ensures that all
-function bodies have at most one return statement. This simplifies a number
-of analyses by providing a canonical exit-point. <BR>
-<BR>
-For a concrete example, you can see how <TT>cilly --dooneRet</TT>
-transforms the following code:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int foo (int predicate) {
- if (predicate <= 0) {
- return 1;
- } else {
- if (predicate > 5)
- return 2;
- return 3;
- }
- }
-</FONT></PRE>
-See the <A HREF="examples/ex26.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<!--TOC subsection Partial Evaluation and Constant Folding-->
-
-<H3 CLASS="subsection"><A NAME="htoc27">8.8</A> Partial Evaluation and Constant Folding</H3><!--SEC END -->
-
-The <TT>partial.ml</TT> module provides a simple interprocedural partial
-evaluation and constant folding data-flow analysis and transformation. This
-transformation requires the <TT>--domakeCFG</TT> option. <BR>
-<BR>
-For a concrete example, you can see how <TT>cilly --domakeCFG --dopartial</TT>
-transforms the following code (note the eliminated <TT>if</TT> branch and the
-partial optimization of <TT>foo</TT>):
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int foo(int x, int y) {
- int unknown;
- if (unknown)
- return y+2;
- return x+3;
- }
-
- int main () {
- int a,b,c;
- a = foo(5,7) + foo(6,7);
- b = 4;
- c = b * b;
- if (b > c)
- return b-c;
- else
- return b+c;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex27.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<!--TOC subsection Reaching Definitions-->
-
-<H3 CLASS="subsection"><A NAME="htoc28">8.9</A> Reaching Definitions</H3><!--SEC END -->
-
-The <TT>reachingdefs.ml</TT> module uses the dataflow framework and CFG
-information to calculate the definitions that reach each
-statement. After computing the CFG (Section <A HREF="#sec-cfg">8.1</A>) and calling
-<TT>computeRDs</TT> on a
-function declaration, <TT>ReachingDef.stmtStartData</TT> will contain a
-mapping from statement IDs to data about which definitions reach each
-statement. In particular, it is a mapping from statement IDs to a
-triple the first two members of which are used internally. The third
-member is a mapping from variable IDs to Sets of integer options. If
-the set contains <TT>Some(i)</TT>, then the definition of that variable
-with ID <TT>i</TT> reaches that statement. If the set contains <TT>None</TT>,
-then there is a path to that statement on which there is no definition
-of that variable. Also, if the variable ID is unmapped at a
-statement, then no definition of that variable reaches that statement.<BR>
-<BR>
-To summarize, reachingdefs.ml has the following interface:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>computeRDs</TT> – Computes reaching definitions. Requires that
-CFG information has already been computed for each statement.
-<LI CLASS="li-itemize"><TT>ReachingDef.stmtStartData</TT> – contains reaching
-definition data after <TT>computeRDs</TT> is called.
-<LI CLASS="li-itemize"><TT>ReachingDef.defIdStmtHash</TT> – Contains a mapping
-from definition IDs to the ID of the statement in which
-the definition occurs.
-<LI CLASS="li-itemize"><TT>getRDs</TT> – Takes a statement ID and returns
-reaching definition data for that statement.
-<LI CLASS="li-itemize"><TT>instrRDs</TT> – Takes a list of instructions and the
-definitions that reach the first instruction, and for
-each instruction calculates the definitions that reach
-either into or out of that instruction.
-<LI CLASS="li-itemize"><TT>rdVisitorClass</TT> – A subclass of nopCilVisitor that
-can be extended such that the current reaching definition
-data is available when expressions are visited through
-the <TT>get_cur_iosh</TT> method of the class.
-</UL>
-<!--TOC subsection Available Expressions-->
-
-<H3 CLASS="subsection"><A NAME="htoc29">8.10</A> Available Expressions</H3><!--SEC END -->
-
-The <TT>availexps.ml</TT> module uses the dataflow framework and CFG
-information to calculate something similar to a traditional available
-expressions analysis. After <TT>computeAEs</TT> is called following a CFG
-calculation (Section <A HREF="#sec-cfg">8.1</A>), <TT>AvailableExps.stmtStartData</TT> will
-contain a mapping
-from statement IDs to data about what expressions are available at
-that statement. The data for each statement is a mapping for each
-variable ID to the whole expression available at that point(in the
-traditional sense) which the variable was last defined to be. So,
-this differs from a traditional available expressions analysis in that
-only whole expressions from a variable definition are considered rather
-than all expressions.<BR>
-<BR>
-The interface is as follows:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>computeAEs</TT> – Computes available expressions. Requires
-that CFG information has already been comptued for each statement.
-<LI CLASS="li-itemize"><TT>AvailableExps.stmtStartData</TT> – Contains available
-expressions data for each statement after <TT>computeAEs</TT> has been
-called.
-<LI CLASS="li-itemize"><TT>getAEs</TT> – Takes a statement ID and returns
-available expression data for that statement.
-<LI CLASS="li-itemize"><TT>instrAEs</TT> – Takes a list of instructions and
-the availalbe expressions at the first instruction, and
-for each instruction calculates the expressions available
-on entering or exiting each instruction.
-<LI CLASS="li-itemize"><TT>aeVisitorClass</TT> – A subclass of nopCilVisitor that
-can be extended such that the current available expressions
-data is available when expressions are visited through the
-<TT>get_cur_eh</TT> method of the class.
-</UL>
-<!--TOC subsection Liveness Analysis-->
-
-<H3 CLASS="subsection"><A NAME="htoc30">8.11</A> Liveness Analysis</H3><!--SEC END -->
-
-The <TT>liveness.ml</TT> module uses the dataflow framework and
-CFG information to calculate which variables are live at
-each program point. After <TT>computeLiveness</TT> is called
-following a CFG calculation (Section <A HREF="#sec-cfg">8.1</A>), <TT>LiveFlow.stmtStartData</TT> will
-contain a mapping for each statement ID to a set of <TT>varinfo</TT>s
-for varialbes live at that program point.<BR>
-<BR>
-The interface is as follows:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>computeLiveness</TT> – Computes live variables. Requires
-that CFG information has already been computed for each statement.
-<LI CLASS="li-itemize"><TT>LiveFlow.stmtStartData</TT> – Contains live variable data
-for each statement after <TT>computeLiveness</TT> has been called.
-</UL>
-Also included in this module is a command line interface that
-will cause liveness data to be printed to standard out for
-a particular function or label.
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>–doliveness</TT> – Instructs cilly to comptue liveness
-information and to print on standard out the variables live
-at the points specified by <TT>–live_func</TT> and <TT>live_label</TT>.
-If both are ommitted, then nothing is printed.
-<LI CLASS="li-itemize"><TT>–live_func</TT> – The name of the function whose
-liveness data is of interest. If <TT>–live_label</TT> is ommitted,
-then data for each statement is printed.
-<LI CLASS="li-itemize"><TT>–live_label</TT> – The name of the label at which
-the liveness data will be printed.
-</UL>
-<!--TOC subsection Dead Code Elimination-->
-
-<H3 CLASS="subsection"><A NAME="htoc31">8.12</A> Dead Code Elimination</H3><!--SEC END -->
-
-The module <TT>deadcodeelim.ml</TT> uses the reaching definitions
-analysis to eliminate assignment instructions whose results
-are not used. The interface is as follows:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>elim_dead_code</TT> – Performs dead code elimination
-on a function. Requires that CFG information has already
-been computed (Section <A HREF="#sec-cfg">8.1</A>).
-<LI CLASS="li-itemize"><TT>dce</TT> – Performs dead code elimination on an
-entire file. Requires that CFG information has already
-been computed.
-</UL>
-<!--TOC subsection Simple Memory Operations-->
-
-<H3 CLASS="subsection"><A NAME="htoc32">8.13</A> Simple Memory Operations</H3><!--SEC END -->
-
-The <TT>simplemem.ml</TT> module allows CIL lvalues that contain memory
-accesses to be even futher simplified via the introduction of
-well-typed temporaries. After this transformation all lvalues involve
-at most one memory reference.<BR>
-<BR>
-For a concrete example, you can see how <TT>cilly --dosimpleMem</TT>
-transforms the following code:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int main () {
- int ***three;
- int **two;
- ***three = **two;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex28.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<!--TOC subsection Simple Three-Address Code-->
-
-<H3 CLASS="subsection"><A NAME="htoc33">8.14</A> Simple Three-Address Code</H3><!--SEC END -->
-
-The <TT>simplify.ml</TT> module further reduces the complexity of program
-expressions and gives you a form of three-address code. After this
-transformation all expressions will adhere to the following grammar:
-<PRE CLASS="verbatim">
- basic::=
- Const _
- Addrof(Var v, NoOffset)
- StartOf(Var v, NoOffset)
- Lval(Var v, off), where v is a variable whose address is not taken
- and off contains only "basic"
-
- exp::=
- basic
- Lval(Mem basic, NoOffset)
- BinOp(bop, basic, basic)
- UnOp(uop, basic)
- CastE(t, basic)
-
- lval ::=
- Mem basic, NoOffset
- Var v, off, where v is a variable whose address is not taken and off
- contains only "basic"
-</PRE>In addition, all <TT>sizeof</TT> and <TT>alignof</TT> forms are turned into
-constants. Accesses to arrays and variables whose address is taken are
-turned into "Mem" accesses. All field and index computations are turned
-into address arithmetic.<BR>
-<BR>
-For a concrete example, you can see how <TT>cilly --dosimplify</TT>
-transforms the following code:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int main() {
- struct mystruct {
- int a;
- int b;
- } m;
- int local;
- int arr[3];
- int *ptr;
-
- ptr = &local;
- m.a = local + sizeof(m) + arr[2];
- return m.a;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex29.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<!--TOC subsection Converting C to C++-->
-
-<H3 CLASS="subsection"><A NAME="htoc34">8.15</A> Converting C to C++</H3><!--SEC END -->
-
-The module canonicalize.ml performs several transformations to correct
-differences between C and C++, so that the output is (hopefully) valid
-C++ code. This may be incomplete — certain fixes which are necessary
-for some programs are not yet implemented.<BR>
-<BR>
-Using the <TT>--doCanonicalize</TT> option with CIL will perform the
-following changes to your program:
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
-Any variables that use C++ keywords as identifiers are renamed.
-<LI CLASS="li-enumerate">C allows global variables to have multiple declarations and
- multiple (equivalent) definitions. This transformation removes
- all but one declaration and all but one definition.
-<LI CLASS="li-enumerate"><TT>__inline</TT> is #defined to <TT>inline</TT>, and <TT>__restrict</TT>
- is #defined to nothing.
-<LI CLASS="li-enumerate">C allows function pointers with no specified arguments to be used on
- any argument list. To make C++ accept this code, we insert a cast
- from the function pointer to a type that matches the arguments. Of
- course, this does nothing to guarantee that the pointer actually has
- that type.
-<LI CLASS="li-enumerate">Makes casts from int to enum types explicit. (CIL changes enum
- constants to int constants, but doesn't use a cast.)
-</OL>
-<!--TOC section Controlling CIL-->
-
-<H2 CLASS="section"><A NAME="htoc35">9</A> Controlling CIL</H2><!--SEC END -->
-
-In the process of converting a C file to CIL we drop the unused prototypes
-and even inline function definitions. This results in much smaller files. If
-you do not want this behavior then you must pass the <TT>--keepunused</TT> argument
-to the CIL application. <BR>
-<BR>
-Alternatively you can put the following pragma in the code (instructing CIL
-to specifically keep the declarations and definitions of the function
-<TT>func1</TT> and variable <TT>var2</TT>, the definition of type <TT>foo</TT> and of
-structure <TT>bar</TT>):
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-#pragma cilnoremove("func1", "var2", "type foo", "struct bar")
-</FONT></PRE>
-<!--TOC section GCC Extensions-->
-
-<H2 CLASS="section"><A NAME="htoc36">10</A> GCC Extensions</H2><!--SEC END -->
-
-The CIL parser handles most of the <TT>gcc</TT>
-<A HREF="javascript:loadTop('http://gcc.gnu.org/onlinedocs/gcc-3.0.2/gcc_5.html#SEC67')">extensions</A>
-and compiles them to CIL. The following extensions are not handled (note that
-we are able to compile a large number of programs, including the Linux kernel,
-without encountering these):
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
-Nested function definitions.
-<LI CLASS="li-enumerate">Constructing function calls.
-<LI CLASS="li-enumerate">Naming an expression's type.
-<LI CLASS="li-enumerate">Complex numbers
-<LI CLASS="li-enumerate">Hex floats
-<LI CLASS="li-enumerate">Subscripts on non-lvalue arrays.
-<LI CLASS="li-enumerate">Forward function parameter declarations
-</OL>
-The following extensions are handled, typically by compiling them away:
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
-Attributes for functions, variables and types. In fact, we have a clear
-specification (see Section <A HREF="#sec-attrib">6.4</A>) of how attributes are interpreted. The
-specification extends that of <TT>gcc</TT>.
-<LI CLASS="li-enumerate">Old-style function definitions and prototypes. These are translated to
-new-style.
-<LI CLASS="li-enumerate">Locally-declared labels. As part of the translation to CIL, we generate
-new labels as needed.
-<LI CLASS="li-enumerate">Labels as values and computed goto. This allows a program to take the
-address of a label and to manipulate it as any value and also to perform a
-computed goto. We compile this by assigning each label whose address is taken
-a small integer that acts as its address. Every computed <TT>goto</TT> in the body
-of the function is replaced with a <TT>switch</TT> statement. If you want to invoke
-the label from another function, you are on your own (the <TT>gcc</TT>
-documentation says the same.)
-<LI CLASS="li-enumerate">Generalized lvalues. You can write code like <TT>(a, b) += 5</TT> and it gets
-translated to CIL.
-<LI CLASS="li-enumerate">Conditionals with omitted operands. Things like <TT>x ? : y</TT> are
-translated to CIL.
-<LI CLASS="li-enumerate">Double word integers. The type <TT>long long</TT> and the <TT>LL</TT> suffix on
-constants is understood. This is currently interpreted as 64-bit integers.
-<LI CLASS="li-enumerate">Local arrays of variable length. These are converted to uses of
-<TT>alloca</TT>, the array variable is replaced with a pointer to the allocated
-array and the instances of <TT>sizeof(a)</TT> are adjusted to return the size of
-the array and not the size of the pointer.
-<LI CLASS="li-enumerate">Non-constant local initializers. Like all local initializers these are
-compiled into assignments.
-<LI CLASS="li-enumerate">Compound literals. These are also turned into assignments.
-<LI CLASS="li-enumerate">Designated initializers. The CIL parser actually supports the full ISO
-syntax for initializers, which is more than both <TT>gcc</TT> and <TT>MSVC</TT>. I
-(George) think that this is the most complicated part of the C language and
-whoever designed it should be banned from ever designing languages again.
-<LI CLASS="li-enumerate">Case ranges. These are compiled into separate cases. There is no code
-duplication, just a larger number of <TT>case</TT> statements.
-<LI CLASS="li-enumerate">Transparent unions. This is a strange feature that allows you to define
-a function whose formal argument has a (tranparent) union type, but the
-argument is called as if it were the first element of the union. This is
-compiled away by saying that the type of the formal argument is that of the
-first field, and the first thing in the function body we copy the formal into
-a union. <BR>
-<BR>
-<LI CLASS="li-enumerate">Inline assembly-language. The full syntax is supported and it is carried
-as such in CIL.<BR>
-<BR>
-<LI CLASS="li-enumerate">Function names as strings. The identifiers <TT>__FUNCTION__</TT> and
-<TT>__PRETTY_FUNCTION__</TT> are replaced with string literals. <BR>
-<BR>
-<LI CLASS="li-enumerate">Keywords <TT>typeof</TT>, <TT>alignof</TT>, <TT>inline</TT> are supported.
-</OL>
-<!--TOC section CIL Limitations-->
-
-<H2 CLASS="section"><A NAME="htoc37">11</A> CIL Limitations</H2><!--SEC END -->
-
-There are several implementation details of CIL that might make it unusable
- or less than ideal for certain tasks:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-CIL operates after preprocessing. If you need to see comments, for
-example, you cannot use CIL. But you can use attributes and pragmas instead.
-And there is some support to help you patch the include files before they are
-seen by the preprocessor. For example, this is how we turn some
-<TT>#define</TT>s that we don't like into function calls. <BR>
-<BR>
-<LI CLASS="li-itemize">CIL does transform the code in a non-trivial way. This is done in order
-to make most analyses easier. But if you want to see the code <TT>e1, e2++</TT>
-exactly as it appears in the code, then you should not use CIL. <BR>
-<BR>
-<LI CLASS="li-itemize">CIL removes all local scopes and moves all variables to function
-scope. It also separates a declaration with an initializer into a declaration
-plus an assignment. The unfortunate effect of this transformation is that
-local variables cannot have the <TT>const</TT> qualifier.</UL>
-<!--TOC section Known Bugs and Limitations-->
-
-<H2 CLASS="section"><A NAME="htoc38">12</A> Known Bugs and Limitations</H2><!--SEC END -->
-
-<UL CLASS="itemize"><LI CLASS="li-itemize">In the new versions of <TT>glibc</TT> there is a function
- <TT>__builtin_va_arg</TT> that takes a type as its second argument. CIL
- handles that through a slight trick. As it parses the function it changes a
- call like:
-<PRE CLASS="verbatim">
- mytype x = __builtin_va_arg(marker, mytype)
-</PRE>into
-<PRE CLASS="verbatim">
- mytype x;
- __builtin_va_arg(marker, sizeof(mytype), &x);
-</PRE>
- The latter form is used internally in CIL. However, the CIL pretty printer
- will try to emit the original code. <BR>
-<BR>
-Similarly, <TT>__builtin_types_compatible_p(t1, t2)</TT>, which takes
- types as arguments, is represented internally as
- <TT>__builtin_types_compatible_p(sizeof t1, sizeof t2)</TT>, but the
- sizeofs are removed when printing.<BR>
-<BR>
-<LI CLASS="li-itemize">The implementation of <TT>bitsSizeOf</TT> does not take into account the
-packing pragmas. However it was tested to be accurate on cygwin/gcc-2.95.3,
-Linux/gcc-2.95.3 and on Windows/MSVC.<BR>
-<BR>
-<LI CLASS="li-itemize">We do not support tri-graph sequences (ISO 5.2.1.1).<BR>
-<BR>
-<LI CLASS="li-itemize">GCC has a strange feature called “extern inline”. Such a function can
-be defined twice: first with the “extern inline” specifier and the second
-time without it. If optimizations are turned off then the “extern inline”
-definition is considered a prototype (its body is ignored). If optimizations
-are turned on then the extern inline function is inlined at all of its
-occurrences from the point of its definition all the way to the point where the
-(optional) second definition appears. No body is generated for an extern
-inline function. A body is generated for the real definition and that one is
-used in the rest of the file. <BR>
-<BR>
-CIL will rename your extern inline function (and its uses) with the suffix
- <TT>__extinline</TT>. This means that if you have two such definition, that do
- different things and the optimizations are not on, then the CIL version might
- compute a different answer !<BR>
-<BR>
-Also, if you have multiple extern inline declarations then CIL will ignore
-but the first one. This is not so bad because GCC itself would not like it. <BR>
-<BR>
-<LI CLASS="li-itemize">There are still a number of bugs in handling some obscure features of
-GCC. For example, when you use variable-length arrays, CIL turns them into
-calls to <TT>alloca</TT>. This means that they are deallocated when the function
-returns and not when the local scope ends. <BR>
-<BR>
-Variable-length arrays are not supported as fields of a struct or union.<BR>
-<BR>
-<LI CLASS="li-itemize">CIL cannot parse arbitrary <TT>#pragma</TT> directives. Their
- syntax must follow gcc's attribute syntax to be understood. If you
- need a pragma that does not follow gcc syntax, add that pragma's name
- to <TT>no_parse_pragma</TT> in <TT>src/frontc/clexer.mll</TT> to indicate that
- CIL should treat that pragma as a monolithic string rather than try
- to parse its arguments.<BR>
-<BR>
-CIL cannot parse a line containing an empty <TT>#pragma</TT>.<BR>
-<BR>
-<LI CLASS="li-itemize">CIL only parses <TT>#pragma</TT> directives at the "top level", this is,
- outside of any enum, structure, union, or function definitions.<BR>
-<BR>
-If your compiler uses pragmas in places other than the top-level,
- you may have to preprocess the sources in a special way (sed, perl,
- etc.) to remove pragmas from these locations.<BR>
-<BR>
-<LI CLASS="li-itemize">CIL cannot parse the following code (fixing this problem would require
-extensive hacking of the LALR grammar):
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-int bar(int ()); // This prototype cannot be parsed
-int bar(int x()); // If you add a name to the function, it works
-int bar(int (*)()); // This also works (and it is more appropriate)
-</FONT></PRE><BR>
-<BR>
-<LI CLASS="li-itemize">CIL also cannot parse certain K&R old-style prototypes with missing
-return type:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-g(); // This cannot be parsed
-int g(); // This is Ok
-</FONT></PRE><BR>
-<BR>
-<LI CLASS="li-itemize">CIL does not understand some obscure combinations of type specifiers
-(“signed” and “unsigned” applied to typedefs that themselves contain a
-sign specification; you could argue that this should not be allowed anyway):
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-typedef signed char __s8;
-__s8 unsigned uchartest; // This is unsigned char for gcc
-</FONT></PRE><BR>
-<BR>
-<LI CLASS="li-itemize">The statement <TT>x = 3 + x ++</TT> will perform the increment of <TT>x</TT>
- before the assignment, while <TT>gcc</TT> delays the increment after the
- assignment. It turned out that this behavior is much easier to implement
- than gcc's one, and either way is correct (since the behavior is unspecified
- in this case). Similarly, if you write <TT>x = x ++;</TT> then CIL will perform
- the increment before the assignment, whereas GCC and MSVC will perform it
- after the assignment.
-</UL>
-<!--TOC section Using the merger-->
-
-<H2 CLASS="section"><A NAME="htoc39">13</A> Using the merger</H2><!--SEC END -->
-<A NAME="sec-merger"></A><!--NAME merger.html-->
-<BR>
-<BR>
-There are many program analyses that are more effective when
-done on the whole program.<BR>
-<BR>
-The merger is a tool that combines all of the C source files in a project
-into a single C file. There are two tasks that a merger must perform:
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
-Detect what are all the sources that make a project and with what
-compiler arguments they are compiled.<BR>
-<BR>
-<LI CLASS="li-enumerate">Merge all of the source files into a single file.
-</OL>
-For the first task the merger impersonates a compiler and a linker (both a
-GCC and a Microsoft Visual C mode are supported) and it expects to be invoked
-(from a build script or a Makefile) on all sources of the project. When
-invoked to compile a source the merger just preprocesses the source and saves
-the result using the name of the requested object file. By preprocessing at
-this time the merger is able to take into account variations in the command
-line arguments that affect preprocessing of different source files.<BR>
-<BR>
-When the merger is invoked to link a number of object files it collects the
-preprocessed sources that were stored with the names of the object files, and
-invokes the merger proper. Note that arguments that affect the compilation or
-linking must be the same for all source files.<BR>
-<BR>
-For the second task, the merger essentially concatenates the preprocessed
-sources with care to rename conflicting file-local declarations (we call this
-process alpha-conversion of a file). The merger also attempts to remove
-duplicate global declarations and definitions. Specifically the following
-actions are taken:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-File-scope names (<TT>static</TT> globals, names of types defined with
-<TT>typedef</TT>, and structure/union/enumeration tags) are given new names if they
-conflict with declarations from previously processed sources. The new name is
-formed by appending the suffix <TT>___n</TT>, where <TT>n</TT> is a unique integer
-identifier. Then the new names are applied to their occurrences in the file. <BR>
-<BR>
-<LI CLASS="li-itemize">Non-static declarations and definitions of globals are never renamed.
-But we try to remove duplicate ones. Equality of globals is detected by
-comparing the printed form of the global (ignoring the line number directives)
-after the body has been alpha-converted. This process is intended to remove
-those declarations (e.g. function prototypes) that originate from the same
-include file. Similarly, we try to eliminate duplicate definitions of
-<TT>inline</TT> functions, since these occasionally appear in include files.<BR>
-<BR>
-<LI CLASS="li-itemize">The types of all global declarations with the same name from all files
-are compared for type isomorphism. During this process, the merger detects all
-those isomorphisms between structures and type definitions that are <B>required</B> for the merged program to be legal. Such structure tags and
-typenames are coalesced and given the same name. <BR>
-<BR>
-<LI CLASS="li-itemize">Besides the structure tags and type names that are required to be
-isomorphic, the merger also tries to coalesce definitions of structures and
-types with the same name from different file. However, in this case the merger
-will not give an error if such definitions are not isomorphic; it will just
-use different names for them. <BR>
-<BR>
-<LI CLASS="li-itemize">In rare situations, it can happen that a file-local global in
-encountered first and it is not renamed, only to discover later when
-processing another file that there is an external symbol with the same name.
-In this case, a second pass is made over the merged file to rename the
-file-local symbol.
-</UL>
-Here is an example of using the merger:<BR>
-<BR>
-The contents of <TT>file1.c</TT> is:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-struct foo; // Forward declaration
-extern struct foo *global;
-</FONT></PRE>
-The contents of <TT>file2.c</TT> is:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-struct bar {
- int x;
- struct bar *next;
-};
-extern struct bar *global;
-struct foo {
- int y;
-};
-extern struct foo another;
-void main() {
-}
-</FONT></PRE>
-There are several ways in which one might create an executable from these
-files:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<PRE CLASS="verbatim">
-gcc file1.c file2.c -o a.out
-</PRE><BR>
-<BR>
-<LI CLASS="li-itemize"><PRE CLASS="verbatim">
-gcc -c file1.c -o file1.o
-gcc -c file2.c -o file2.o
-ld file1.o file2.o -o a.out
-</PRE><BR>
-<BR>
-<LI CLASS="li-itemize"><PRE CLASS="verbatim">
-gcc -c file1.c -o file1.o
-gcc -c file2.c -o file2.o
-ar r libfile2.a file2.o
-gcc file1.o libfile2.a -o a.out
-</PRE><BR>
-<BR>
-<LI CLASS="li-itemize"><PRE CLASS="verbatim">
-gcc -c file1.c -o file1.o
-gcc -c file2.c -o file2.o
-ar r libfile2.a file2.o
-gcc file1.o -lfile2 -o a.out
-</PRE></UL>
-In each of the cases above you must replace all occurrences of <TT>gcc</TT> and
-<TT>ld</TT> with <TT>cilly --merge</TT>, and all occurrences of <TT>ar</TT> with <TT>cilly
---merge --mode=AR</TT>. It is very important that the <TT>--merge</TT> flag be used
-throughout the build process. If you want to see the merged source file you
-must also pass the <TT>--keepmerged</TT> flag to the linking phase. <BR>
-<BR>
-The result of merging file1.c and file2.c is:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-// from file1.c
-struct foo; // Forward declaration
-extern struct foo *global;
-
-// from file2.c
-struct foo {
- int x;
- struct foo *next;
-};
-struct foo___1 {
- int y;
-};
-extern struct foo___1 another;
-</FONT></PRE>
-<!--TOC section Using the patcher-->
-
-<H2 CLASS="section"><A NAME="htoc40">14</A> Using the patcher</H2><!--SEC END -->
-<A NAME="sec-patcher"></A><!--NAME patcher.html-->
-<BR>
-<BR>
-Occasionally we have needed to modify slightly the standard include files.
-So, we developed a simple mechanism that allows us to create modified copies
-of the include files and use them instead of the standard ones. For this
-purpose we specify a patch file and we run a program caller Patcher which
-makes modified copies of include files and applies the patch.<BR>
-<BR>
-The patcher is invoked as follows:
-<PRE CLASS="verbatim">
-bin/patcher [options]
-
-Options:
- --help Prints this help message
- --verbose Prints a lot of information about what is being done
- --mode=xxx What tool to emulate:
- GNUCC - GNU CC
- MSVC - MS VC cl compiler
-
- --dest=xxx The destination directory. Will make one if it does not exist
- --patch=xxx Patch file (can be specified multiple times)
- --ppargs=xxx An argument to be passed to the preprocessor (can be specified
- multiple times)
-
- --ufile=xxx A user-include file to be patched (treated as \#include "xxx")
- --sfile=xxx A system-include file to be patched (treated as \#include <xxx>)
-
- --clean Remove all files in the destination directory
- --dumpversion Print the version name used for the current compiler
-
- All of the other arguments are passed to the preprocessor. You should pass
- enough arguments (e.g., include directories) so that the patcher can find the
- right include files to be patched.
-</PRE>
- Based on the given <TT>mode</TT> and the current version of the compiler (which
-the patcher can print when given the <TT>dumpversion</TT> argument) the patcher
-will create a subdirectory of the <TT>dest</TT> directory (say <TT>/usr/home/necula/cil/include</TT>), such as:
-<PRE CLASS="verbatim">
-/usr/home/necula/cil/include/gcc_2.95.3-5
-</PRE>
- In that file the patcher will copy the modified versions of the include files
-specified with the <TT>ufile</TT> and <TT>sfile</TT> options. Each of these options can
-be specified multiple times. <BR>
-<BR>
-The patch file (specified with the <TT>patch</TT> option) has a format inspired by
-the Unix <TT>patch</TT> tool. The file has the following grammar:
-<PRE CLASS="verbatim">
-<<< flags
-patterns
-===
-replacement
->>>
-</PRE>
- The flags are a comma separated, case-sensitive, sequence of keywords or
-keyword = value. The following flags are supported:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>file=foo.h</TT> - will only apply the patch on files whose name is
- <TT>foo.h</TT>.
-<LI CLASS="li-itemize"><TT>optional</TT> - this means that it is Ok if the current patch does not
-match any of the processed files.
-<LI CLASS="li-itemize"><TT>group=foo</TT> - will add this patch to the named group. If this is not
-specified then a unique group is created to contain just the current patch.
-When all files specified in the command line have been patched, an error
-message is generated for all groups for whom no member patch was used. We use
-this mechanism to receive notice when the patch triggers are out-dated with
-respect to the new include files.
-<LI CLASS="li-itemize"><TT>system=sysname</TT> - will only consider this pattern on a given
-operating system. The “sysname” is reported by the “$Ô” variable in
-Perl, except that Windows is always considered to have sysname
-“cygwin.” For Linux use “linux” (capitalization matters).
-<LI CLASS="li-itemize"><TT>ateof</TT> - In this case the patterns are ignored and the replacement
-text is placed at the end of the patched file. Use the <TT>file</TT> flag if you
-want to restrict the files in which this replacement is performed.
-<LI CLASS="li-itemize"><TT>atsof</TT> - The patterns are ignored and the replacement text is placed
-at the start of the patched file. Uf the <TT>file</TT> flag to restrict the
-application of this patch to a certain file.
-<LI CLASS="li-itemize"><TT>disabled</TT> - Use this flag if you want to disable the pattern.
-</UL>
-The patterns can consist of several groups of lines separated by the <TT>|||</TT>
-marker. Each of these group of lines is a multi-line pattern that if found in
-the file will be replaced with the text given at the end of the block. <BR>
-<BR>
-The matching is space-insensitive.<BR>
-<BR>
-All of the markers <TT><<<</TT>, <TT>|||</TT>, <TT>===</TT> and <TT>>>></TT> must appear at the
-beginning of a line but they can be followed by arbitrary text (which is
-ignored).<BR>
-<BR>
-The replacement text can contain the special keyword <TT>@__pattern__@</TT>,
-which is substituted with the pattern that matched. <BR>
-<BR>
-<!--TOC section Debugging support-->
-
-<H2 CLASS="section"><A NAME="htoc41">15</A> Debugging support</H2><!--SEC END -->
-<A NAME="sec-debugger"></A>
-Most of the time we debug our code using the Errormsg module along with the
-pretty printer. But if you want to use the Ocaml debugger here is an easy way
-to do it. Say that you want to debug the invocation of cilly that arises out
-of the following command:
-<PRE CLASS="verbatim">
-cilly -c hello.c
-</PRE>
- You must follow the installation <A HREF="../ccured/setup.html">instructions</A>
-to install the Elist support files for ocaml and to extend your .emacs
-appropriately. Then from within Emacs you do
-<PRE CLASS="verbatim">
-ALT-X my-camldebug
-</PRE>
- This will ask you for the command to use for running the Ocaml debugger
-(initially the default will be “ocamldebug” or the last command you
-introduced). You use the following command:
-<PRE CLASS="verbatim">
-cilly --ocamldebug -c hello.c
-</PRE>
- This will run <TT>cilly</TT> as usual and invoke the Ocaml debugger when the cilly
-engine starts. The advantage of this way of invoking the debugger is that the
-directory search paths are set automatically and the right set or arguments is
-passed to the debugger. <BR>
-<BR>
-<!--TOC section Who Says C is Simple?-->
-
-<H2 CLASS="section"><A NAME="htoc42">16</A> Who Says C is Simple?</H2><!--SEC END -->
-<A NAME="sec-simplec"></A>
-When I (George) started to write CIL I thought it was going to take two weeks.
-Exactly a year has passed since then and I am still fixing bugs in it. This
-gross underestimate was due to the fact that I thought parsing and making
-sense of C is simple. You probably think the same. What I did not expect was
-how many dark corners this language has, especially if you want to parse
-real-world programs such as those written for GCC or if you are more ambitious
-and you want to parse the Linux or Windows NT sources (both of these were
-written without any respect for the standard and with the expectation that
-compilers will be changed to accommodate the program). <BR>
-<BR>
-The following examples were actually encountered either in real programs or
-are taken from the ISO C99 standard or from the GCC's testcases. My first
-reaction when I saw these was: <EM>Is this C?</EM>. The second one was : <EM>What the hell does it mean?</EM>. <BR>
-<BR>
-If you are contemplating doing program analysis for C on abstract-syntax
-trees then your analysis ought to be able to handle these things. Or, you can
-use CIL and let CIL translate them into clean C code. <BR>
-<BR>
-<!--TOC subsection Standard C-->
-
-<H3 CLASS="subsection"><A NAME="htoc43">16.1</A> Standard C</H3><!--SEC END -->
-
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">Why does the following code return 0 for most values of <TT>x</TT>? (This
-should be easy.)
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x;
- return x == (1 && x);
-</FONT></PRE>
-See the <A HREF="examples/ex30.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Why does the following code return 0 and not -1? (Answer: because
-<TT>sizeof</TT> is unsigned, thus the result of the subtraction is unsigned, thus
-the shift is logical.)
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- return ((1 - sizeof(int)) >> 32);
-</FONT></PRE>
-See the <A HREF="examples/ex31.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Scoping rules can be tricky. This function returns 5.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-int x = 5;
-int f() {
- int x = 3;
- {
- extern int x;
- return x;
- }
-}
-</FONT></PRE>
-See the <A HREF="examples/ex32.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Functions and function pointers are implicitly converted to each other.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-int (*pf)(void);
-int f(void) {
-
- pf = &f; // This looks ok
- pf = ***f; // Dereference a function?
- pf(); // Invoke a function pointer?
- (****pf)(); // Looks strange but Ok
- (***************f)(); // Also Ok
-}
-</FONT></PRE>
-See the <A HREF="examples/ex33.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Initializer with designators are one of the hardest parts about ISO C.
-Neither MSVC or GCC implement them fully. GCC comes close though. What is the
-final value of <TT>i.nested.y</TT> and <TT>i.nested.z</TT>? (Answer: 2 and respectively
-6).
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-struct {
- int x;
- struct {
- int y, z;
- } nested;
-} i = { .nested.y = 5, 6, .x = 1, 2 };
-</FONT></PRE>
-See the <A HREF="examples/ex34.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">This is from c-torture. This function returns 1.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-typedef struct
-{
- char *key;
- char *value;
-} T1;
-
-typedef struct
-{
- long type;
- char *value;
-} T3;
-
-T1 a[] =
-{
- {
- "",
- ((char *)&((T3) {1, (char *) 1}))
- }
-};
-int main() {
- T3 *pt3 = (T3*)a[0].value;
- return pt3->value;
-}
-</FONT></PRE>
-See the <A HREF="examples/ex35.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Another one with constructed literals. This one is legal according to
-the GCC documentation but somehow GCC chokes on (it works in CIL though). This
-code returns 2.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- return ((int []){1,2,3,4})[1];
-</FONT></PRE>
-See the <A HREF="examples/ex36.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">In the example below there is one copy of “bar” and two copies of
- “pbar” (static prototypes at block scope have file scope, while for all
- other types they have block scope).
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int foo() {
- static bar();
- static (*pbar)() = bar;
-
- }
-
- static bar() {
- return 1;
- }
-
- static (*pbar)() = 0;
-</FONT></PRE>
-See the <A HREF="examples/ex37.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Two years after heavy use of CIL, by us and others, I discovered a bug
- in the parser. The return value of the following function depends on what
- precedence you give to casts and unary minus:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- unsigned long foo() {
- return (unsigned long) - 1 / 8;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex38.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-The correct interpretation is <TT>((unsigned long) - 1) / 8</TT>, which is a
- relatively large number, as opposed to <TT>(unsigned long) (- 1 / 8)</TT>, which
- is 0. </OL>
-<!--TOC subsection GCC ugliness-->
-
-<H3 CLASS="subsection"><A NAME="htoc44">16.2</A> GCC ugliness</H3><!--SEC END -->
-<A NAME="sec-ugly-gcc"></A>
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">GCC has generalized lvalues. You can take the address of a lot of
-strange things:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x, y, z;
- return &(x ? y : z) - & (x++, x);
-</FONT></PRE>
-See the <A HREF="examples/ex39.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">GCC lets you omit the second component of a conditional expression.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- extern int f();
- return f() ? : -1; // Returns the result of f unless it is 0
-</FONT></PRE>
-See the <A HREF="examples/ex40.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Computed jumps can be tricky. CIL compiles them away in a fairly clean
-way but you are on your own if you try to jump into another function this way.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-static void *jtab[2]; // A jump table
-static int doit(int x){
-
- static int jtab_init = 0;
- if(!jtab_init) { // Initialize the jump table
- jtab[0] = &&lbl1;
- jtab[1] = &&lbl2;
- jtab_init = 1;
- }
- goto *jtab[x]; // Jump through the table
-lbl1:
- return 0;
-lbl2:
- return 1;
-}
-
-int main(void){
- if (doit(0) != 0) exit(1);
- if (doit(1) != 1) exit(1);
- exit(0);
-}
-</FONT></PRE>
-See the <A HREF="examples/ex41.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">A cute little example that we made up. What is the returned value?
-(Answer: 1);
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- return ({goto L; 0;}) && ({L: 5;});
-</FONT></PRE>
-See the <A HREF="examples/ex42.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate"><TT>extern inline</TT> is a strange feature of GNU C. Can you guess what the
-following code computes?
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-extern inline foo(void) { return 1; }
-int firstuse(void) { return foo(); }
-
-// A second, incompatible definition of foo
-int foo(void) { return 2; }
-
-int main() {
- return foo() + firstuse();
-}
-</FONT></PRE>
-See the <A HREF="examples/ex43.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-The answer depends on whether the optimizations are turned on. If they are
-then the answer is 3 (the first definition is inlined at all occurrences until
-the second definition). If the optimizations are off, then the first
-definition is ignore (treated like a prototype) and the answer is 4. <BR>
-<BR>
-CIL will misbehave on this example, if the optimizations are turned off (it
- always returns 3).<BR>
-<BR>
-<LI CLASS="li-enumerate">GCC allows you to cast an object of a type T into a union as long as the
-union has a field of that type:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-union u {
- int i;
- struct s {
- int i1, i2;
- } s;
-};
-
-union u x = (union u)6;
-
-int main() {
- struct s y = {1, 2};
- union u z = (union u)y;
-}
-</FONT></PRE>
-See the <A HREF="examples/ex44.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">GCC allows you to use the <TT>__mode__</TT> attribute to specify the size
-of the integer instead of the standard <TT>char</TT>, <TT>short</TT> and so on:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-int __attribute__ ((__mode__ ( __QI__ ))) i8;
-int __attribute__ ((__mode__ ( __HI__ ))) i16;
-int __attribute__ ((__mode__ ( __SI__ ))) i32;
-int __attribute__ ((__mode__ ( __DI__ ))) i64;
-</FONT></PRE>
-See the <A HREF="examples/ex45.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">The “alias” attribute on a function declaration tells the
- linker to treat this declaration as another name for the specified
- function. CIL will replace the declaration with a trampoline
- function pointing to the specified target.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- static int bar(int x, char y) {
- return x + y;
- }
-
- //foo is considered another name for bar.
- int foo(int x, char y) __attribute__((alias("bar")));
-</FONT></PRE>
-See the <A HREF="examples/ex46.txt">CIL output</A> for this
-code fragment</OL>
-<!--TOC subsection Microsoft VC ugliness-->
-
-<H3 CLASS="subsection"><A NAME="htoc45">16.3</A> Microsoft VC ugliness</H3><!--SEC END -->
-
-This compiler has few extensions, so there is not much to say here.
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
-Why does the following code return 0 and not -1? (Answer: because of a
-bug in Microsoft Visual C. It thinks that the shift is unsigned just because
-the second operator is unsigned. CIL reproduces this bug when in MSVC mode.)
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- return -3 >> (8 * sizeof(int));
-</FONT></PRE><BR>
-<BR>
-<LI CLASS="li-enumerate">Unnamed fields in a structure seem really strange at first. It seems
-that Microsoft Visual C introduced this extension, then GCC picked it up (but
-in the process implemented it wrongly: in GCC the field <TT>y</TT> overlaps with
-<TT>x</TT>!).
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-struct {
- int x;
- struct {
- int y, z;
- struct {
- int u, v;
- };
- };
-} a;
-return a.x + a.y + a.z + a.u + a.v;
-</FONT></PRE>
-See the <A HREF="examples/ex47.txt">CIL output</A> for this
-code fragment</OL>
-<!--TOC section Authors-->
-
-<H2 CLASS="section"><A NAME="htoc46">17</A> Authors</H2><!--SEC END -->
-
-The CIL parser was developed starting from Hugues Casse's <TT>frontc</TT>
-front-end for C although all the files from the <TT>frontc</TT> distribution have
-been changed very extensively. The intermediate language and the elaboration
-stage are all written from scratch. The main author is
-<A HREF="mailto:necula@cs.berkeley.edu">George Necula</A>, with significant
-contributions from <A HREF="mailto:smcpeak@cs.berkeley.edu">Scott McPeak</A>,
-<A HREF="mailto:weimer@cs.berkeley.edu">Westley Weimer</A>,
-<A HREF="mailto:liblit@cs.wisc.edu">Ben Liblit</A>,
-<A HREF="javascript:loadTop('http://www.cs.berkeley.edu/~matth/')">Matt Harren</A>,
-Raymond To and Aman Bhargava.<BR>
-<BR>
-This work is based upon work supported in part by the National Science
-Foundation under Grants No. 9875171, 0085949 and 0081588, and gifts from
-Microsoft Research. Any opinions, findings, and conclusions or recommendations
-expressed in this material are those of the author(s) and do not necessarily
-reflect the views of the National Science Foundation or the other sponsors.<BR>
-<BR>
-<!--TOC section License-->
-
-<H2 CLASS="section"><A NAME="htoc47">18</A> License</H2><!--SEC END -->
-
-Copyright (c) 2001-2005,
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-George C. Necula <necula@cs.berkeley.edu>
-<LI CLASS="li-itemize">Scott McPeak <smcpeak@cs.berkeley.edu>
-<LI CLASS="li-itemize">Wes Weimer <weimer@cs.berkeley.edu>
-<LI CLASS="li-itemize">Ben Liblit <liblit@cs.wisc.edu>
-</UL>
-All rights reserved.<BR>
-<BR>
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:<BR>
-<BR>
-1. Redistributions of source code must retain the above copyright notice,
-this list of conditions and the following disclaimer.<BR>
-<BR>
-2. Redistributions in binary form must reproduce the above copyright notice,
-this list of conditions and the following disclaimer in the documentation
-and/or other materials provided with the distribution.<BR>
-<BR>
-3. The names of the contributors may not be used to endorse or promote
-products derived from this software without specific prior written
-permission.<BR>
-<BR>
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
-LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGE.<BR>
-<BR>
-<!--TOC section Bug reports-->
-
-<H2 CLASS="section"><A NAME="htoc48">19</A> Bug reports</H2><!--SEC END -->
-
-We are certain that there are still some remaining bugs in CIL. If you find
-one please file a bug report in our Source Forge space
-<A HREF="javascript:loadTop('http://sourceforge.net/projects/cil')">http://sourceforge.net/projects/cil</A>. <BR>
-<BR>
-You can find there the latest announcements, a source distribution,
-bug report submission instructions and a mailing list: cil-users[at
-sign]lists.sourceforge.net. Please use this list to ask questions about CIL,
-as it will ensure your message is viewed by a broad audience. <BR>
-<BR>
-<!--TOC section Changes-->
-
-<H2 CLASS="section"><A NAME="htoc49">20</A> Changes</H2><!--SEC END -->
-<A NAME="sec-changes"></A><!--NAME changes.html-->
-
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<B>May 20, 2006</B>: <B>Released version 1.3.5</B>
-<LI CLASS="li-itemize"><B>May 19, 2006</B>: <TT>Makefile.cil.in</TT>/<TT>Makefile.cil</TT> have
- been renamed <TT>Makefile.in</TT>/<TT>Makefile</TT>. And <TT>maincil.ml</TT> has
- been renamed <TT>main.ml</TT>.
-<LI CLASS="li-itemize"><B>May 18, 2006</B>: Added a new module <A HREF="api/Cfg.html">Cfg</A> to compute the
- control-flow graph. Unlike the older <A HREF="api/Cil.html#VALcomputeCFGInfo">Cil.computeCFGInfo</A>,
- the new version does not modify the code.
-<LI CLASS="li-itemize"><B>May 18, 2006</B>: Added several new analyses: reaching
- definitions, available expressions, liveness analysis, and dead code
- elimination. See Section <A HREF="#sec-Extension">8</A>.
-<LI CLASS="li-itemize"><B>May 2, 2006</B>: Added a flag <TT>--noInsertImplicitCasts</TT>.
- When this flag is used, CIL code will only include casts inserted by
- the programmer. Implicit coercions are not changed to explicit casts.
-<LI CLASS="li-itemize"><B>April 16, 2006</B>: Minor improvements to the <TT>--stats</TT>
- flag (Section <A HREF="#sec-cilly-asm-options">7.2</A>). We now use Pentium performance
- counters by default, if your processor supports them.
-<LI CLASS="li-itemize"><B>April 10, 2006</B>: Extended <TT>machdep.c</TT> to support
- microcontroller compilers where the struct alignment of integer
- types does not match the size of the type. Thanks to Nathan
- Cooprider for the patch.
-<LI CLASS="li-itemize"><B>April 6, 2006</B>: Fix for global initializers of unions when
- the union field being initialized is not the first one, and for
- missing initializers of unions when the first field is not the
- largest field.
-<LI CLASS="li-itemize"><B>April 6, 2006</B>: Fix for bitfields in the SFI module.
-<LI CLASS="li-itemize"><B>April 6, 2006</B>: Various fixes for gcc attributes.
- <TT>packed</TT>, <TT>section</TT>, and <TT>always_inline</TT> attributes are now
- parsed correctly. Also fixed printing of attributes on enum types.
-<LI CLASS="li-itemize"><B>March 30, 2006</B>: Fix for <TT>rmtemps.ml</TT>, which deletes
- unused inline functions. When in <TT>gcc</TT> mode CIL now leaves all
- inline functions in place, since <TT>gcc</TT> treats these as externally
- visible.
-<LI CLASS="li-itemize"><B>March 15, 2006</B>: Fix for <TT>typeof(<I>e</I>)</TT> when <I>e</I> has type
- <TT>void</TT>.
-<LI CLASS="li-itemize"><B>March 3, 2006</B>: Assume inline assembly instructions can
- fall through for the purposes of adding return statements. Thanks to
- Nathan Cooprider for the patch.
-<LI CLASS="li-itemize"><B>February 27, 2006</B>: Fix for extern inline functions when
- the output of CIL is fed back into CIL.
-<LI CLASS="li-itemize"><B>January 30, 2006</B>: Fix parsing of <TT>switch</TT> without braces.
-<LI CLASS="li-itemize"><B>January 30, 2006</B>: Allow `$' to appear in identifiers.
-<LI CLASS="li-itemize"><B>January 13, 2006</B>: Added support for gcc's alias attribute
- on functions. See Section <A HREF="#sec-ugly-gcc">16.2</A>, item 8.
-<LI CLASS="li-itemize"><B>December 9, 2005</B>: Christoph Spiel fixed the Golf and
- Olf modules so that Golf can be used with the points-to analysis.
- He also added performance fixes and cleaned up the documentation.
-<LI CLASS="li-itemize"><B>December 1, 2005</B>: Major rewrite of the ext/callgraph module.
-<LI CLASS="li-itemize"><B>December 1, 2005</B>: Preserve enumeration constants in CIL. Default
-is the old behavior to replace them with integers.
-<LI CLASS="li-itemize"><B>November 30, 2005</B>: Added support for many GCC <TT>__builtin</TT>
- functions.
-<LI CLASS="li-itemize"><B>November 30, 2005</B>: Added the EXTRAFEATURES configure
- option, making it easier to add Features to the build process.
-<LI CLASS="li-itemize"><B>November 23, 2005</B>: In MSVC mode do not remove any locals whose name
- appears as a substring in an inline assembly.
-<LI CLASS="li-itemize"><B>November 23, 2005</B>: Do not add a return to functions that have the
- noreturn attribute.
-<LI CLASS="li-itemize"><B>November 22, 2005</B>: <B>Released version 1.3.4</B>
-<LI CLASS="li-itemize"><B>November 21, 2005</B>: Performance and correctness fixes for
- the Points-to Analysis module. Thanks to Christoph Spiel for the
- patches.
-<LI CLASS="li-itemize"><B>October 5, 2005</B>: CIL now builds on SPARC/Solaris. Thanks
- to Nick Petroni and Remco van Engelen for the patches.
-<LI CLASS="li-itemize"><B>September 26, 2005</B>: CIL no longer uses the `<TT>-I-</TT>' flag
- by default when preprocessing with gcc.
-<LI CLASS="li-itemize"><B>August 24, 2005</B>: Added a command-line option
- “--forceRLArgEval” that forces function arguments to be evaluated
- right-to-left. This is the default behavior in unoptimized gcc and
- MSVC, but the order of evaluation is undefined when using
- optimizations, unless you apply this CIL transformation. This flag
- does not affect the order of evaluation of e.g. binary operators,
- which remains undefined. Thanks to Nathan Cooprider for the patch.
-<LI CLASS="li-itemize"><B>August 9, 2005</B>: Fixed merging when there are more than 20
- input files.
-<LI CLASS="li-itemize"><B>August 3, 2005</B>: When merging, it is now an error to
- declare the same global variable twice with different initializers.
-<LI CLASS="li-itemize"><B>July 27, 2005</B>: Fixed bug in transparent unions.
-<LI CLASS="li-itemize"><B>July 27, 2005</B>: Fixed bug in collectInitializer. Thanks to
- Benjamin Monate for the patch.
-<LI CLASS="li-itemize"><B>July 26, 2005</B>: Better support for extended inline assembly
- in gcc.
-<LI CLASS="li-itemize"><B>July 26, 2005</B>: Added many more gcc __builtin* functions
- to CIL. Most are treated as Call instructions, but a few are
- translated into expressions so that they can be used in global
- initializers. For example, “<TT>__builtin_offsetof(t, field)</TT>” is
- rewritten as “<TT>&((t*)0)->field</TT>”, the traditional way of calculating
- an offset.
-<LI CLASS="li-itemize"><B>July 18, 2005</B>: Fixed bug in the constant folding of shifts
- when the second argument was negative or too large.
-<LI CLASS="li-itemize"><B>July 18, 2005</B>: Fixed bug where casts were not always
- inserted in function calls.
-<LI CLASS="li-itemize"><B>June 10, 2005</B>: Fixed bug in the code that makes implicit
- returns explicit. We weren't handling switch blocks correctly.
-<LI CLASS="li-itemize"><B>June 1, 2005</B>: <B>Released version 1.3.3</B>
-<LI CLASS="li-itemize"><B>May 31, 2005</B>: Fixed handling of noreturn attribute for function
- pointers.
-<LI CLASS="li-itemize"><B>May 30, 2005</B>: Fixed bugs in the handling of constructors in gcc.
-<LI CLASS="li-itemize"><B>May 30, 2005</B>: Fixed bugs in the generation of global variable IDs.
-<LI CLASS="li-itemize"><B>May 27, 2005</B>: Reimplemented the translation of function calls so
- that we can intercept some builtins. This is important for the uses of
- __builtin_constant_p in constants.
-<LI CLASS="li-itemize"><B>May 27, 2005</B>: Export the plainCilPrinter, for debugging.
-<LI CLASS="li-itemize"><B>May 27, 2005</B>: Fixed bug with printing of const attribute for
- arrays.
-<LI CLASS="li-itemize"><B>May 27, 2005</B>: Fixed bug in generation of type signatures. Now they
- should not contain expressions anymore, so you can use structural equality.
- This used to lead to Out_of_Memory exceptions.
-<LI CLASS="li-itemize"><B>May 27, 2005</B>: Fixed bug in type comparisons using
- TBuiltin_va_list.
-<LI CLASS="li-itemize"><B>May 27, 2005</B>: Improved the constant folding in array lengths and
- case expressions.
-<LI CLASS="li-itemize"><B>May 27, 2005</B>: Added the <TT>__builtin_frame_address</TT> to the set
- of gcc builtins.
-<LI CLASS="li-itemize"><B>May 27, 2005</B>: Added the CIL project to SourceForge.
-<LI CLASS="li-itemize"><B>April 23, 2005</B>: The cattr field was not visited.
-<LI CLASS="li-itemize"><B>March 6, 2005</B>: Debian packaging support
-<LI CLASS="li-itemize"><B>February 16, 2005</B>: Merger fixes.
-<LI CLASS="li-itemize"><B>February 11, 2005</B>: Fixed a bug in <TT>--dopartial</TT>. Thanks to
-Nathan Cooprider for this fix.
-<LI CLASS="li-itemize"><B>January 31, 2005</B>: Make sure the input file is closed even if a
- parsing error is encountered.
-<LI CLASS="li-itemize"><B>January 11, 2005</B>: <B>Released version 1.3.2</B>
-<LI CLASS="li-itemize"><B>January 11, 2005</B>: Fixed printing of integer constants whose
- integer kind is shorter than an int.
-<LI CLASS="li-itemize"><B>January 11, 2005</B>: Added checks for negative size arrays and arrays
- too big.
-<LI CLASS="li-itemize"><B>January 10, 2005</B>: Added support for GCC attribute “volatile” for
- tunctions (as a synonim for noreturn).
-<LI CLASS="li-itemize"><B>January 10, 2005</B>: Improved the comparison of array sizes when
- comparing array types.
-<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed handling of shell metacharacters in the
- cilly command lione.
-<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed dropping of cast in initialization of
- local variable with the result of a function call.
-<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed some structural comparisons that were
- broken in the Ocaml 3.08.
-<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed the <TT>unrollType</TT> function to not forget
- attributes.
-<LI CLASS="li-itemize"><B>January 10, 2005</B>: Better keeping track of locations of function
- prototypes and definitions.
-<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed bug with the expansion of enumeration
- constants in attributes.
-<LI CLASS="li-itemize"><B>October 18, 2004</B>: Fixed a bug in cabsvisit.ml. CIl would wrap a
- BLOCK around a single atom unnecessarily.
-<LI CLASS="li-itemize"><B>August 7, 2004</B>: <B>Released version 1.3.1</B>
-<LI CLASS="li-itemize"><B>August 4, 2004</B>: Fixed a bug in splitting of structs using
- <TT>--dosimplify</TT>
-<LI CLASS="li-itemize"><B>July 29, 2004</B>: Minor changes to the type typeSig (type signatures)
- to ensure that they do not contain types, so that you can do structural
- comparison without danger of nontermination.
-<LI CLASS="li-itemize"><B>July 28, 2004</B>: Ocaml version 3.08 is required. Numerous small
- changes while porting to Ocaml 3.08.
-<LI CLASS="li-itemize"><B>July 7, 2004</B>: <B>Released version 1.2.6</B>
-<LI CLASS="li-itemize"><B>July 2, 2004</B>: Character constants such as <TT>'c'</TT> should
- have type <TT>int</TT>, not <TT>char</TT>. Added a utility function
- <TT>Cil.charConstToInt</TT> that sign-extends chars greater than 128, if needed.
-<LI CLASS="li-itemize"><B>July 2, 2004</B>: Fixed a bug that was casting values to int
- before applying the logical negation operator !. This caused
- problems for floats, and for integer types bigger than <TT>int</TT>.
-<LI CLASS="li-itemize"><B>June 13, 2004</B>: Added the field <TT>sallstmts</TT> to a function
- description, to hold all statements in the function.
-<LI CLASS="li-itemize"><B>June 13, 2004</B>: Added new extensions for data flow analyses, and
- for computing dominators.
-<LI CLASS="li-itemize"><B>June 10, 2004</B>: Force initialization of CIL at the start of
-Cabs2cil.
-<LI CLASS="li-itemize"><B>June 9, 2004</B>: Added support for GCC <TT>__attribute_used__</TT>
-<LI CLASS="li-itemize"><B>April 7, 2004</B>: <B>Released version 1.2.5</B>
-<LI CLASS="li-itemize"><B>April 7, 2004</B>: Allow now to run ./configure CC=cl and set the MSVC
-compiler to be the default. The MSVC driver will now select the default name
-of the .exe file like the CL compiler.
-<LI CLASS="li-itemize"><B>April 7, 2004</B>: Fixed a bug in the driver. The temporary files are
-deleted by the Perl script before the CL compiler gets to them?
-<LI CLASS="li-itemize"><B>April 7, 2004</B>: Added the - form of arguments to the MSVC driver.
-<LI CLASS="li-itemize"><B>April 7, 2004</B>: Added a few more GCC-specific string escapes, (, [,
-{, %, E.
-<LI CLASS="li-itemize"><B>April 7, 2004</B>: Fixed bug with continuation lines in MSVC.
-<LI CLASS="li-itemize"><B>April 6, 2004</B>: Fixed embarassing bug in the parser: the precedence
- of casts and unary operators was switched.
-<LI CLASS="li-itemize"><B>April 5, 2004</B>: Fixed a bug involving statements mixed between
-declarations containing initializers. Now we make sure that the initializers
-are run in the proper order with respect to the statements.
-<LI CLASS="li-itemize"><B>April 5, 2004</B>: Fixed a bug in the merger. The merger was keeping
-separate alpha renaming talbes (namespaces) for variables and types. This
-means that it might end up with a type and a variable named the same way, if
-they come from different files, which breaks an important CIL invariant.
-<LI CLASS="li-itemize"><B>March 11, 2004</B> : Fixed a bug in the Cil.copyFunction function. The
-new local variables were not getting fresh IDs.
-<LI CLASS="li-itemize"><B>March 5, 2004</B>: Fixed a bug in the handling of static function
- prototypes in a block scope. They used to be renamed. Now we just consider
- them global.
-<LI CLASS="li-itemize"><B>February 20, 2004</B>: <B>Released version 1.2.4</B>
-<LI CLASS="li-itemize"><B>February 15, 2004</B>: Changed the parser to allow extra semicolons
- after field declarations.
-<LI CLASS="li-itemize"><B>February 14, 2004</B>: Changed the Errormsg functions: error, unimp,
-bug to not raise an exception. Instead they just set Errormsg.hadErrors.
-<LI CLASS="li-itemize"><B>February 13, 2004</B>: Change the parsing of attributes to recognize
- enumeration constants.
-<LI CLASS="li-itemize"><B>February 10, 2004</B>: In some versions of <TT>gcc</TT> the identifier
- _{thread is an identifier and in others it is a keyword. Added code
- during configuration to detect which is the case.
-<LI CLASS="li-itemize"><B>January 7, 2004</B>: <B>Released version 1.2.3</B>
-<LI CLASS="li-itemize"><B>January 7, 2004</B>: Changed the alpha renamer to be less
-conservative. It will remember all versions of a name that were seen and will
-only create a new name if we have not seen one.
-<LI CLASS="li-itemize"><B>December 30, 2003</B> : Extended the <TT>cilly</TT> command to understand
- better linker command options <TT>-lfoo</TT>.
-<LI CLASS="li-itemize"><B>December 5, 2003</B>: Added markup commands to the pretty-printer
-module. Also, changed the “@<” left-flush command into “@''.
-<LI CLASS="li-itemize"><B>December 4, 2003</B>: Wide string literals are now handled
-directly by Cil (rather than being exploded into arrays). This is
-apparently handy for Microsoft Device Driver APIs that use intrinsic
-functions that require literal constant wide-string arguments.
-<LI CLASS="li-itemize"><B>December 3, 2003</B>: Added support for structured exception handling
- extensions for the Microsoft compilers.
-<LI CLASS="li-itemize"><B>December 1, 2003</B>: Fixed a Makefile bug in the generation of the
-Cil library (e.g., <TT>cil.cma</TT>) that was causing it to be unusable. Thanks
-to KEvin Millikin for pointing out this bug.
-<LI CLASS="li-itemize"><B>November 26, 2003</B>: Added support for linkage specifications
- (extern “C”).
-<LI CLASS="li-itemize"><B>November 26, 2003</B>: Added the ocamlutil directory to contain some
-utilities shared with other projects.
-<LI CLASS="li-itemize"><B>November 25, 2003</B>: <B>Released version 1.2.2</B>
-<LI CLASS="li-itemize"><B>November 24, 2003</B>: Fixed a bug that allowed a static local to
- conflict with a global with the same name that is declared later in the
- file.
-<LI CLASS="li-itemize"><B>November 24, 2003</B>: Removed the <TT>--keep</TT> option of the <TT>cilly</TT>
- driver and replaced it with <TT>--save-temps</TT>.
-<LI CLASS="li-itemize"><B>November 24, 2003</B>: Added printing of what CIL features are being
- run.
-<LI CLASS="li-itemize"><B>November 24, 2003</B>: Fixed a bug that resulted in attributes being
- dropped for integer types.
-<LI CLASS="li-itemize"><B>November 11, 2003</B>: Fixed a bug in the visitor for enumeration
- definitions.
-<LI CLASS="li-itemize"><B>October 24, 2003</B>: Fixed a problem in the configuration script. It
- was not recognizing the Ocaml version number for beta versions.
-<LI CLASS="li-itemize"><B>October 15, 2003</B>: Fixed a problem in version 1.2.1 that was
- preventing compilation on OCaml 3.04.
-<LI CLASS="li-itemize"><B>September 17, 2003: Released version 1.2.1.</B>
-<LI CLASS="li-itemize"><B>September 7, 2003</B>: Redesigned the interface for choosing
- <TT>#line</TT> directive printing styles. Cil.printLn and
- Cil.printLnComment have been merged into Cil.lineDirectiveStyle.
-<LI CLASS="li-itemize"><B>August 8, 2003</B>: Do not silently pad out functions calls with
-arguments to match the prototype.
-<LI CLASS="li-itemize"><B>August 1, 2003</B>: A variety of fixes suggested by Steve Chamberlain:
-initializers for externs, prohibit float literals in enum, initializers for
-unsized arrays were not working always, an overflow problem in Ocaml, changed
-the processing of attributes before struct specifiers<BR>
-<BR>
-<LI CLASS="li-itemize"><B>July 14, 2003</B>: Add basic support for GCC's "__thread" storage
-qualifier. If given, it will appear as a "thread" attribute at the top of the
-type of the declared object. Treatment is very similar to "__declspec(...)"
-in MSVC<BR>
-<BR>
-<LI CLASS="li-itemize"><B>July 8, 2003</B>: Fixed some of the __alignof computations. Fixed
- bug in the designated initializers for arrays (Array.get error).
-<LI CLASS="li-itemize"><B>July 8, 2003</B>: Fixed infinite loop bug (Stack Overflow) in the
- visitor for __alignof.
-<LI CLASS="li-itemize"><B>July 8, 2003</B>: Fixed bug in the conversion to CIL. A function or
- array argument of
- the GCC __typeof() was being converted to pointer type. Instead, it should
- be left alone, just like for sizeof.
-<LI CLASS="li-itemize"><B>July 7, 2003</B>: New Escape module provides utility functions
- for escaping characters and strings in accordance with C lexical
- rules.<BR>
-<BR>
-<LI CLASS="li-itemize"><B>July 2, 2003</B>: Relax CIL's rules for when two enumeration types are
-considered compatible. Previously CIL considered two enums to be compatible if
-they were the same enum. Now we follow the C99 standard.<BR>
-<BR>
-<LI CLASS="li-itemize"><B>June 28, 2003</B>: In the Formatparse module, Eric Haugh found and
- fixed a bug in the handling of lvalues of the form “lv->field.more”.<BR>
-<BR>
-<LI CLASS="li-itemize"><B>June 28, 2003</B>: Extended the handling of gcc command lines
-arguments in the Perl scripts. <BR>
-<BR>
-<LI CLASS="li-itemize"><B>June 23, 2003</B>: In Rmtmps module, simplified the API for
- customizing the root set. Clients may supply a predicate that
- returns true for each root global. Modifying various
- “<TT>referenced</TT>” fields directly is no longer supported.<BR>
-<BR>
-<LI CLASS="li-itemize"><B>June 17, 2003</B>: Reimplement internal utility routine
- <TT>Cil.escape_char</TT>. Faster and better. <BR>
-<BR>
-<LI CLASS="li-itemize"><B>June 14, 2003</B>: Implemented support for <TT>__attribute__s</TT>
-appearing between "struct" and the struct tag name (also for unions and
-enums), since gcc supports this as documented in section 4.30 of the gcc
-(2.95.3) manual<BR>
-<BR>
-<LI CLASS="li-itemize"><B>May 30, 2003</B>: Released the regression tests.
-<LI CLASS="li-itemize"><B>May 28, 2003</B>: <B>Released version 1.1.2</B>
-<LI CLASS="li-itemize"><B>May 26, 2003</B>: Add the <TT>simplify</TT> module that compiles CIL
-expressions into simpler expressions, similar to those that appear in a
-3-address intermediate language.
-<LI CLASS="li-itemize"><B>May 26, 2003</B>: Various fixes and improvements to the pointer
-analysis modules.
-<LI CLASS="li-itemize"><B>May 26, 2003</B>: Added optional consistency checking for
-transformations.
-<LI CLASS="li-itemize"><B>May 25, 2003</B>: Added configuration support for big endian machines.
-Now <A HREF="api/Cil.html#VALlittle_endian">Cil.little_endian</A> can be used to test whether the machine is
-little endian or not.
-<LI CLASS="li-itemize"><B>May 22, 2003</B>: Fixed a bug in the handling of inline functions. The
-CIL merger used to turn these functions into “static”, which is incorrect.
-<LI CLASS="li-itemize"><B>May 22, 2003</B>: Expanded the CIL consistency checker to verify
-undesired sharing relationships between data structures.
-<LI CLASS="li-itemize"><B>May 22, 2003</B>: Fixed bug in the <TT>oneret</TT> CIL module: it was
-mishandling certain labeled return statements.
-<LI CLASS="li-itemize"><B>May 5, 2003</B>: <B>Released version 1.0.11</B>
-<LI CLASS="li-itemize"><B>May 5, 2003</B>: OS X (powerpc/darwin) support for CIL. Special
-thanks to Jeff Foster, Andy Begel and Tim Leek.
-<LI CLASS="li-itemize"><B>April 30, 2003</B>: Better description of how to use CIL for your
-analysis.
-<LI CLASS="li-itemize"><B>April 28, 2003</B>: Fixed a bug with <TT>--dooneRet</TT> and
-<TT>--doheapify</TT>. Thanks, Manos Renieris.
-<LI CLASS="li-itemize"><B>April 16, 2003</B>: Reworked management of
- temporary/intermediate output files in Perl driver scripts. Default
- behavior is now to remove all such files. To keep intermediate
- files, use one of the following existing flags:
- <UL CLASS="itemize"><LI CLASS="li-itemize">
- <TT>--keepmerged</TT> for the single-file merge of all sources
- <LI CLASS="li-itemize"><TT>--keep=<<I>dir</I></TT><TT>></TT> for various other CIL and
- CCured output files
- <LI CLASS="li-itemize"><TT>--save-temps</TT> for various gcc intermediate files; MSVC
- has no equivalent option
- </UL>
- As part of this change, some intermediate files have changed their
- names slightly so that new suffixes are always preceded by a
- period. For example, CCured output that used to appear in
- “<TT>foocured.c</TT>” now appears in “<TT>foo.cured.c</TT>”.
-<LI CLASS="li-itemize"><B>April 7, 2003</B>: Changed the representation of the <A HREF="api/Cil.html#VALGVar">Cil.GVar</A>
-global constructor. Now it is possible to update the initializer without
-reconstructing the global (which in turn it would require reconstructing the
-list of globals that make up a program). We did this because it is often
-tempting to use <A HREF="api/Cil.html#VALvisitCilFileSameGlobals">Cil.visitCilFileSameGlobals</A> and the <A HREF="api/Cil.html#VALGVar">Cil.GVar</A>
-was the only global that could not be updated in place.
-<LI CLASS="li-itemize"><B>April 6, 2003</B>: Reimplemented parts of the cilly.pl script to make
-it more robust in the presence of complex compiler arguments.
-<LI CLASS="li-itemize"><B>March 10, 2003</B>: <B>Released version 1.0.9</B>
-<LI CLASS="li-itemize"><B>March 10, 2003</B>: Unified and documented a large number of CIL
-Library Modules: oneret, simplemem, makecfg, heapify, stackguard, partial.
-Also documented the main client interface for the pointer analysis.
-<LI CLASS="li-itemize"><B>February 18, 2003</B>: Fixed a bug in logwrites that was causing it
-to produce invalid C code on writes to bitfields. Thanks, David Park.
-<LI CLASS="li-itemize"><B>February 15, 2003</B>: <B>Released version 1.0.8</B>
-<LI CLASS="li-itemize"><B>February 15, 2003</B>: PDF versions of the manual and API are
-available for those who would like to print them out.
-<LI CLASS="li-itemize"><B>February 14, 2003</B>: CIL now comes bundled with alias analyses.
-<LI CLASS="li-itemize"><B>February 11, 2003</B>: Added support for adding/removing options from
- <TT>./configure</TT>.
-<LI CLASS="li-itemize"><B>February 3, 2003</B>: <B>Released version 1.0.7</B>
-<LI CLASS="li-itemize"><B>February 1, 2003</B>: Some bug fixes in the handling of variable
-argument functions in new versions of <TT>gcc</TT> And <TT>glibc</TT>.
-<LI CLASS="li-itemize"><B>January 29, 2003</B>: Added the logical AND and OR operators.
-Exapanded the translation to CIL to handle more complicated initializers
-(including those that contain logical operators).
-<LI CLASS="li-itemize"><B>January 28, 2003</B>: <B>Released version 1.0.6</B>
-<LI CLASS="li-itemize"><B>January 28, 2003</B>: Added support for the new handling of
-variable-argument functions in new versions of <TT>glibc</TT>.
-<LI CLASS="li-itemize"><B>January 19, 2003</B>: Added support for declarations in interpreted
- constructors. Relaxed the semantics of the patterns for variables.
-<LI CLASS="li-itemize"><B>January 17, 2003</B>: Added built-in prototypes for the gcc built-in
- functions. Changed the <TT>pGlobal</TT> method in the printers to print the
- carriage return as well.
-<LI CLASS="li-itemize"><B>January 9, 2003</B>: Reworked lexer and parser's strategy for
- tracking source file names and line numbers to more closely match
- typical native compiler behavior. The visible CIL interface is
- unchanged.
-<LI CLASS="li-itemize"><B>January 9, 2003</B>: Changed the interface to the alpha convertor. Now
-you can pass a list where it will record undo information that you can use to
-revert the changes that it makes to the scope tables.
-<LI CLASS="li-itemize"><B>January 6, 2003</B>: <B>Released version 1.0.5</B>
-<LI CLASS="li-itemize"><B>January 4, 2003</B>: Changed the interface for the Formatcil module.
- Now the placeholders in the pattern have names. Also expanded the
- documentation of the Formatcil module.
- Now the placeholders in the pattern have names.
-<LI CLASS="li-itemize"><B>January 3, 2003</B>: Extended the <TT>rmtmps</TT> module to also remove
- unused labels that are generated in the conversion to CIL. This reduces the
- number of warnings that you get from <TT>cgcc</TT> afterwards.
-<LI CLASS="li-itemize"><B>December 17, 2002</B>: Fixed a few bugs in CIL related to the
- representation of string literals. The standard says that a string literal
- is an array. In CIL, a string literal has type pointer to character. This is
- Ok, except as an argument of sizeof. To support this exception, we have
- added to CIL the expression constructor SizeOfStr. This allowed us to fix
- bugs with computing <TT>sizeof("foo bar")</TT> and <TT>sizeof((char*)"foo bar")</TT>
- (the former is 8 and the latter is 4).<BR>
-<BR>
-<LI CLASS="li-itemize"><B>December 8, 2002</B>: Fixed a few bugs in the lexer and parser
- relating to hex and octal escapes in string literals. Also fixed
- the dependencies between the lexer and parser.
-<LI CLASS="li-itemize"><B>December 5, 2002</B>: Fixed visitor bugs that were causing
- some attributes not to be visited and some queued instructions to be
- dropped.
-<LI CLASS="li-itemize"><B>December 3, 2002</B>: Added a transformation to catch stack
- overflows. Fixed the heapify transformation.
-<LI CLASS="li-itemize"><B>October 14, 2002</B>: CIL is now available under the BSD license
-(see the License section or the file LICENSE). <B>Released version 1.0.4</B>
-<LI CLASS="li-itemize"><B>October 9, 2002</B>: More FreeBSD configuration changes, support
-for the GCC-ims <TT>__signed</TT> and <TT>__volatile</TT>. Thanks to Axel
-Simon for pointing out these problems. <B>Released version 1.0.3</B>
-<LI CLASS="li-itemize"><B>October 8, 2002</B>: FreeBSD configuration and porting fixes.
-Thanks to Axel Simon for pointing out these problems.
-<LI CLASS="li-itemize"><B>September 10, 2002</B>: Fixed bug in conversion to CIL. Now we drop
-all “const” qualifiers from the types of locals, even from the fields of
-local structures or elements of arrays.
-<LI CLASS="li-itemize"><B>September 7, 2002</B>: Extended visitor interface to distinguish visitng
- offsets inside lvalues from offsets inside initializer lists.
-<LI CLASS="li-itemize"><B>September 7, 2002</B>: <B>Released version 1.0.1</B>
-<LI CLASS="li-itemize"><B>September 6, 2002</B>: Extended the patcher with the <TT>ateof</TT> flag.
-<LI CLASS="li-itemize"><B>September 4, 2002</B>: Fixed bug in the elaboration to CIL. In some
-cases constant folding of <TT>||</TT> and <TT>&&</TT> was computed wrong.
-<LI CLASS="li-itemize"><B>September 3, 2002</B>: Fixed the merger documentation.
-<LI CLASS="li-itemize"><B>August 29, 2002</B>: <B>Released version 1.0.0.</B>
-<LI CLASS="li-itemize"><B>August 29, 2002</B>: Started numbering versions with a major nubmer,
-minor and revisions. Released version 1.0.0.
-<LI CLASS="li-itemize"><B>August 25, 2002</B>: Fixed the implementation of the unique
-identifiers for global variables and composites. Now those identifiers are
-globally unique.
-<LI CLASS="li-itemize"><B>August 24, 2002</B>: Added to the machine-dependent configuration the
-<TT>sizeofvoid</TT>. It is 1 on gcc and 0 on MSVC. Extended the implementation of
-<TT>Cil.bitsSizeOf</TT> to handle this (it was previously returning an error when
-trying to compute the size of <TT>void</TT>).
-<LI CLASS="li-itemize"><B>August 24, 2002</B>: Changed the representation of structure and
-unions to distinguish between undefined structures and those that are defined
-to be empty (allowed on gcc). The sizeof operator is undefined for the former
-and returns 0 for the latter.
-<LI CLASS="li-itemize"><B>August 22, 2002</B>: Apply a patch from Richard H. Y. to support
-FreeBSD installations. Thanks, Richard!
-<LI CLASS="li-itemize"><B>August 12, 2002</B>: Fixed a bug in the translation of wide-character
-strings. Now this translation matches that of the underlying compiler. Changed
-the implementation of the compiler dependencies.
-<LI CLASS="li-itemize"><B>May 25, 2002</B>: Added interpreted constructors and destructors.
-<LI CLASS="li-itemize"><B>May 17, 2002</B>: Changed the representation of functions to move the
-“inline” information to the varinfo. This way we can print the “inline”
-even in declarations which is what gcc does.
-<LI CLASS="li-itemize"><B>May 15, 2002</B>: Changed the visitor for initializers to make two
-tail-recursive passes (the second is a <TT>List.rev</TT> and only done if one of
-the initializers change). This prevents <TT>Stack_Overflow</TT> for large
-initializers. Also improved the processing of initializers when converting to
-CIL.
-<LI CLASS="li-itemize"><B>May 15, 2002</B>: Changed the front-end to allow the use of <TT>MSVC</TT>
-mode even on machines that do not have MSVC. The machine-dependent parameters
-for GCC will be used in that case.
-<LI CLASS="li-itemize"><B>May 11, 2002</B>: Changed the representation of formals in function
-types. Now the function type is purely functional.
-<LI CLASS="li-itemize"><B>May 4, 2002</B>: Added the function
-<A HREF="api/Cil.html#VALvisitCilFileSameGlobals">Cil.visitCilFileSameGlobals</A> and changed <A HREF="api/Cil.html#VALvisitCilFile">Cil.visitCilFile</A> to be
-tail recursive. This prevents stack overflow on huge files.
-<LI CLASS="li-itemize"><B>February 28, 2002</B>: Changed the significance of the
-<TT>CompoundInit</TT> in <A HREF="api/Cil.html#TYPEinit">Cil.init</A> to allow for missing initializers at the
-end of an array initializer. Added the API function
-<A HREF="api/Cil.html#VALfoldLeftCompoundAll">Cil.foldLeftCompoundAll</A>.
-</UL>
-<!--HTMLFOOT-->
-<!--ENDHTML-->
-<!--FOOTER-->
-<HR SIZE=2><BLOCKQUOTE CLASS="quote"><EM>This document was translated from L<sup>A</sup>T<sub>E</sub>X by
-</EM><A HREF="http://pauillac.inria.fr/~maranget/hevea/index.html"><EM>H<FONT SIZE=2><sup>E</sup></FONT>V<FONT SIZE=2><sup>E</sup></FONT>A</EM></A><EM>.</EM></BLOCKQUOTE></BODY>
-</HTML>
diff --git a/cil/doc/cil.version.tex b/cil/doc/cil.version.tex
deleted file mode 100644
index c584859456c476e2599d0e8cce959b9b5ae47de2..0000000000000000000000000000000000000000
--- a/cil/doc/cil.version.tex
+++ /dev/null
@@ -1,2 +0,0 @@
-\def\cilversion{1.3.5}
-\def\ccuredversion{@CCURED_VERSION@}
diff --git a/cil/doc/cil001.html b/cil/doc/cil001.html
deleted file mode 100644
index 5edc5daa201a45282977fa71095eb50ca1cbbca2..0000000000000000000000000000000000000000
--- a/cil/doc/cil001.html
+++ /dev/null
@@ -1,134 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-Introduction
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil002.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc1">1</A> Introduction</H2>
-New: CIL now has a Source Forge page:
- <A HREF="javascript:loadTop('http://sourceforge.net/projects/cil')">http://sourceforge.net/projects/cil</A>. <BR>
-<BR>
-CIL (<B>C</B> <B>I</B>ntermediate <B>L</B>anguage) is a high-level representation
-along with a set of tools that permit easy analysis and source-to-source
-transformation of C programs.<BR>
-<BR>
-CIL is both lower-level than abstract-syntax trees, by clarifying ambiguous
-constructs and removing redundant ones, and also higher-level than typical
-intermediate languages designed for compilation, by maintaining types and a
-close relationship with the source program. The main advantage of CIL is that
-it compiles all valid C programs into a few core constructs with a very clean
-semantics. Also CIL has a syntax-directed type system that makes it easy to
-analyze and manipulate C programs. Furthermore, the CIL front-end is able to
-process not only ANSI-C programs but also those using Microsoft C or GNU C
-extensions. If you do not use CIL and want instead to use just a C parser and
-analyze programs expressed as abstract-syntax trees then your analysis will
-have to handle a lot of ugly corners of the language (let alone the fact that
-parsing C itself is not a trivial task). See Section <A HREF="cil016.html#sec-simplec">16</A> for some
-examples of such extreme programs that CIL simplifies for you.<BR>
-<BR>
-In essence, CIL is a highly-structured, “clean” subset of C. CIL features a
-reduced number of syntactic and conceptual forms. For example, all looping
-constructs are reduced to a single form, all function bodies are given
-explicit <TT>return</TT> statements, syntactic sugar like <TT>"->"</TT> is
-eliminated and function arguments with array types become pointers. (For an
-extensive list of how CIL simplifies C programs, see Section <A HREF="cil004.html#sec-cabs2cil">4</A>.)
-This reduces the number of cases that must be considered when manipulating a C
-program. CIL also separates type declarations from code and flattens scopes
-within function bodies. This structures the program in a manner more amenable
-to rapid analysis and transformation. CIL computes the types of all program
-expressions, and makes all type promotions and casts explicit. CIL supports
-all GCC and MSVC extensions except for nested functions and complex numbers.
-Finally, CIL organizes C's imperative features into expressions, instructions
-and statements based on the presence and absence of side-effects and
-control-flow. Every statement can be annotated with successor and predecessor
-information. Thus CIL provides an integrated program representation that can
-be used with routines that require an AST (e.g. type-based analyses and
-pretty-printers), as well as with routines that require a CFG (e.g., dataflow
-analyses). CIL also supports even lower-level representations (e.g.,
-three-address code), see Section <A HREF="ext.html#sec-Extension">8</A>. <BR>
-<BR>
-CIL comes accompanied by a number of Perl scripts that perform generally
-useful operations on code:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-A <A HREF="cil007.html#sec-driver">driver</A> which behaves as either the <TT>gcc</TT> or
-Microsoft VC compiler and can invoke the preprocessor followed by the CIL
-application. The advantage of this script is that you can easily use CIL and
-the analyses written for CIL with existing make files.
-<LI CLASS="li-itemize">A <A HREF="merger.html#sec-merger">whole-program merger</A> that you can use as a
-replacement for your compiler and it learns all the files you compile when you
-make a project and merges all of the preprocessed source files into a single
-one. This makes it easy to do whole-program analysis.
-<LI CLASS="li-itemize">A <A HREF="patcher.html#sec-patcher">patcher</A> makes it easy to create modified
-copies of the system include files. The CIL driver can then be told to use
-these patched copies instead of the standard ones.
-</UL>
-CIL has been tested very extensively. It is able to process the SPECINT95
-benchmarks, the Linux kernel, GIMP and other open-source projects. All of
-these programs are compiled to the simple CIL and then passed to <TT>gcc</TT> and
-they still run! We consider the compilation of Linux a major feat especially
-since Linux contains many of the ugly GCC extensions (see Section <A HREF="cil016.html#sec-ugly-gcc">16.2</A>).
-This adds to about 1,000,000 lines of code that we tested it on. It is also
-able to process the few Microsoft NT device drivers that we have had access
-to. CIL was tested against GCC's c-torture testsuite and (except for the tests
-involving complex numbers and inner functions, which CIL does not currently
-implement) CIL passes most of the tests. Specifically CIL fails 23 tests out
-of the 904 c-torture tests that it should pass. GCC itself fails 19 tests. A
-total of 1400 regression test cases are run automatically on each change to
-the CIL sources.<BR>
-<BR>
-CIL is relatively independent on the underlying machine and compiler. When
-you build it CIL will configure itself according to the underlying compiler.
-However, CIL has only been tested on Intel x86 using the gcc compiler on Linux
-and cygwin and using the MS Visual C compiler. (See below for specific
-versions of these compilers that we have used CIL for.)<BR>
-<BR>
-The largest application we have used CIL for is
-<A HREF="javascript:loadTop('../ccured/index.html')">CCured</A>, a compiler that compiles C code into
-type-safe code by analyzing your pointer usage and inserting runtime checks in
-the places that cannot be guaranteed statically to be type safe. <BR>
-<BR>
-You can also use CIL to “compile” code that uses GCC extensions (e.g. the
-Linux kernel) into standard C code.<BR>
-<BR>
-CIL also comes accompanies by a growing library of extensions (see
-Section <A HREF="ext.html#sec-Extension">8</A>). You can use these for your projects or as examples of
-using CIL. <BR>
-<BR>
-<TT>PDF</TT> versions of <A HREF="CIL.pdf">this manual</A> and the
-<A HREF="CIL-API.pdf">CIL API</A> are available. However, we recommend the
-<TT>HTML</TT> versions because the postprocessed code examples are easier to
-view. <BR>
-<BR>
-If you use CIL in your project, we would appreciate letting us know. If you
-want to cite CIL in your research writings, please refer to the paper “CIL:
-Intermediate Language and Tools for Analysis and Transformation of C
-Programs” by George C. Necula, Scott McPeak, S.P. Rahul and Westley Weimer,
-in “Proceedings of Conference on Compilier Construction”, 2002.<BR>
-<BR>
-<HR>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil002.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/cil002.html b/cil/doc/cil002.html
deleted file mode 100644
index e575ce39f353d9d3354a686a243d850038f49c64..0000000000000000000000000000000000000000
--- a/cil/doc/cil002.html
+++ /dev/null
@@ -1,98 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-Installation
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="cil001.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil003.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc2">2</A> Installation</H2>
-You will need OCaml release 3.08 or higher to build CIL. CIL has been tested
-on Linux and on Windows (where it can behave at either Microsoft Visual C or
-gcc).<BR>
-<BR>
-If you want to use CIL on Windows then you must get a complete installation
-of <TT>cygwin</TT> and the source-code OCaml distribution and compile it yourself
-using the cygwin tools (as opposed to getting the Win32 native-code version of
-OCaml). If you have not done this before then take a look
-<A HREF="../ccured/setup.html">here</A>. (Don't need to worry about <TT>cvs</TT> and
-<TT>ssh</TT> unless you will need to use the master CVS repository for CIL.)
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
-Download the CIL <A HREF="distrib">distribution</A> (latest version is
-<A HREF="distrib/cil-1.3.5.tar.gz"><TT>distrib/cil-1.3.5.tar.gz</TT></A>). See the Section <A HREF="changes.html#sec-changes">20</A> for recent changes to the CIL distribution.
-<LI CLASS="li-enumerate">Unzip and untar the source distribution. This will create a directory
- called <TT>cil</TT> whose structure is explained below.<BR>
-<TT>tar xvfz cil-1.3.5.tar.gz</TT>
-<LI CLASS="li-enumerate">Enter the <TT>cil</TT> directory and run the <TT>configure</TT> script and then
- GNU make to build the distribution. If you are on Windows, at least the
- <TT>configure</TT> step must be run from within <TT>bash</TT>.<BR>
- <CODE>cd cil</CODE><BR>
- <CODE>./configure</CODE><BR>
- <CODE>make</CODE><BR>
- <CODE>make quicktest</CODE><BR>
-<LI CLASS="li-enumerate">You should now find <TT>cilly.asm.exe</TT> in a
-subdirectory of <TT>obj</TT>. The name of the subdirectory is either <TT>x86_WIN32</TT>
-if you are using <TT>cygwin</TT> on Windows or <TT>x86_LINUX</TT> if you are using
-Linux (although you should be using instead the Perl wrapper <TT>bin/cilly</TT>).
-Note that we do not have an <TT>install</TT> make target and you should use Cil
-from the development directory.
-<LI CLASS="li-enumerate">If you decide to use CIL, <B>please</B>
-<A HREF="mailto:necula@cs.berkeley.edu">send us a note</A>. This will help recharge
-our batteries after more than a year of development. And of course, do send us
-your bug reports as well.</OL>
-The <TT>configure</TT> script tries to find appropriate defaults for your system.
-You can control its actions by passing the following arguments:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>CC=foo</TT> Specifies the path for the <TT>gcc</TT> executable. By default
-whichever version is in the PATH is used. If <TT>CC</TT> specifies the Microsoft
-<TT>cl</TT> compiler, then that compiler will be set as the default one. Otherwise,
-the <TT>gcc</TT> compiler will be the default.
-</UL>
-CIL requires an underlying C compiler and preprocessor. CIL depends on the
-underlying compiler and machine for the sizes and alignment of types.The
-installation procedure for CIL queries the underlying compiler for
-architecture and compiler dependent configuration parameters, such as the size
-of a pointer or the particular alignment rules for structure fields. (This
-means, of course, that you should re-run <TT>./configure</TT> when you move CIL to
-another machine.)<BR>
-<BR>
-We have tested CIL on the following compilers:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-On Windows, <TT>cl</TT> compiler version 12.00.8168 (MSVC 6),
- 13.00.9466 (MSVC .Net), and 13.10.3077 (MSVC .Net 2003). Run <TT>cl</TT>
- with no arguments to get the compiler version.
-<LI CLASS="li-itemize">On Windows, using <TT>cygwin</TT> and <TT>gcc</TT> version 2.95.3, 3.0,
- 3.2, 3.3, and 3.4.
-<LI CLASS="li-itemize">On Linux, using <TT>gcc</TT> version 2.95.3, 3.0, 3.2, 3.3, and 4.0.
-</UL>
-Others have successfully used CIL with Mac OS X (on both PowerPC and
-x86), Solaris, and *BSD. If you make any changes to the build
-system in order to run CIL on your platform, please send us a patch.<BR>
-<BR>
- <HR>
-<A HREF="cil001.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil003.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/cil003.html b/cil/doc/cil003.html
deleted file mode 100644
index 4b885f35a66dd3a5091b839f2b85c3024426b19a..0000000000000000000000000000000000000000
--- a/cil/doc/cil003.html
+++ /dev/null
@@ -1,187 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-Distribution Contents
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="cil002.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil004.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc3">3</A> Distribution Contents</H2>
-The file <A HREF="distrib/cil-1.3.5.tar.gz"><TT>distrib/cil-1.3.5.tar.gz</TT></A>
-contains the complete source CIL distribution,
-consisting of the following files:<BR>
-<TABLE CELLSPACING=2 CELLPADDING=0>
-<TR><TD ALIGN=left NOWRAP>Filename</TD>
-<TD ALIGN=left NOWRAP>Description</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>Makefile.in</TT></TD>
-<TD ALIGN=left NOWRAP><TT>configure</TT> source for the
- Makefile that builds CIL</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>configure</TT></TD>
-<TD ALIGN=left NOWRAP>The configure script</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>configure.in</TT></TD>
-<TD ALIGN=left NOWRAP>The <TT>autoconf</TT> source for <TT>configure</TT></TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>config.guess</TT>, <TT>config.sub</TT>, <TT>install-sh</TT></TD>
-<TD ALIGN=left NOWRAP>stuff required by
- <TT>configure</TT></TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP> </TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>doc/</TT></TD>
-<TD ALIGN=left NOWRAP>HTML documentation of the CIL API</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>obj/</TT></TD>
-<TD ALIGN=left NOWRAP>Directory that will contain the compiled
- CIL modules and executables</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>bin/cilly.in</TT></TD>
-<TD ALIGN=left NOWRAP>The <TT>configure</TT> source for a Perl script
- that can be invoked with the
- same arguments as either <TT>gcc</TT> or
- Microsoft Visual C and will convert the
- program to CIL, perform some simple
- transformations, emit it and compile it as
- usual.</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>lib/CompilerStub.pm</TT></TD>
-<TD ALIGN=left NOWRAP>A Perl class that can be used to write code
- that impersonates a compiler. <TT>cilly</TT>
- uses it.</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>lib/Merger.pm</TT></TD>
-<TD ALIGN=left NOWRAP>A subclass of <TT>CompilerStub.pm</TT> that can
- be used to merge source files into a single
- source file.<TT>cilly</TT>
- uses it.</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>bin/patcher.in</TT></TD>
-<TD ALIGN=left NOWRAP>A Perl script that applies specified patches
- to standard include files.</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP> </TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/check.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>Checks the well-formedness of a CIL file</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/cil.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>Definition of CIL abstract syntax and
- utilities for manipulating it</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/clist.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>Utilities for efficiently managing lists
- that need to be concatenated often</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/errormsg.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>Utilities for error reporting</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/ext/heapify.ml</TT></TD>
-<TD ALIGN=left NOWRAP>A CIL transformation that moves array local
- variables from the stack to the heap</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/ext/logcalls.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>A CIL transformation that logs every
- function call</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/ext/sfi.ml</TT></TD>
-<TD ALIGN=left NOWRAP>A CIL transformation that can log every
- memory read and write</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/frontc/clexer.mll</TT></TD>
-<TD ALIGN=left NOWRAP>The lexer</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/frontc/cparser.mly</TT></TD>
-<TD ALIGN=left NOWRAP>The parser</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/frontc/cabs.ml</TT></TD>
-<TD ALIGN=left NOWRAP>The abstract syntax</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/frontc/cprint.ml</TT></TD>
-<TD ALIGN=left NOWRAP>The pretty printer for CABS</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/frontc/cabs2cil.ml</TT></TD>
-<TD ALIGN=left NOWRAP>The elaborator to CIL</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/main.ml</TT></TD>
-<TD ALIGN=left NOWRAP>The <TT>cilly</TT> application</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/pretty.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>Utilities for pretty printing</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/rmtmps.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>A CIL tranformation that removes unused
- types, variables and inlined functions</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/stats.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>Utilities for maintaining timing statistics</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/testcil.ml</TT></TD>
-<TD ALIGN=left NOWRAP>A random test of CIL (against the resident
- C compiler)</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/trace.ml,mli</TT></TD>
-<TD ALIGN=left NOWRAP>Utilities useful for printing debugging
- information</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP> </TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>ocamlutil/</TT></TD>
-<TD ALIGN=left NOWRAP>Miscellaneous libraries that are not
- specific to CIL.</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>ocamlutil/Makefile.ocaml</TT></TD>
-<TD ALIGN=left NOWRAP>A file that is included by <TT>Makefile</TT></TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>ocamlutil/Makefile.ocaml.build</TT></TD>
-<TD ALIGN=left NOWRAP>A file that is included by <TT>Makefile</TT></TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>ocamlutil/perfcount.c</TT></TD>
-<TD ALIGN=left NOWRAP>C code that links with src/stats.ml
- and reads Intel performance
- counters.</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP> </TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>obj/@ARCHOS@/feature_config.ml</TT></TD>
-<TD ALIGN=left NOWRAP>File generated by the Makefile
- describing which extra “features”
- to compile. See Section <A HREF="cilly.html#sec-cil">5</A></TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>obj/@ARCHOS@/machdep.ml</TT></TD>
-<TD ALIGN=left NOWRAP>File generated by the Makefile containing
- information about your architecture,
- such as the size of a pointer</TD>
-</TR>
-<TR><TD ALIGN=left NOWRAP><TT>src/machdep.c</TT></TD>
-<TD ALIGN=left NOWRAP>C program that generates
- <TT>machdep.ml</TT> files</TD>
-</TR></TABLE><BR>
-<HR>
-<A HREF="cil002.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil004.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/cil004.html b/cil/doc/cil004.html
deleted file mode 100644
index 16fde39295758ccc16316d1ba4bfd2f773f77ea4..0000000000000000000000000000000000000000
--- a/cil/doc/cil004.html
+++ /dev/null
@@ -1,350 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-Compiling C to CIL
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="cil003.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cilly.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc4">4</A> Compiling C to CIL</H2><A NAME="sec-cabs2cil"></A>
-In this section we try to describe a few of the many transformations that are
-applied to a C program to convert it to CIL. The module that implements this
-conversion is about 5000 lines of OCaml code. In contrast a simple program
-transformation that instruments all functions to keep a shadow stack of the
-true return address (thus preventing stack smashing) is only 70 lines of code.
-This example shows that the analysis is so much simpler because it has to
-handle only a few simple C constructs and also because it can leverage on CIL
-infrastructure such as visitors and pretty-printers.<BR>
-<BR>
-In no particular order these are a few of the most significant ways in which
-C programs are compiled into CIL:
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
-CIL will eliminate all declarations for unused entities. This means that
-just because your hello world program includes <TT>stdio.h</TT> it does not mean
-that your analysis has to handle all the ugly stuff from <TT>stdio.h</TT>.<BR>
-<BR>
-<LI CLASS="li-enumerate">Type specifiers are interpreted and normalized:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-int long signed x;
-signed long extern x;
-long static int long y;
-
-// Some code that uses these declaration, so that CIL does not remove them
-int main() { return x + y; }
-</FONT></PRE>
-See the <A HREF="examples/ex1.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Anonymous structure and union declarations are given a name.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- struct { int x; } s;
-</FONT></PRE>
-See the <A HREF="examples/ex2.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Nested structure tag definitions are pulled apart. This means that all
-structure tag definitions can be found by a simple scan of the globals.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-struct foo {
- struct bar {
- union baz {
- int x1;
- double x2;
- } u1;
- int y;
- } s1;
- int z;
-} f;
-</FONT></PRE>
-See the <A HREF="examples/ex3.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">All structure, union, enumeration definitions and the type definitions
-from inners scopes are moved to global scope (with appropriate renaming). This
-facilitates moving around of the references to these entities.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-int main() {
- struct foo {
- int x; } foo;
- {
- struct foo {
- double d;
- };
- return foo.x;
- }
-}
-</FONT></PRE>
-See the <A HREF="examples/ex4.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Prototypes are added for those functions that are called before being
-defined. Furthermore, if a prototype exists but does not specify the type of
-parameters that is fixed. But CIL will not be able to add prototypes for those
-functions that are neither declared nor defined (but are used!).
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int f(); // Prototype without arguments
- int f(double x) {
- return g(x);
- }
- int g(double x) {
- return x;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex5.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Array lengths are computed based on the initializers or by constant
-folding.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int a1[] = {1,2,3};
- int a2[sizeof(int) >= 4 ? 8 : 16];
-</FONT></PRE>
-See the <A HREF="examples/ex6.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Enumeration tags are computed using constant folding:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-int main() {
- enum {
- FIVE = 5,
- SIX, SEVEN,
- FOUR = FIVE - 1,
- EIGHT = sizeof(double)
- } x = FIVE;
- return x;
-}
-
-</FONT></PRE>
-See the <A HREF="examples/ex7.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Initializers are normalized to include specific initialization for the
-missing elements:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int a1[5] = {1,2,3};
- struct foo { int x, y; } s1 = { 4 };
-</FONT></PRE>
-See the <A HREF="examples/ex8.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Initializer designators are interpreted and eliminated. Subobjects are
-properly marked with braces. CIL implements
-the whole ISO C99 specification for initializer (neither GCC nor MSVC do) and
-a few GCC extensions.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- struct foo {
- int x, y;
- int a[5];
- struct inner {
- int z;
- } inner;
- } s = { 0, .inner.z = 3, .a[1 ... 2] = 5, 4, y : 8 };
-</FONT></PRE>
-See the <A HREF="examples/ex9.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">String initializers for arrays of characters are processed
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-char foo[] = "foo plus bar";
-</FONT></PRE>
-See the <A HREF="examples/ex10.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">String constants are concatenated
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-char *foo = "foo " " plus " " bar ";
-</FONT></PRE>
-See the <A HREF="examples/ex11.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Initializers for local variables are turned into assignments. This is in
-order to separate completely the declarative part of a function body from the
-statements. This has the unfortunate effect that we have to drop the <TT>const</TT>
-qualifier from local variables !
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x = 5;
- struct foo { int f1, f2; } a [] = {1, 2, 3, 4, 5 };
-</FONT></PRE>
-See the <A HREF="examples/ex12.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Local variables in inner scopes are pulled to function scope (with
-appropriate renaming). Local scopes thus disappear. This makes it easy to find
-and operate on all local variables in a function.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x = 5;
- int main() {
- int x = 6;
- {
- int x = 7;
- return x;
- }
- return x;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex13.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Global declarations in local scopes are moved to global scope:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x = 5;
- int main() {
- int x = 6;
- {
- static int x = 7;
- return x;
- }
- return x;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex14.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Return statements are added for functions that are missing them. If the
-return type is not a base type then a <TT>return</TT> without a value is added.
-The guaranteed presence of return statements makes it easy to implement a
-transformation that inserts some code to be executed immediately before
-returning from a function.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int foo() {
- int x = 5;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex15.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">One of the most significant transformations is that expressions that
-contain side-effects are separated into statements.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x, f(int);
- return (x ++ + f(x));
-</FONT></PRE>
-See the <A HREF="examples/ex16.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-Internally, the <TT>x ++</TT> statement is turned into an assignment which the
-pretty-printer prints like the original. CIL has only three forms of basic
-statements: assignments, function calls and inline assembly.<BR>
-<BR>
-<LI CLASS="li-enumerate">Shortcut evaluation of boolean expressions and the <TT>?:</TT> operator are
-compiled into explicit conditionals:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x;
- int y = x ? 2 : 4;
- int z = x || y;
- // Here we duplicate the return statement
- if(x && y) { return 0; } else { return 1; }
- // To avoid excessive duplication, CIL uses goto's for
- // statement that have more than 5 instructions
- if(x && y || z) { x ++; y ++; z ++; x ++; y ++; return z; }
-</FONT></PRE>
-See the <A HREF="examples/ex17.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">GCC's conditional expression with missing operands are also compiled
-into conditionals:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int f();;
- return f() ? : 4;
-</FONT></PRE>
-See the <A HREF="examples/ex18.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">All forms of loops (<TT>while</TT>, <TT>for</TT> and <TT>do</TT>) are compiled
-internally as a single <TT>while(1)</TT> looping construct with explicit <TT>break</TT>
-statement for termination. For simple <TT>while</TT> loops the pretty printer is
-able to print back the original:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x, y;
- for(int i = 0; i<5; i++) {
- if(i == 5) continue;
- if(i == 4) break;
- i += 2;
- }
- while(x < 5) {
- if(x == 3) continue;
- x ++;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex19.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">GCC's block expressions are compiled away. (That's right there is an
-infinite loop in this code.)
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x = 5, y = x;
- int z = ({ x++; L: y -= x; y;});
- return ({ goto L; 0; });
-</FONT></PRE>
-See the <A HREF="examples/ex20.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">CIL contains support for both MSVC and GCC inline assembly (both in one
-internal construct)<BR>
-<BR>
-<LI CLASS="li-enumerate">CIL compiles away the GCC extension that allows many kinds of constructs
-to be used as lvalues:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x, y, z;
- return &(x ? y : z) - & (x ++, x);
-</FONT></PRE>
-See the <A HREF="examples/ex21.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">All types are computed and explicit casts are inserted for all
-promotions and conversions that a compiler must insert:<BR>
-<BR>
-<LI CLASS="li-enumerate">CIL will turn old-style function definition (without prototype) into
-new-style definitions. This will make the compiler less forgiving when
-checking function calls, and will catch for example cases when a function is
-called with too few arguments. This happens in old-style code for the purpose
-of implementing variable argument functions.<BR>
-<BR>
-<LI CLASS="li-enumerate">Since CIL sees the source after preprocessing the code after CIL does
-not contain the comments and the preprocessing directives.<BR>
-<BR>
-<LI CLASS="li-enumerate">CIL will remove from the source file those type declarations, local
-variables and inline functions that are not used in the file. This means that
-your analysis does not have to see all the ugly stuff that comes from the
-header files:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-#include <stdio.h>
-
-typedef int unused_type;
-
-static char unused_static (void) { return 0; }
-
-int main() {
- int unused_local;
- printf("Hello world\n"); // Only printf will be kept from stdio.h
-}
-</FONT></PRE>
-See the <A HREF="examples/ex22.txt">CIL output</A> for this
-code fragment</OL>
-<HR>
-<A HREF="cil003.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cilly.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/cil006.html b/cil/doc/cil006.html
deleted file mode 100644
index 8fc3194909f02105e9ac5487b5f2a846d361478b..0000000000000000000000000000000000000000
--- a/cil/doc/cil006.html
+++ /dev/null
@@ -1,627 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-CIL API Documentation
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="cilly.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil007.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc8">6</A> CIL API Documentation</H2><A NAME="sec-api"></A>
-The CIL API is documented in the file <TT>src/cil.mli</TT>. We also have an
-<A HREF="api/index.html">online documentation</A> extracted from <TT>cil.mli</TT>. We
-index below the main types that are used to represent C programs in CIL:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<A HREF="api/index_types.html">An index of all types</A>
-<LI CLASS="li-itemize"><A HREF="api/index_values.html">An index of all values</A>
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEfile">Cil.file</A> is the representation of a file.
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEglobal">Cil.global</A> is the representation of a global declaration or
-definitions. Values for <A HREF="api/Cil.html#VALemptyFunction">operating on globals</A>.
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEtyp">Cil.typ</A> is the representation of a type.
-Values for <A HREF="api/Cil.html#VALvoidType">operating on types</A>.
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEcompinfo">Cil.compinfo</A> is the representation of a structure or a union
-type
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEfieldinfo">Cil.fieldinfo</A> is the representation of a field in a structure
-or a union
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEenuminfo">Cil.enuminfo</A> is the representation of an enumeration type.
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEvarinfo">Cil.varinfo</A> is the representation of a variable
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEfundec">Cil.fundec</A> is the representation of a function
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPElval">Cil.lval</A> is the representation of an lvalue.
-Values for <A HREF="api/Cil.html#VALmakeVarInfo">operating on lvalues</A>.
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEexp">Cil.exp</A> is the representation of an expression without
-side-effects.
-Values for <A HREF="api/Cil.html#VALzero">operating on expressions</A>.
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEinstr">Cil.instr</A> is the representation of an instruction (with
-side-effects but without control-flow)
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEstmt">Cil.stmt</A> is the representation of a control-flow statements.
-Values for <A HREF="api/Cil.html#VALmkStmt">operating on statements</A>.
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEattribute">Cil.attribute</A> is the representation of attributes.
-Values for <A HREF="api/Cil.html#TYPEattributeClass">operating on attributes</A>.
-</UL>
-<A NAME="toc3"></A>
-<H3 CLASS="subsection"><A NAME="htoc9">6.1</A> Using the visitor</H3><A NAME="sec-visitor"></A>
-One of the most useful tools exported by the CIL API is an implementation of
-the visitor pattern for CIL programs. The visiting engine scans depth-first
-the structure of a CIL program and at each node is queries a user-provided
-visitor structure whether it should do one of the following operations:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-Ignore this node and all its descendants
-<LI CLASS="li-itemize">Descend into all of the children and when done rebuild the node if any
-of the children have changed.
-<LI CLASS="li-itemize">Replace the subtree rooted at the node with another tree.
-<LI CLASS="li-itemize">Replace the subtree with another tree, then descend into the children
-and rebuild the node if necessary and then invoke a user-specified function.
-<LI CLASS="li-itemize">In addition to all of the above actions then visitor can specify that
-some instructions should be queued to be inserted before the current
-instruction or statement being visited.
-</UL>
-By writing visitors you can customize the program traversal and
-transformation. One major limitation of the visiting engine is that it does
-not propagate information from one node to another. Each visitor must use its
-own private data to achieve this effect if necessary. <BR>
-<BR>
-Each visitor is an object that is an instance of a class of type <A HREF="api/Cil.cilVisitor.html#.">Cil.cilVisitor..</A>
-The most convenient way to obtain such classes is to specialize the
-<A HREF="api/Cil.nopCilVisitor.html#c">Cil.nopCilVisitor.c</A>lass (which just traverses the tree doing
-nothing). Any given specialization typically overrides only a few of the
-methods. Take a look for example at the visitor defined in the module
-<TT>logwrites.ml</TT>. Another, more elaborate example of a visitor is the
-[copyFunctionVisitor] defined in <TT>cil.ml</TT>.<BR>
-<BR>
-Once you have defined a visitor you can invoke it with one of the functions:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<A HREF="api/Cil.html#VALvisitCilFile">Cil.visitCilFile</A> or <A HREF="api/Cil.html#VALvisitCilFileSameGlobals">Cil.visitCilFileSameGlobals</A> - visit a file
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilGlobal">Cil.visitCilGlobal</A> - visit a global
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilFunction">Cil.visitCilFunction</A> - visit a function definition
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilExp">Cil.visitCilExp</A> - visit an expression
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilLval">Cil.visitCilLval</A> - visit an lvalue
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilInstr">Cil.visitCilInstr</A> - visit an instruction
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilStmt">Cil.visitCilStmt</A> - visit a statement
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilType">Cil.visitCilType</A> - visit a type. Note that this does not visit
-the files of a composite type. use visitGlobal to visit the [GCompTag] that
-defines the fields.
-</UL>
-Some transformations may want to use visitors to insert additional
-instructions before statements and instructions. To do so, pass a list of
-instructions to the <A HREF="api/Cil.html#VALqueueInstr">Cil.queueInstr</A> method of the specialized
-object. The instructions will automatically be inserted before that
-instruction in the transformed code. The <A HREF="api/Cil.html#VALunqueueInstr">Cil.unqueueInstr</A> method
-should not normally be called by the user. <BR>
-<BR>
-<A NAME="toc4"></A>
-<H3 CLASS="subsection"><A NAME="htoc10">6.2</A> Interpreted Constructors and Deconstructors</H3>
-Interpreted constructors and deconstructors are a facility for constructing
-and deconstructing CIL constructs using a pattern with holes that can be
-filled with a variety of kinds of elements. The pattern is a string that uses
-the C syntax to represent C language elements. For example, the following
-code:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-Formatcil.cType "void * const (*)(int x)"
-</FONT></PRE>
-is an alternative way to construct the internal representation of the type of pointer to function
-with an integer argument and a void * const as result:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-TPtr(TFun(TVoid [Attr("const", [])],
- [ ("x", TInt(IInt, []), []) ], false, []), [])
-</FONT></PRE>
-The advantage of the interpreted constructors is that you can use familiar C
-syntax to construct CIL abstract-syntax trees. <BR>
-<BR>
-You can construct this way types, lvalues, expressions, instructions and
-statements. The pattern string can also contain a number of placeholders that
-are replaced during construction with CIL items passed as additional argument
-to the construction function. For example, the <TT>%e:id</TT> placeholder means
-that the argument labeled “id” (expected to be of form <TT>Fe exp</TT>) will
-supply the expression to replace the placeholder. For example, the following
-code constructs an increment instruction at location <TT>loc</TT>:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-Formatcil.cInstr "%v:x = %v:x + %e:something"
- loc
- [ ("something", Fe some_exp);
- ("x", Fv some_varinfo) ]
-</FONT></PRE>
-An alternative way to construct the same CIL instruction is:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-Set((Var some_varinfo, NoOffset),
- BinOp(PlusA, Lval (Var some_varinfo, NoOffset),
- some_exp, intType),
- loc)
-</FONT></PRE>
-See <A HREF="api/Cil.html#TYPEformatArg">Cil.formatArg</A> for a definition of the placeholders that are
-understood.<BR>
-<BR>
-A dual feature is the interpreted deconstructors. This can be used to test
-whether a CIL construct has a certain form:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-Formatcil.dType "void * const (*)(int x)" t
-</FONT></PRE>
-will test whether the actual argument <TT>t</TT> is indeed a function pointer of
-the required type. If it is then the result is <TT>Some []</TT> otherwise it is
-<TT>None</TT>. Furthermore, for the purpose of the interpreted deconstructors
-placeholders in patterns match anything of the right type. For example,
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-Formatcil.dType "void * (*)(%F:t)" t
-</FONT></PRE>
-will match any function pointer type, independent of the type and number of
-the formals. If the match succeeds the result is <TT>Some [ FF forms ]</TT> where
-<TT>forms</TT> is a list of names and types of the formals. Note that each member
-in the resulting list corresponds positionally to a placeholder in the
-pattern.<BR>
-<BR>
-The interpreted constructors and deconstructors do not support the complete C
-syntax, but only a substantial fragment chosen to simplify the parsing. The
-following is the syntax that is supported:
-<PRE CLASS="verbatim">
-Expressions:
- E ::= %e:ID | %d:ID | %g:ID | n | L | ( E ) | Unop E | E Binop E
- | sizeof E | sizeof ( T ) | alignof E | alignof ( T )
- | & L | ( T ) E
-
-Unary operators:
- Unop ::= + | - | ~ | %u:ID
-
-Binary operators:
- Binop ::= + | - | * | / | << | >> | & | ``|'' | ^
- | == | != | < | > | <= | >= | %b:ID
-
-Lvalues:
- L ::= %l:ID | %v:ID Offset | * E | (* E) Offset | E -> ident Offset
-
-Offsets:
- Offset ::= empty | %o:ID | . ident Offset | [ E ] Offset
-
-Types:
- T ::= Type_spec Attrs Decl
-
-Type specifiers:
- Type_spec ::= void | char | unsigned char | short | unsigned short
- | int | unsigned int | long | unsigned long | %k:ID | float
- | double | struct %c:ID | union %c:ID
-
-
-Declarators:
- Decl ::= * Attrs Decl | Direct_decl
-
-
-Direct declarators:
- Direct_decl ::= empty | ident | ( Attrs Decl )
- | Direct_decl [ Exp_opt ]
- | ( Attrs Decl )( Parameters )
-
-Optional expressions
- Exp_opt ::= empty | E | %eo:ID
-
-Formal parameters
- Parameters ::= empty | ... | %va:ID | %f:ID | T | T , Parameters
-
-List of attributes
- Attrs ::= empty | %A:ID | Attrib Attrs
-
-Attributes
- Attrib ::= const | restrict | volatile | __attribute__ ( ( GAttr ) )
-
-GCC Attributes
- GAttr ::= ident | ident ( AttrArg_List )
-
-Lists of GCC Attribute arguments:
- AttrArg_List ::= AttrArg | %P:ID | AttrArg , AttrArg_List
-
-GCC Attribute arguments
- AttrArg ::= %p:ID | ident | ident ( AttrArg_List )
-
-Instructions
- Instr ::= %i:ID ; | L = E ; | L Binop= E | Callres L ( Args )
-
-Actual arguments
- Args ::= empty | %E:ID | E | E , Args
-
-Call destination
- Callres ::= empty | L = | %lo:ID
-
-Statements
- Stmt ::= %s:ID | if ( E ) then Stmt ; | if ( E ) then Stmt else Stmt ;
- | return Exp_opt | break ; | continue ; | { Stmt_list }
- | while (E ) Stmt | Instr_list
-
-Lists of statements
- Stmt_list ::= empty | %S:ID | Stmt Stmt_list
- | Type_spec Attrs Decl ; Stmt_list
- | Type_spec Attrs Decl = E ; Stmt_list
- | Type_spec Attrs Decl = L (Args) ; Stmt_list
-
-List of instructions
- Instr_list ::= Instr | %I:ID | Instr Instr_list
-</PRE>
-Notes regarding the syntax:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-In the grammar description above non-terminals are written with
-uppercase initial<BR>
-<BR>
-<LI CLASS="li-itemize">All of the patterns consist of the <TT>%</TT> character followed by one or
-two letters, followed by “:” and an indentifier. For each such
-pattern there is a corresponding constructor of the <A HREF="api/Cil.html#TYPEformatArg">Cil.formatArg</A>
-type, whose name is the letter 'F' followed by the same one or two letters as
-in the pattern. That constructor is used by the user code to pass a
-<A HREF="api/Cil.html#TYPEformatArg">Cil.formatArg</A> actual argument to the interpreted constructor and by
-the interpreted deconstructor to return what was matched for a pattern.<BR>
-<BR>
-<LI CLASS="li-itemize">If the pattern name is uppercase, it designates a list of the elements
-designated by the corresponding lowercase pattern. E.g. %E designated lists
-of expressions (as in the actual arguments of a call).<BR>
-<BR>
-<LI CLASS="li-itemize">The two-letter patterns whose second letter is “o” designate an
-optional element. E.g. %eo designates an optional expression (as in the
-length of an array). <BR>
-<BR>
-<LI CLASS="li-itemize">Unlike in calls to <TT>printf</TT>, the pattern %g is used for strings. <BR>
-<BR>
-<LI CLASS="li-itemize">The usual precedence and associativity rules as in C apply <BR>
-<BR>
-<LI CLASS="li-itemize">The pattern string can contain newlines and comments, using both the
-<TT>/* ... */</TT> style as well as the <TT>//</TT> one. <BR>
-<BR>
-<LI CLASS="li-itemize">When matching a “cast” pattern of the form <TT>( T ) E</TT>, the
-deconstructor will match even expressions that do not have the actual cast but
-in that case the type is matched against the type of the expression. E.g. the
-patters <TT>"(int)%e"</TT> will match any expression of type <TT>int</TT> whether it
-has an explicit cast or not. <BR>
-<BR>
-<LI CLASS="li-itemize">The %k pattern is used to construct and deconstruct an integer type of
-any kind. <BR>
-<BR>
-<LI CLASS="li-itemize">Notice that the syntax of types and declaration are the same (in order
-to simplify the parser). This means that technically you can write a whole
-declaration instead of a type in the cast. In this case the name that you
-declare is ignored.<BR>
-<BR>
-<LI CLASS="li-itemize">In lists of formal parameters and lists of attributes, an empty list in
-the pattern matches any formal parameters or attributes. <BR>
-<BR>
-<LI CLASS="li-itemize">When matching types, uses of named types are unrolled to expose a real
-type before matching. <BR>
-<BR>
-<LI CLASS="li-itemize">The order of the attributes is ignored during matching. The the pattern
-for a list of attributes contains %A then the resulting <TT>formatArg</TT> will be
-bound to <B>all</B> attributes in the list. For example, the pattern <TT>"const
-%A"</TT> matches any list of attributes that contains <TT>const</TT> and binds the
-corresponding placeholder to the entire list of attributes, including
-<TT>const</TT>. <BR>
-<BR>
-<LI CLASS="li-itemize">All instruction-patterns must be terminated by semicolon<BR>
-<BR>
-<LI CLASS="li-itemize">The autoincrement and autodecrement instructions are not supported. Also
-not supported are complex expressions, the <TT>&&</TT> and <TT>||</TT> shortcut
-operators, and a number of other more complex instructions or statements. In
-general, the patterns support only constructs that can be represented directly
-in CIL.<BR>
-<BR>
-<LI CLASS="li-itemize">The pattern argument identifiers are not used during deconstruction.
-Instead, the result contains a sequence of values in the same order as the
-appearance of pattern arguments in the pattern.<BR>
-<BR>
-<LI CLASS="li-itemize">You can mix statements with declarations. For each declaration a new
- temporary will be constructed (using a function you provive). You can then
- refer to that temporary by name in the rest of the pattern.<BR>
-<BR>
-<LI CLASS="li-itemize">The <TT>%v:</TT> pattern specifier is optional.
-</UL>
-The following function are defined in the <TT>Formatcil</TT> module for
-constructing and deconstructing:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<A HREF="api/Formatcil.html#VALcExp">Formatcil.cExp</A> constructs <A HREF="api/Cil.html#TYPEexp">Cil.exp</A>.
-<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALcType">Formatcil.cType</A> constructs <A HREF="api/Cil.html#TYPEtyp">Cil.typ</A>.
-<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALcLval">Formatcil.cLval</A> constructs <A HREF="api/Cil.html#TYPElval">Cil.lval</A>.
-<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALcInstr">Formatcil.cInstr</A> constructs <A HREF="api/Cil.html#TYPEinstr">Cil.instr</A>.
-<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALcStmt">Formatcil.cStmt</A> and <A HREF="api/Formatcil.html#VALcStmts">Formatcil.cStmts</A> construct <A HREF="api/Cil.html#TYPEstmt">Cil.stmt</A>.
-<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALdExp">Formatcil.dExp</A> deconstructs <A HREF="api/Cil.html#TYPEexp">Cil.exp</A>.
-<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALdType">Formatcil.dType</A> deconstructs <A HREF="api/Cil.html#TYPEtyp">Cil.typ</A>.
-<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALdLval">Formatcil.dLval</A> deconstructs <A HREF="api/Cil.html#TYPElval">Cil.lval</A>.
-<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALdInstr">Formatcil.dInstr</A> deconstructs <A HREF="api/Cil.html#TYPElval">Cil.lval</A>.
-</UL>
-Below is an example using interpreted constructors. This example generates
-the CIL representation of code that scans an array backwards and initializes
-every even-index element with an expression:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-Formatcil.cStmts
- loc
- "int idx = sizeof(array) / sizeof(array[0]) - 1;
- while(idx >= 0) {
- // Some statements to be run for all the elements of the array
- %S:init
- if(! (idx & 1))
- array[idx] = %e:init_even;
- /* Do not forget to decrement the index variable */
- idx = idx - 1;
- }"
- (fun n t -> makeTempVar myfunc ~name:n t)
- [ ("array", Fv myarray);
- ("init", FS [stmt1; stmt2; stmt3]);
- ("init_even", Fe init_expr_for_even_elements) ]
-</FONT></PRE>
-To write the same CIL statement directly in CIL would take much more effort.
-Note that the pattern is parsed only once and the result (a function that
-takes the arguments and constructs the statement) is memoized. <BR>
-<BR>
-
-<H4 CLASS="subsubsection"><A NAME="htoc11">6.2.1</A> Performance considerations for interpreted constructors</H4>
-Parsing the patterns is done with a LALR parser and it takes some time. To
-improve performance the constructors and deconstructors memoize the parsed
-patterns and will only compile a pattern once. Also all construction and
-deconstruction functions can be applied partially to the pattern string to
-produce a function that can be later used directly to construct or
-deconstruct. This function appears to be about two times slower than if the
-construction is done using the CIL constructors (without memoization the
-process would be one order of magnitude slower.) However, the convenience of
-interpreted constructor might make them a viable choice in many situations
-when performance is not paramount (e.g. prototyping).<BR>
-<BR>
-<A NAME="toc5"></A>
-<H3 CLASS="subsection"><A NAME="htoc12">6.3</A> Printing and Debugging support</H3>
-The Modules <A HREF="api/Pretty.html">Pretty</A> and <A HREF="api/Errormsg.html">Errormsg</A> contain respectively
-utilities for pretty printing and reporting errors and provide a convenient
-<TT>printf</TT>-like interface. <BR>
-<BR>
-Additionally, CIL defines for each major type a pretty-printing function that
-you can use in conjunction with the <A HREF="api/Pretty.html">Pretty</A> interface. The
-following are some of the pretty-printing functions:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<A HREF="api/Cil.html#VALd_exp">Cil.d_exp</A> - print an expression
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_type">Cil.d_type</A> - print a type
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_lval">Cil.d_lval</A> - print an lvalue
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_global">Cil.d_global</A> - print a global
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_stmt">Cil.d_stmt</A> - print a statment
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_instr">Cil.d_instr</A> - print an instruction
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_init">Cil.d_init</A> - print an initializer
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_attr">Cil.d_attr</A> - print an attribute
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_attrlist">Cil.d_attrlist</A> - print a set of attributes
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_loc">Cil.d_loc</A> - print a location
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_ikind">Cil.d_ikind</A> - print an integer kind
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_fkind">Cil.d_fkind</A> - print a floating point kind
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_const">Cil.d_const</A> - print a constant
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_storage">Cil.d_storage</A> - print a storage specifier
-</UL>
-You can even customize the pretty-printer by creating instances of
-<A HREF="api/Cil.cilPrinter.html#.">Cil.cilPrinter..</A> Typically such an instance extends
-<A HREF="api/Cil.html#VALdefaultCilPrinter">Cil.defaultCilPrinter</A>. Once you have a customized pretty-printer you
-can use the following printing functions:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<A HREF="api/Cil.html#VALprintExp">Cil.printExp</A> - print an expression
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintType">Cil.printType</A> - print a type
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintLval">Cil.printLval</A> - print an lvalue
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintGlobal">Cil.printGlobal</A> - print a global
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintStmt">Cil.printStmt</A> - print a statment
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintInstr">Cil.printInstr</A> - print an instruction
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintInit">Cil.printInit</A> - print an initializer
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintAttr">Cil.printAttr</A> - print an attribute
-<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintAttrs">Cil.printAttrs</A> - print a set of attributes
-</UL>
-CIL has certain internal consistency invariants. For example, all references
-to a global variable must point to the same <TT>varinfo</TT> structure. This
-ensures that one can rename the variable by changing the name in the
-<TT>varinfo</TT>. These constraints are mentioned in the API documentation. There
-is also a consistency checker in file <TT>src/check.ml</TT>. If you suspect that
-your transformation is breaking these constraints then you can pass the
-<TT>--check</TT> option to cilly and this will ensure that the consistency checker
-is run after each transformation. <BR>
-<BR>
-<A NAME="toc6"></A>
-<H3 CLASS="subsection"><A NAME="htoc13">6.4</A> Attributes</H3><A NAME="sec-attrib"></A>
-In CIL you can attach attributes to types and to names (variables, functions
-and fields). Attributes are represented using the type <A HREF="api/Cil.html#TYPEattribute">Cil.attribute</A>.
-An attribute consists of a name and a number of arguments (represented using
-the type <A HREF="api/Cil.html#TYPEattrparam">Cil.attrparam</A>). Almost any expression can be used as an
-attribute argument. Attributes are stored in lists sorted by the name of the
-attribute. To maintain list ordering, use the functions
-<A HREF="api/Cil.html#VALtypeAttrs">Cil.typeAttrs</A> to retrieve the attributes of a type and the functions
-<A HREF="api/Cil.html#VALaddAttribute">Cil.addAttribute</A> and <A HREF="api/Cil.html#VALaddAttributes">Cil.addAttributes</A> to add attributes.
-Alternatively you can use <A HREF="api/Cil.html#VALtypeAddAttributes">Cil.typeAddAttributes</A> to add an attribute to
-a type (and return the new type).<BR>
-<BR>
-GCC already has extensive support for attributes, and CIL extends this
-support to user-defined attributes. A GCC attribute has the syntax:
-<PRE CLASS="verbatim">
- gccattribute ::= __attribute__((attribute)) (Note the double parentheses)
-</PRE>
- Since GCC and MSVC both support various flavors of each attribute (with or
-without leading or trailing _) we first strip ALL leading and trailing _
-from the attribute name (but not the identified in [ACons] parameters in
-<A HREF="api/Cil.html#TYPEattrparam">Cil.attrparam</A>). When we print attributes, for GCC we add two leading
-and two trailing _; for MSVC we add just two leading _.<BR>
-<BR>
-There is support in CIL so that you can control the printing of attributes
-(see <A HREF="api/Cil.html#VALsetCustomPrintAttribute">Cil.setCustomPrintAttribute</A> and
-<A HREF="api/Cil.html#VALsetCustomPrintAttributeScope">Cil.setCustomPrintAttributeScope</A>). This custom-printing support is now
-used to print the "const" qualifier as "<TT>const</TT>" and not as
-"<TT>__attribute__((const))</TT>".<BR>
-<BR>
-The attributes are specified in declarations. This is unfortunate since the C
-syntax for declarations is already quite complicated and after writing the
-parser and elaborator for declarations I am convinced that few C programmers
-understand it completely. Anyway, this seems to be the easiest way to support
-attributes. <BR>
-<BR>
-Name attributes must be specified at the very end of the declaration, just
-before the <TT>=</TT> for the initializer or before the <TT>,</TT> the separates a
-declaration in a group of declarations or just before the <TT>;</TT> that
-terminates the declaration. A name attribute for a function being defined can
-be specified just before the brace that starts the function body.<BR>
-<BR>
-For example (in the following examples <TT>A1</TT>,...,<TT>An</TT> are type attributes
-and <TT>N</TT> is a name attribute (each of these uses the <TT>__attribute__</TT> syntax):
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x N;
- int x N, * y N = 0, z[] N;
- extern void exit() N;
- int fact(int x) N { ... }
-</FONT></PRE>
-Type attributes can be specified along with the type using the following
- rules:
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
- The type attributes for a base type (int, float, named type, reference
- to struct or union or enum) must be specified immediately following the
- type (actually it is Ok to mix attributes with the specification of the
- type, in between unsigned and int for example).<BR>
-<BR>
-For example:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int A1 x N; /* A1 applies to the type int. An example is an attribute
- "even" restricting the type int to even values. */
- struct foo A1 A2 x; // Both A1 and A2 apply to the struct foo type
-</FONT></PRE><BR>
-<BR>
-<LI CLASS="li-enumerate">The type attributes for a pointer type must be specified immediately
- after the * symbol.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- /* A pointer (A1) to an int (A2) */
- int A2 * A1 x;
- /* A pointer (A1) to a pointer (A2) to a float (A3) */
- float A3 * A2 * A1 x;
-</FONT></PRE>
-Note: The attributes for base types and for pointer types are a strict
- extension of the ANSI C type qualifiers (const, volatile and restrict). In
- fact CIL treats these qualifiers as attributes. <BR>
-<BR>
-<LI CLASS="li-enumerate">The attributes for a function type or for an array type can be
- specified using parenthesized declarators.<BR>
-<BR>
-For example:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- /* A function (A1) from int (A2) to float (A3) */
- float A3 (A1 f)(int A2);
-
- /* A pointer (A1) to a function (A2) that returns an int (A3) */
- int A3 (A2 * A1 pfun)(void);
-
- /* An array (A1) of int (A2) */
- int A2 (A1 x0)[]
-
- /* Array (A1) of pointers (A2) to functions (A3) that take an int (A4) and
- * return a pointer (A5) to int (A6) */
- int A6 * A5 (A3 * A2 (A1 x1)[5])(int A4);
-
-
- /* A function (A4) that takes a float (A5) and returns a pointer (A6) to an
- * int (A7) */
- extern int A7 * A6 (A4 x2)(float A5 x);
-
- /* A function (A1) that takes a int (A2) and that returns a pointer (A3) to
- * a function (A4) that takes a float (A5) and returns a pointer (A6) to an
- * int (A7) */
- int A7 * A6 (A4 * A3 (A1 x3)(int A2 x))(float A5) {
- return & x2;
- }
-</FONT></PRE></OL>
-Note: ANSI C does not allow the specification of type qualifiers for function
-and array types, although it allows for the parenthesized declarator. With
-just a bit of thought (looking at the first few examples above) I hope that
-the placement of attributes for function and array types will seem intuitive.<BR>
-<BR>
-This extension is not without problems however. If you want to refer just to
-a type (in a cast for example) then you leave the name out. But this leads to
-strange conflicts due to the parentheses that we introduce to scope the
-attributes. Take for example the type of x0 from above. It should be written
-as:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int A2 (A1 )[]
-</FONT></PRE>
-But this will lead most C parsers into deep confusion because the parentheses
-around A1 will be confused for parentheses of a function designator. To push
-this problem around (I don't know a solution) whenever we are about to print a
-parenthesized declarator with no name but with attributes, we comment out the
-attributes so you can see them (for whatever is worth) without confusing the
-compiler. For example, here is how we would print the above type:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int A2 /*(A1 )*/[]
-</FONT></PRE>
-
-<H5 CLASS="paragraph">Handling of predefined GCC attributes</H5>
-GCC already supports attributes in a lot of places in declarations. The only
-place where we support attributes and GCC does not is right before the { that
-starts a function body. <BR>
-<BR>
-GCC classifies its attributes in attributes for functions, for variables and
-for types, although the latter category is only usable in definition of struct
-or union types and is not nearly as powerful as the CIL type attributes. We
-have made an effort to reclassify GCC attributes as name and type attributes
-(they only apply for function types). Here is what we came up with:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
- GCC name attributes:<BR>
-<BR>
-section, constructor, destructor, unused, weak, no_instrument_function,
- noreturn, alias, no_check_memory_usage, dllinport, dllexport, exception,
- model<BR>
-<BR>
-Note: the "noreturn" attribute would be more appropriately qualified as a
- function type attribute. But we classify it as a name attribute to make
- it easier to support a similarly named MSVC attribute. <BR>
-<BR>
-<LI CLASS="li-itemize">GCC function type attributes:<BR>
-<BR>
-fconst (printed as "const"), format, regparm, stdcall,
- cdecl, longcall<BR>
-<BR>
-I was not able to completely decipher the position in which these attributes
- must go. So, the CIL elaborator knows these names and applies the following
- rules:
- <UL CLASS="itemize"><LI CLASS="li-itemize">
- All of the name attributes that appear in the specifier part (i.e. at
- the beginning) of a declaration are associated with all declared names. <BR>
-<BR>
-<LI CLASS="li-itemize">All of the name attributes that appear at the end of a declarator are
- associated with the particular name being declared.<BR>
-<BR>
-<LI CLASS="li-itemize">More complicated is the handling of the function type attributes, since
- there can be more than one function in a single declaration (a function
- returning a pointer to a function). Lacking any real understanding of how
- GCC handles this, I attach the function type attribute to the "nearest"
- function. This means that if a pointer to a function is "nearby" the
- attribute will be correctly associated with the function. In truth I pray
- that nobody uses declarations as that of x3 above.
- </UL>
-</UL>
-
-<H5 CLASS="paragraph">Handling of predefined MSVC attributes</H5>
-MSVC has two kinds of attributes, declaration modifiers to be printed before
- the storage specifier using the notation "<TT>__declspec(...)</TT>" and a few
- function type attributes, printed almost as our CIL function type
- attributes. <BR>
-<BR>
-The following are the name attributes that are printed using
- <TT>__declspec</TT> right before the storage designator of the declaration:
- thread, naked, dllimport, dllexport, noreturn<BR>
-<BR>
-The following are the function type attributes supported by MSVC:
- fastcall, cdecl, stdcall<BR>
-<BR>
-It is not worth going into the obscure details of where MSVC accepts these
- type attributes. The parser thinks it knows these details and it pulls
- these attributes from wherever they might be placed. The important thing
- is that MSVC will accept if we print them according to the rules of the CIL
- attributes ! <BR>
-<BR>
-<HR>
-<A HREF="cilly.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil007.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/cil007.html b/cil/doc/cil007.html
deleted file mode 100644
index 7d6c02309fe23a5491608cd93c53e88b50fdeca6..0000000000000000000000000000000000000000
--- a/cil/doc/cil007.html
+++ /dev/null
@@ -1,279 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-The CIL Driver
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="cil006.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="ext.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc14">7</A> The CIL Driver</H2><A NAME="sec-driver"></A>
-We have packaged CIL as an application <TT>cilly</TT> that contains certain
-example modules, such as <TT>logwrites.ml</TT> (a module
-that instruments code to print the addresses of memory locations being
-written). Normally, you write another module like that, add command-line
-options and an invocation of your module in <TT>src/main.ml</TT>. Once you compile
-CIL you will obtain the file <TT>obj/cilly.asm.exe</TT>. <BR>
-<BR>
-We wrote a driver for this executable that makes it easy to invoke your
-analysis on existing C code with very little manual intervention. This driver
-is <TT>bin/cilly</TT> and is quite powerful. Note that the <TT>cilly</TT> script
-is configured during installation with the path where CIL resides. This means
-that you can move it to any place you want. <BR>
-<BR>
-A simple use of the driver is:
-<PRE CLASS="verbatim">
-bin/cilly --save-temps -D HAPPY_MOOD -I myincludes hello.c -o hello
-</PRE>
-<FONT COLOR=blue>--save-temps</FONT> tells CIL to save the resulting output files in the
-current directory. Otherwise, they'll be put in <TT>/tmp</TT> and deleted
-automatically. Not that this is the only CIL-specific flag in the
-list – the other flags use <TT>gcc</TT>'s syntax.<BR>
-<BR>
-This performs the following actions:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-preprocessing using the -D and -I arguments with the resulting
- file left in <TT>hello.i</TT>,
-<LI CLASS="li-itemize">the invocation of the <TT>cilly.asm</TT> application which parses <TT>hello.i</TT>
- converts it to CIL and the pretty-prints it to <TT>hello.cil.c</TT>
-<LI CLASS="li-itemize">another round of preprocessing with the result placed in <TT>hello.cil.i</TT>
-<LI CLASS="li-itemize">the true compilation with the result in <TT>hello.cil.o</TT>
-<LI CLASS="li-itemize">a linking phase with the result in <TT>hello</TT>
-</UL>
-Note that <TT>cilly</TT> behaves like the <TT>gcc</TT> compiler. This makes it
-easy to use it with existing <TT>Makefiles</TT>:
-<PRE CLASS="verbatim">
-make CC="bin/cilly" LD="bin/cilly"
-</PRE>
- <TT>cilly</TT> can also behave as the Microsoft Visual C compiler, if the first
- argument is <TT>--mode=MSVC</TT>:
-<PRE CLASS="verbatim">
-bin/cilly --mode=MSVC /D HAPPY_MOOD /I myincludes hello.c /Fe hello.exe
-</PRE>
- (This in turn will pass a <TT>--MSVC</TT> flag to the underlying <TT>cilly.asm</TT>
- process which will make it understand the Microsoft Visual C extensions)<BR>
-<BR>
-<TT>cilly</TT> can also behave as the archiver <TT>ar</TT>, if it is passed an
-argument <TT>--mode=AR</TT>. Note that only the <TT>cr</TT> mode is supported (create a
-new archive and replace all files in there). Therefore the previous version of
-the archive is lost. <BR>
-<BR>
-Furthermore, <TT>cilly</TT> allows you to pass some arguments on to the
-underlying <TT>cilly.asm</TT> process. As a general rule all arguments that start
-with <TT>--</TT> and that <TT>cilly</TT> itself does not process, are passed on. For
-example,
-<PRE CLASS="verbatim">
-bin/cilly --dologwrites -D HAPPY_MOOD -I myincludes hello.c -o hello.exe
-</PRE>
- will produce a file <TT>hello.cil.c</TT> that prints all the memory addresses
-written by the application. <BR>
-<BR>
-The most powerful feature of <TT>cilly</TT> is that it can collect all the
-sources in your project, merge them into one file and then apply CIL. This
-makes it a breeze to do whole-program analysis and transformation. All you
-have to do is to pass the <TT>--merge</TT> flag to <TT>cilly</TT>:
-<PRE CLASS="verbatim">
-make CC="bin/cilly --save-temps --dologwrites --merge"
-</PRE>
- You can even leave some files untouched:
-<PRE CLASS="verbatim">
-make CC="bin/cilly --save-temps --dologwrites --merge --leavealone=foo --leavealone=bar"
-</PRE>
- This will merge all the files except those with the basename <TT>foo</TT> and
-<TT>bar</TT>. Those files will be compiled as usual and then linked in at the very
-end. <BR>
-<BR>
-The sequence of actions performed by <TT>cilly</TT> depends on whether merging
-is turned on or not:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-If merging is off
- <OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
- For every file <TT>file.c</TT> to compile
- <OL CLASS="enumerate" type=a><LI CLASS="li-enumerate">
- Preprocess the file with the given arguments to
- produce <TT>file.i</TT>
- <LI CLASS="li-enumerate">Invoke <TT>cilly.asm</TT> to produce a <TT>file.cil.c</TT>
- <LI CLASS="li-enumerate">Preprocess to <TT>file.cil.i</TT>
- <LI CLASS="li-enumerate">Invoke the underlying compiler to produce <TT>file.cil.o</TT>
- </OL>
- <LI CLASS="li-enumerate">Link the resulting objects
- </OL>
-<LI CLASS="li-itemize">If merging is on
- <OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
- For every file <TT>file.c</TT> to compile
- <OL CLASS="enumerate" type=a><LI CLASS="li-enumerate">
- Preprocess the file with the given arguments to
- produce <TT>file.i</TT>
- <LI CLASS="li-enumerate">Save the preprocessed source as <TT>file.o</TT>
- </OL>
- <LI CLASS="li-enumerate">When linking executable <TT>hello.exe</TT>, look at every object
- file that must be linked and see if it actually
- contains preprocessed source. Pass all those files to a
- special merging application (described in
- Section <A HREF="merger.html#sec-merger">13</A>) to produce <TT>hello.exe_comb.c</TT>
- <LI CLASS="li-enumerate">Invoke <TT>cilly.asm</TT> to produce a <TT>hello.exe_comb.cil.c</TT>
- <LI CLASS="li-enumerate">Preprocess to <TT>hello.exe_comb.cil.i</TT>
- <LI CLASS="li-enumerate">Invoke the underlying compiler to produce <TT>hello.exe_comb.cil.o</TT>
- <LI CLASS="li-enumerate">Invoke the actual linker to produce <TT>hello.exe</TT>
- </OL>
-</UL>
-Note that files that you specify with <TT>--leavealone</TT> are not merged and
-never presented to CIL. They are compiled as usual and then are linked in at
-the end. <BR>
-<BR>
-And a final feature of <TT>cilly</TT> is that it can substitute copies of the
-system's include files:
-<PRE CLASS="verbatim">
-make CC="bin/cilly --includedir=myinclude"
-</PRE>
- This will force the preprocessor to use the file <TT>myinclude/xxx/stdio.h</TT>
-(if it exists) whenever it encounters <TT>#include <stdio.h></TT>. The <TT>xxx</TT> is
-a string that identifies the compiler version you are using. This modified
-include files should be produced with the patcher script (see
-Section <A HREF="patcher.html#sec-patcher">14</A>).<BR>
-<BR>
-<A NAME="toc7"></A>
-<H3 CLASS="subsection"><A NAME="htoc15">7.1</A> <TT>cilly</TT> Options</H3>
-Among the options for the <TT>cilly</TT> you can put anything that can normally
-go in the command line of the compiler that <TT>cilly</TT> is impersonating.
-<TT>cilly</TT> will do its best to pass those options along to the appropriate
-subprocess. In addition, the following options are supported (a complete and
-up-to-date list can always be obtained by running <TT>cilly --help</TT>):
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>--mode=mode</TT> This must be the first argument if present. It makes
-<TT>cilly</TT> behave as a given compiled. The following modes are recognized:
- <UL CLASS="itemize"><LI CLASS="li-itemize">
- GNUCC - the GNU C Compiler. This is the default.
- <LI CLASS="li-itemize">MSVC - the Microsoft Visual C compiler. Of course, you should
- pass only MSVC valid options in this case.
- <LI CLASS="li-itemize">AR - the archiver <TT>ar</TT>. Only the mode <TT>cr</TT> is supported and
- the original version of the archive is lost.
- </UL>
-<LI CLASS="li-itemize"><TT>--help</TT> Prints a list of the options supported.
-<LI CLASS="li-itemize"><TT>--verbose</TT> Prints lots of messages about what is going on.
-<LI CLASS="li-itemize"><TT>--stages</TT> Less than <TT>--verbose</TT> but lets you see what <TT>cilly</TT>
- is doing.
-<LI CLASS="li-itemize"><TT>--merge</TT> This tells <TT>cilly</TT> to first attempt to collect into one
-source file all of the sources that make your application, and then to apply
-<TT>cilly.asm</TT> on the resulting source. The sequence of actions in this case is
-described above and the merger itself is described in Section <A HREF="merger.html#sec-merger">13</A>.<BR>
-<BR>
-<LI CLASS="li-itemize"><TT>--leavealone=xxx</TT>. Do not merge and do not present to CIL the files
-whose basename is "xxx". These files are compiled as usual and linked in at
-the end.
-<LI CLASS="li-itemize"><TT>--includedir=xxx</TT>. Override the include files with those in the given
-directory. The given directory is the same name that was given an an argument
-to the patcher (see Section <A HREF="patcher.html#sec-patcher">14</A>). In particular this means that
-that directory contains subdirectories named based on the current compiler
-version. The patcher creates those directories.
-<LI CLASS="li-itemize"><TT>--usecabs</TT>. Do not CIL, but instead just parse the source and print
-its AST out. This should looked like the preprocessed file. This is useful
-when you suspect that the conversion to CIL phase changes the meaning of the
-program.
-<LI CLASS="li-itemize"><TT>--save-temps=xxx</TT>. Temporary files are preserved in the xxx
- directory. For example, the output of CIL will be put in a file
- named <TT>*.cil.c</TT>.
-<LI CLASS="li-itemize"><TT>--save-temps</TT>. Temporay files are preserved in the current directory.
-</UL>
-<A NAME="toc8"></A>
-<H3 CLASS="subsection"><A NAME="htoc16">7.2</A> <TT>cilly.asm</TT> Options</H3>
- <A NAME="sec-cilly-asm-options"></A>
-All of the options that start with <TT>--</TT> and are not understood by
-<TT>cilly</TT> are passed on to <TT>cilly.asm</TT>. <TT>cilly</TT> also passes along to
-<TT>cilly.asm</TT> flags such as <TT>--MSVC</TT> that both need to know
-about. The following options are supported:<BR>
-<BR>
- <B>General Options:</B>
-<UL CLASS="itemize"><LI CLASS="li-itemize">
- <TT>--version</TT> output version information and exit
- <LI CLASS="li-itemize"><TT>--verbose</TT> Print lots of random stuff. This is passed on from cilly
- <LI CLASS="li-itemize"><TT>--warnall</TT> Show all warnings.
- <LI CLASS="li-itemize"><TT>--debug=xxx</TT> turns on debugging flag xxx
- <LI CLASS="li-itemize"><TT>--nodebug=xxx</TT> turns off debugging flag xxx
- <LI CLASS="li-itemize"><TT>--flush</TT> Flush the output streams often (aids debugging).
- <LI CLASS="li-itemize"><TT>--check</TT> Run a consistency check over the CIL after every operation.
- <LI CLASS="li-itemize"><TT>--nocheck</TT> turns off consistency checking of CIL.
- <LI CLASS="li-itemize"><TT>--noPrintLn</TT> Don't output #line directives in the output.
- <LI CLASS="li-itemize"><TT>--commPrintLn</TT> Print #line directives in the output, but
- put them in comments.
- <LI CLASS="li-itemize"><TT>--log=xxx</TT> Set the name of the log file. By default stderr is used
- <LI CLASS="li-itemize"><TT>--MSVC</TT> Enable MSVC compatibility. Default is GNU.
- <LI CLASS="li-itemize"><TT>--ignore-merge-conflicts</TT> ignore merging conflicts.
- <LI CLASS="li-itemize"><TT>--extrafiles=filename</TT>: the name of a file that contains
- a list of additional files to process, separated by whitespace.
- <LI CLASS="li-itemize"><TT>--stats</TT> Print statistics about the running time of the
- parser, conversion to CIL, etc. Also prints memory-usage
- statistics. You can time parts of your own code as well. Calling
- (<TT>Stats.time “label” func arg</TT>) will evaluate <TT>(func arg)</TT>
- and remember how long this takes. If you call <TT>Stats.time</TT>
- repeatedly with the same label, CIL will report the aggregate
- time.<BR>
-<BR>
-If available, CIL uses the x86 performance counters for these
- stats. This is very precise, but results in “wall-clock time.”
- To report only user-mode time, find the call to <TT>Stats.reset</TT> in
- <TT>main.ml</TT>, and change it to <TT>Stats.reset false</TT>.<BR>
-<BR>
-<B>Lowering Options</B>
- <LI CLASS="li-itemize"><TT>--noLowerConstants</TT> do not lower constant expressions.
- <LI CLASS="li-itemize"><TT>--noInsertImplicitCasts</TT> do not insert implicit casts.
- <LI CLASS="li-itemize"><TT>--forceRLArgEval</TT> Forces right to left evaluation of function arguments.
- <LI CLASS="li-itemize"><TT>--disallowDuplication</TT> Prevent small chunks of code from being duplicated.
- <LI CLASS="li-itemize"><TT>--keepunused</TT> Do not remove the unused variables and types.
- <LI CLASS="li-itemize"><TT>--rmUnusedInlines</TT> Delete any unused inline functions. This is the default in MSVC mode.<BR>
-<BR>
-<B>Output Options:</B>
- <LI CLASS="li-itemize"><TT>--printCilAsIs</TT> Do not try to simplify the CIL when
- printing. Without this flag, CIL will attempt to produce prettier
- output by e.g. changing <TT>while(1)</TT> into more meaningful loops.
- <LI CLASS="li-itemize"><TT>--noWrap</TT> do not wrap long lines when printing
- <LI CLASS="li-itemize"><TT>--out=xxx</TT> the name of the output CIL file. <TT>cilly</TT>
- sets this for you.
- <LI CLASS="li-itemize"><TT>--mergedout=xxx</TT> specify the name of the merged file
- <LI CLASS="li-itemize"><TT>--cabsonly=xxx</TT> CABS output file name
-<BR>
-<BR>
- <B>Selected features.</B> See Section <A HREF="ext.html#sec-Extension">8</A> for more information.
-<LI CLASS="li-itemize"><TT>--dologcalls</TT>. Insert code in the processed source to print the name of
-functions as are called. Implemented in <TT>src/ext/logcalls.ml</TT>.
-<LI CLASS="li-itemize"><TT>--dologwrites</TT>. Insert code in the processed source to print the
-address of all memory writes. Implemented in <TT>src/ext/logwrites.ml</TT>.
-<LI CLASS="li-itemize"><TT>--dooneRet</TT>. Make each function have at most one 'return'.
-Implemented in <TT>src/ext/oneret.ml</TT>.
-<LI CLASS="li-itemize"><TT>--dostackGuard</TT>. Instrument function calls and returns to
-maintain a separate stack for return addresses. Implemeted in
-<TT>src/ext/heapify.ml</TT>.
-<LI CLASS="li-itemize"><TT>--domakeCFG</TT>. Make the program look more like a CFG. Implemented
-in <TT>src/cil.ml</TT>.
-<LI CLASS="li-itemize"><TT>--dopartial</TT>. Do interprocedural partial evaluation and
-constant folding. Implemented in <TT>src/ext/partial.ml</TT>.
-<LI CLASS="li-itemize"><TT>--dosimpleMem</TT>. Simplify all memory expressions. Implemented in
-<TT>src/ext/simplemem.ml</TT>. <BR>
-<BR>
-For an up-to-date list of available options, run <TT>cilly.asm --help</TT>. </UL>
-<HR>
-<A HREF="cil006.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="ext.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/cil009.html b/cil/doc/cil009.html
deleted file mode 100644
index f408d00620a5a844add3fc92641e58763e339d4b..0000000000000000000000000000000000000000
--- a/cil/doc/cil009.html
+++ /dev/null
@@ -1,48 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-Controlling CIL
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="ext.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil010.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc35">9</A> Controlling CIL</H2>
-In the process of converting a C file to CIL we drop the unused prototypes
-and even inline function definitions. This results in much smaller files. If
-you do not want this behavior then you must pass the <TT>--keepunused</TT> argument
-to the CIL application. <BR>
-<BR>
-Alternatively you can put the following pragma in the code (instructing CIL
-to specifically keep the declarations and definitions of the function
-<TT>func1</TT> and variable <TT>var2</TT>, the definition of type <TT>foo</TT> and of
-structure <TT>bar</TT>):
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-#pragma cilnoremove("func1", "var2", "type foo", "struct bar")
-</FONT></PRE>
-<HR>
-<A HREF="ext.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil010.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/cil010.html b/cil/doc/cil010.html
deleted file mode 100644
index e7b1e4b08b8c07e919920c67822966a7f3c1f3c6..0000000000000000000000000000000000000000
--- a/cil/doc/cil010.html
+++ /dev/null
@@ -1,100 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-GCC Extensions
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="cil009.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil011.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc36">10</A> GCC Extensions</H2>
-The CIL parser handles most of the <TT>gcc</TT>
-<A HREF="javascript:loadTop('http://gcc.gnu.org/onlinedocs/gcc-3.0.2/gcc_5.html#SEC67')">extensions</A>
-and compiles them to CIL. The following extensions are not handled (note that
-we are able to compile a large number of programs, including the Linux kernel,
-without encountering these):
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
-Nested function definitions.
-<LI CLASS="li-enumerate">Constructing function calls.
-<LI CLASS="li-enumerate">Naming an expression's type.
-<LI CLASS="li-enumerate">Complex numbers
-<LI CLASS="li-enumerate">Hex floats
-<LI CLASS="li-enumerate">Subscripts on non-lvalue arrays.
-<LI CLASS="li-enumerate">Forward function parameter declarations
-</OL>
-The following extensions are handled, typically by compiling them away:
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
-Attributes for functions, variables and types. In fact, we have a clear
-specification (see Section <A HREF="cil006.html#sec-attrib">6.4</A>) of how attributes are interpreted. The
-specification extends that of <TT>gcc</TT>.
-<LI CLASS="li-enumerate">Old-style function definitions and prototypes. These are translated to
-new-style.
-<LI CLASS="li-enumerate">Locally-declared labels. As part of the translation to CIL, we generate
-new labels as needed.
-<LI CLASS="li-enumerate">Labels as values and computed goto. This allows a program to take the
-address of a label and to manipulate it as any value and also to perform a
-computed goto. We compile this by assigning each label whose address is taken
-a small integer that acts as its address. Every computed <TT>goto</TT> in the body
-of the function is replaced with a <TT>switch</TT> statement. If you want to invoke
-the label from another function, you are on your own (the <TT>gcc</TT>
-documentation says the same.)
-<LI CLASS="li-enumerate">Generalized lvalues. You can write code like <TT>(a, b) += 5</TT> and it gets
-translated to CIL.
-<LI CLASS="li-enumerate">Conditionals with omitted operands. Things like <TT>x ? : y</TT> are
-translated to CIL.
-<LI CLASS="li-enumerate">Double word integers. The type <TT>long long</TT> and the <TT>LL</TT> suffix on
-constants is understood. This is currently interpreted as 64-bit integers.
-<LI CLASS="li-enumerate">Local arrays of variable length. These are converted to uses of
-<TT>alloca</TT>, the array variable is replaced with a pointer to the allocated
-array and the instances of <TT>sizeof(a)</TT> are adjusted to return the size of
-the array and not the size of the pointer.
-<LI CLASS="li-enumerate">Non-constant local initializers. Like all local initializers these are
-compiled into assignments.
-<LI CLASS="li-enumerate">Compound literals. These are also turned into assignments.
-<LI CLASS="li-enumerate">Designated initializers. The CIL parser actually supports the full ISO
-syntax for initializers, which is more than both <TT>gcc</TT> and <TT>MSVC</TT>. I
-(George) think that this is the most complicated part of the C language and
-whoever designed it should be banned from ever designing languages again.
-<LI CLASS="li-enumerate">Case ranges. These are compiled into separate cases. There is no code
-duplication, just a larger number of <TT>case</TT> statements.
-<LI CLASS="li-enumerate">Transparent unions. This is a strange feature that allows you to define
-a function whose formal argument has a (tranparent) union type, but the
-argument is called as if it were the first element of the union. This is
-compiled away by saying that the type of the formal argument is that of the
-first field, and the first thing in the function body we copy the formal into
-a union. <BR>
-<BR>
-<LI CLASS="li-enumerate">Inline assembly-language. The full syntax is supported and it is carried
-as such in CIL.<BR>
-<BR>
-<LI CLASS="li-enumerate">Function names as strings. The identifiers <TT>__FUNCTION__</TT> and
-<TT>__PRETTY_FUNCTION__</TT> are replaced with string literals. <BR>
-<BR>
-<LI CLASS="li-enumerate">Keywords <TT>typeof</TT>, <TT>alignof</TT>, <TT>inline</TT> are supported.
-</OL>
-<HR>
-<A HREF="cil009.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil011.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/cil011.html b/cil/doc/cil011.html
deleted file mode 100644
index 975c8dd862ed8ae501d1982ecf8c1eb8b349dae3..0000000000000000000000000000000000000000
--- a/cil/doc/cil011.html
+++ /dev/null
@@ -1,53 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-CIL Limitations
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="cil010.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil012.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc37">11</A> CIL Limitations</H2>
-There are several implementation details of CIL that might make it unusable
- or less than ideal for certain tasks:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-CIL operates after preprocessing. If you need to see comments, for
-example, you cannot use CIL. But you can use attributes and pragmas instead.
-And there is some support to help you patch the include files before they are
-seen by the preprocessor. For example, this is how we turn some
-<TT>#define</TT>s that we don't like into function calls. <BR>
-<BR>
-<LI CLASS="li-itemize">CIL does transform the code in a non-trivial way. This is done in order
-to make most analyses easier. But if you want to see the code <TT>e1, e2++</TT>
-exactly as it appears in the code, then you should not use CIL. <BR>
-<BR>
-<LI CLASS="li-itemize">CIL removes all local scopes and moves all variables to function
-scope. It also separates a declaration with an initializer into a declaration
-plus an assignment. The unfortunate effect of this transformation is that
-local variables cannot have the <TT>const</TT> qualifier.</UL>
-<HR>
-<A HREF="cil010.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil012.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/cil012.html b/cil/doc/cil012.html
deleted file mode 100644
index 5d18fd52daa0b8fe83781763260e27f339a9832a..0000000000000000000000000000000000000000
--- a/cil/doc/cil012.html
+++ /dev/null
@@ -1,133 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-Known Bugs and Limitations
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="cil011.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="merger.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc38">12</A> Known Bugs and Limitations</H2>
-<UL CLASS="itemize"><LI CLASS="li-itemize">In the new versions of <TT>glibc</TT> there is a function
- <TT>__builtin_va_arg</TT> that takes a type as its second argument. CIL
- handles that through a slight trick. As it parses the function it changes a
- call like:
-<PRE CLASS="verbatim">
- mytype x = __builtin_va_arg(marker, mytype)
-</PRE>into
-<PRE CLASS="verbatim">
- mytype x;
- __builtin_va_arg(marker, sizeof(mytype), &x);
-</PRE>
- The latter form is used internally in CIL. However, the CIL pretty printer
- will try to emit the original code. <BR>
-<BR>
-Similarly, <TT>__builtin_types_compatible_p(t1, t2)</TT>, which takes
- types as arguments, is represented internally as
- <TT>__builtin_types_compatible_p(sizeof t1, sizeof t2)</TT>, but the
- sizeofs are removed when printing.<BR>
-<BR>
-<LI CLASS="li-itemize">The implementation of <TT>bitsSizeOf</TT> does not take into account the
-packing pragmas. However it was tested to be accurate on cygwin/gcc-2.95.3,
-Linux/gcc-2.95.3 and on Windows/MSVC.<BR>
-<BR>
-<LI CLASS="li-itemize">We do not support tri-graph sequences (ISO 5.2.1.1).<BR>
-<BR>
-<LI CLASS="li-itemize">GCC has a strange feature called “extern inline”. Such a function can
-be defined twice: first with the “extern inline” specifier and the second
-time without it. If optimizations are turned off then the “extern inline”
-definition is considered a prototype (its body is ignored). If optimizations
-are turned on then the extern inline function is inlined at all of its
-occurrences from the point of its definition all the way to the point where the
-(optional) second definition appears. No body is generated for an extern
-inline function. A body is generated for the real definition and that one is
-used in the rest of the file. <BR>
-<BR>
-CIL will rename your extern inline function (and its uses) with the suffix
- <TT>__extinline</TT>. This means that if you have two such definition, that do
- different things and the optimizations are not on, then the CIL version might
- compute a different answer !<BR>
-<BR>
-Also, if you have multiple extern inline declarations then CIL will ignore
-but the first one. This is not so bad because GCC itself would not like it. <BR>
-<BR>
-<LI CLASS="li-itemize">There are still a number of bugs in handling some obscure features of
-GCC. For example, when you use variable-length arrays, CIL turns them into
-calls to <TT>alloca</TT>. This means that they are deallocated when the function
-returns and not when the local scope ends. <BR>
-<BR>
-Variable-length arrays are not supported as fields of a struct or union.<BR>
-<BR>
-<LI CLASS="li-itemize">CIL cannot parse arbitrary <TT>#pragma</TT> directives. Their
- syntax must follow gcc's attribute syntax to be understood. If you
- need a pragma that does not follow gcc syntax, add that pragma's name
- to <TT>no_parse_pragma</TT> in <TT>src/frontc/clexer.mll</TT> to indicate that
- CIL should treat that pragma as a monolithic string rather than try
- to parse its arguments.<BR>
-<BR>
-CIL cannot parse a line containing an empty <TT>#pragma</TT>.<BR>
-<BR>
-<LI CLASS="li-itemize">CIL only parses <TT>#pragma</TT> directives at the "top level", this is,
- outside of any enum, structure, union, or function definitions.<BR>
-<BR>
-If your compiler uses pragmas in places other than the top-level,
- you may have to preprocess the sources in a special way (sed, perl,
- etc.) to remove pragmas from these locations.<BR>
-<BR>
-<LI CLASS="li-itemize">CIL cannot parse the following code (fixing this problem would require
-extensive hacking of the LALR grammar):
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-int bar(int ()); // This prototype cannot be parsed
-int bar(int x()); // If you add a name to the function, it works
-int bar(int (*)()); // This also works (and it is more appropriate)
-</FONT></PRE><BR>
-<BR>
-<LI CLASS="li-itemize">CIL also cannot parse certain K&R old-style prototypes with missing
-return type:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-g(); // This cannot be parsed
-int g(); // This is Ok
-</FONT></PRE><BR>
-<BR>
-<LI CLASS="li-itemize">CIL does not understand some obscure combinations of type specifiers
-(“signed” and “unsigned” applied to typedefs that themselves contain a
-sign specification; you could argue that this should not be allowed anyway):
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-typedef signed char __s8;
-__s8 unsigned uchartest; // This is unsigned char for gcc
-</FONT></PRE><BR>
-<BR>
-<LI CLASS="li-itemize">The statement <TT>x = 3 + x ++</TT> will perform the increment of <TT>x</TT>
- before the assignment, while <TT>gcc</TT> delays the increment after the
- assignment. It turned out that this behavior is much easier to implement
- than gcc's one, and either way is correct (since the behavior is unspecified
- in this case). Similarly, if you write <TT>x = x ++;</TT> then CIL will perform
- the increment before the assignment, whereas GCC and MSVC will perform it
- after the assignment.
-</UL>
-<HR>
-<A HREF="cil011.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="merger.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/cil015.html b/cil/doc/cil015.html
deleted file mode 100644
index a3dff7d73f4475fbb79cb77d4452d2d3bbeb3441..0000000000000000000000000000000000000000
--- a/cil/doc/cil015.html
+++ /dev/null
@@ -1,60 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-Debugging support
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="patcher.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil016.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc41">15</A> Debugging support</H2><A NAME="sec-debugger"></A>
-Most of the time we debug our code using the Errormsg module along with the
-pretty printer. But if you want to use the Ocaml debugger here is an easy way
-to do it. Say that you want to debug the invocation of cilly that arises out
-of the following command:
-<PRE CLASS="verbatim">
-cilly -c hello.c
-</PRE>
- You must follow the installation <A HREF="../ccured/setup.html">instructions</A>
-to install the Elist support files for ocaml and to extend your .emacs
-appropriately. Then from within Emacs you do
-<PRE CLASS="verbatim">
-ALT-X my-camldebug
-</PRE>
- This will ask you for the command to use for running the Ocaml debugger
-(initially the default will be “ocamldebug” or the last command you
-introduced). You use the following command:
-<PRE CLASS="verbatim">
-cilly --ocamldebug -c hello.c
-</PRE>
- This will run <TT>cilly</TT> as usual and invoke the Ocaml debugger when the cilly
-engine starts. The advantage of this way of invoking the debugger is that the
-directory search paths are set automatically and the right set or arguments is
-passed to the debugger. <BR>
-<BR>
-<HR>
-<A HREF="patcher.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil016.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/cil016.html b/cil/doc/cil016.html
deleted file mode 100644
index 3191a9d572e22dfac214910d7523d3ffbd8f86b0..0000000000000000000000000000000000000000
--- a/cil/doc/cil016.html
+++ /dev/null
@@ -1,342 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-Who Says C is Simple?
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="cil015.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil017.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc42">16</A> Who Says C is Simple?</H2><A NAME="sec-simplec"></A>
-When I (George) started to write CIL I thought it was going to take two weeks.
-Exactly a year has passed since then and I am still fixing bugs in it. This
-gross underestimate was due to the fact that I thought parsing and making
-sense of C is simple. You probably think the same. What I did not expect was
-how many dark corners this language has, especially if you want to parse
-real-world programs such as those written for GCC or if you are more ambitious
-and you want to parse the Linux or Windows NT sources (both of these were
-written without any respect for the standard and with the expectation that
-compilers will be changed to accommodate the program). <BR>
-<BR>
-The following examples were actually encountered either in real programs or
-are taken from the ISO C99 standard or from the GCC's testcases. My first
-reaction when I saw these was: <EM>Is this C?</EM>. The second one was : <EM>What the hell does it mean?</EM>. <BR>
-<BR>
-If you are contemplating doing program analysis for C on abstract-syntax
-trees then your analysis ought to be able to handle these things. Or, you can
-use CIL and let CIL translate them into clean C code. <BR>
-<BR>
-<A NAME="toc24"></A>
-<H3 CLASS="subsection"><A NAME="htoc43">16.1</A> Standard C</H3>
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">Why does the following code return 0 for most values of <TT>x</TT>? (This
-should be easy.)
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x;
- return x == (1 && x);
-</FONT></PRE>
-See the <A HREF="examples/ex30.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Why does the following code return 0 and not -1? (Answer: because
-<TT>sizeof</TT> is unsigned, thus the result of the subtraction is unsigned, thus
-the shift is logical.)
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- return ((1 - sizeof(int)) >> 32);
-</FONT></PRE>
-See the <A HREF="examples/ex31.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Scoping rules can be tricky. This function returns 5.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-int x = 5;
-int f() {
- int x = 3;
- {
- extern int x;
- return x;
- }
-}
-</FONT></PRE>
-See the <A HREF="examples/ex32.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Functions and function pointers are implicitly converted to each other.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-int (*pf)(void);
-int f(void) {
-
- pf = &f; // This looks ok
- pf = ***f; // Dereference a function?
- pf(); // Invoke a function pointer?
- (****pf)(); // Looks strange but Ok
- (***************f)(); // Also Ok
-}
-</FONT></PRE>
-See the <A HREF="examples/ex33.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Initializer with designators are one of the hardest parts about ISO C.
-Neither MSVC or GCC implement them fully. GCC comes close though. What is the
-final value of <TT>i.nested.y</TT> and <TT>i.nested.z</TT>? (Answer: 2 and respectively
-6).
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-struct {
- int x;
- struct {
- int y, z;
- } nested;
-} i = { .nested.y = 5, 6, .x = 1, 2 };
-</FONT></PRE>
-See the <A HREF="examples/ex34.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">This is from c-torture. This function returns 1.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-typedef struct
-{
- char *key;
- char *value;
-} T1;
-
-typedef struct
-{
- long type;
- char *value;
-} T3;
-
-T1 a[] =
-{
- {
- "",
- ((char *)&((T3) {1, (char *) 1}))
- }
-};
-int main() {
- T3 *pt3 = (T3*)a[0].value;
- return pt3->value;
-}
-</FONT></PRE>
-See the <A HREF="examples/ex35.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Another one with constructed literals. This one is legal according to
-the GCC documentation but somehow GCC chokes on (it works in CIL though). This
-code returns 2.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- return ((int []){1,2,3,4})[1];
-</FONT></PRE>
-See the <A HREF="examples/ex36.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">In the example below there is one copy of “bar” and two copies of
- “pbar” (static prototypes at block scope have file scope, while for all
- other types they have block scope).
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int foo() {
- static bar();
- static (*pbar)() = bar;
-
- }
-
- static bar() {
- return 1;
- }
-
- static (*pbar)() = 0;
-</FONT></PRE>
-See the <A HREF="examples/ex37.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Two years after heavy use of CIL, by us and others, I discovered a bug
- in the parser. The return value of the following function depends on what
- precedence you give to casts and unary minus:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- unsigned long foo() {
- return (unsigned long) - 1 / 8;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex38.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-The correct interpretation is <TT>((unsigned long) - 1) / 8</TT>, which is a
- relatively large number, as opposed to <TT>(unsigned long) (- 1 / 8)</TT>, which
- is 0. </OL>
-<A NAME="toc25"></A>
-<H3 CLASS="subsection"><A NAME="htoc44">16.2</A> GCC ugliness</H3><A NAME="sec-ugly-gcc"></A>
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">GCC has generalized lvalues. You can take the address of a lot of
-strange things:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int x, y, z;
- return &(x ? y : z) - & (x++, x);
-</FONT></PRE>
-See the <A HREF="examples/ex39.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">GCC lets you omit the second component of a conditional expression.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- extern int f();
- return f() ? : -1; // Returns the result of f unless it is 0
-</FONT></PRE>
-See the <A HREF="examples/ex40.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">Computed jumps can be tricky. CIL compiles them away in a fairly clean
-way but you are on your own if you try to jump into another function this way.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-static void *jtab[2]; // A jump table
-static int doit(int x){
-
- static int jtab_init = 0;
- if(!jtab_init) { // Initialize the jump table
- jtab[0] = &&lbl1;
- jtab[1] = &&lbl2;
- jtab_init = 1;
- }
- goto *jtab[x]; // Jump through the table
-lbl1:
- return 0;
-lbl2:
- return 1;
-}
-
-int main(void){
- if (doit(0) != 0) exit(1);
- if (doit(1) != 1) exit(1);
- exit(0);
-}
-</FONT></PRE>
-See the <A HREF="examples/ex41.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">A cute little example that we made up. What is the returned value?
-(Answer: 1);
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- return ({goto L; 0;}) && ({L: 5;});
-</FONT></PRE>
-See the <A HREF="examples/ex42.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate"><TT>extern inline</TT> is a strange feature of GNU C. Can you guess what the
-following code computes?
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-extern inline foo(void) { return 1; }
-int firstuse(void) { return foo(); }
-
-// A second, incompatible definition of foo
-int foo(void) { return 2; }
-
-int main() {
- return foo() + firstuse();
-}
-</FONT></PRE>
-See the <A HREF="examples/ex43.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-The answer depends on whether the optimizations are turned on. If they are
-then the answer is 3 (the first definition is inlined at all occurrences until
-the second definition). If the optimizations are off, then the first
-definition is ignore (treated like a prototype) and the answer is 4. <BR>
-<BR>
-CIL will misbehave on this example, if the optimizations are turned off (it
- always returns 3).<BR>
-<BR>
-<LI CLASS="li-enumerate">GCC allows you to cast an object of a type T into a union as long as the
-union has a field of that type:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-union u {
- int i;
- struct s {
- int i1, i2;
- } s;
-};
-
-union u x = (union u)6;
-
-int main() {
- struct s y = {1, 2};
- union u z = (union u)y;
-}
-</FONT></PRE>
-See the <A HREF="examples/ex44.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">GCC allows you to use the <TT>__mode__</TT> attribute to specify the size
-of the integer instead of the standard <TT>char</TT>, <TT>short</TT> and so on:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-int __attribute__ ((__mode__ ( __QI__ ))) i8;
-int __attribute__ ((__mode__ ( __HI__ ))) i16;
-int __attribute__ ((__mode__ ( __SI__ ))) i32;
-int __attribute__ ((__mode__ ( __DI__ ))) i64;
-</FONT></PRE>
-See the <A HREF="examples/ex45.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<LI CLASS="li-enumerate">The “alias” attribute on a function declaration tells the
- linker to treat this declaration as another name for the specified
- function. CIL will replace the declaration with a trampoline
- function pointing to the specified target.
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- static int bar(int x, char y) {
- return x + y;
- }
-
- //foo is considered another name for bar.
- int foo(int x, char y) __attribute__((alias("bar")));
-</FONT></PRE>
-See the <A HREF="examples/ex46.txt">CIL output</A> for this
-code fragment</OL>
-<A NAME="toc26"></A>
-<H3 CLASS="subsection"><A NAME="htoc45">16.3</A> Microsoft VC ugliness</H3>
-This compiler has few extensions, so there is not much to say here.
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
-Why does the following code return 0 and not -1? (Answer: because of a
-bug in Microsoft Visual C. It thinks that the shift is unsigned just because
-the second operator is unsigned. CIL reproduces this bug when in MSVC mode.)
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- return -3 >> (8 * sizeof(int));
-</FONT></PRE><BR>
-<BR>
-<LI CLASS="li-enumerate">Unnamed fields in a structure seem really strange at first. It seems
-that Microsoft Visual C introduced this extension, then GCC picked it up (but
-in the process implemented it wrongly: in GCC the field <TT>y</TT> overlaps with
-<TT>x</TT>!).
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-struct {
- int x;
- struct {
- int y, z;
- struct {
- int u, v;
- };
- };
-} a;
-return a.x + a.y + a.z + a.u + a.v;
-</FONT></PRE>
-See the <A HREF="examples/ex47.txt">CIL output</A> for this
-code fragment</OL>
-<HR>
-<A HREF="cil015.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil017.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/cil017.html b/cil/doc/cil017.html
deleted file mode 100644
index a9e04eb2e86041a6f9daa6bc183c62a83f6d15ef..0000000000000000000000000000000000000000
--- a/cil/doc/cil017.html
+++ /dev/null
@@ -1,53 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-Authors
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="cil016.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil018.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc46">17</A> Authors</H2>
-The CIL parser was developed starting from Hugues Casse's <TT>frontc</TT>
-front-end for C although all the files from the <TT>frontc</TT> distribution have
-been changed very extensively. The intermediate language and the elaboration
-stage are all written from scratch. The main author is
-<A HREF="mailto:necula@cs.berkeley.edu">George Necula</A>, with significant
-contributions from <A HREF="mailto:smcpeak@cs.berkeley.edu">Scott McPeak</A>,
-<A HREF="mailto:weimer@cs.berkeley.edu">Westley Weimer</A>,
-<A HREF="mailto:liblit@cs.wisc.edu">Ben Liblit</A>,
-<A HREF="javascript:loadTop('http://www.cs.berkeley.edu/~matth/')">Matt Harren</A>,
-Raymond To and Aman Bhargava.<BR>
-<BR>
-This work is based upon work supported in part by the National Science
-Foundation under Grants No. 9875171, 0085949 and 0081588, and gifts from
-Microsoft Research. Any opinions, findings, and conclusions or recommendations
-expressed in this material are those of the author(s) and do not necessarily
-reflect the views of the National Science Foundation or the other sponsors.<BR>
-<BR>
-<HR>
-<A HREF="cil016.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil018.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/cil018.html b/cil/doc/cil018.html
deleted file mode 100644
index dc039eaf1b884c4f4fd3d20eebecd5ea1d100273..0000000000000000000000000000000000000000
--- a/cil/doc/cil018.html
+++ /dev/null
@@ -1,71 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-License
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="cil017.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil019.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc47">18</A> License</H2>
-Copyright (c) 2001-2005,
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-George C. Necula <necula@cs.berkeley.edu>
-<LI CLASS="li-itemize">Scott McPeak <smcpeak@cs.berkeley.edu>
-<LI CLASS="li-itemize">Wes Weimer <weimer@cs.berkeley.edu>
-<LI CLASS="li-itemize">Ben Liblit <liblit@cs.wisc.edu>
-</UL>
-All rights reserved.<BR>
-<BR>
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:<BR>
-<BR>
-1. Redistributions of source code must retain the above copyright notice,
-this list of conditions and the following disclaimer.<BR>
-<BR>
-2. Redistributions in binary form must reproduce the above copyright notice,
-this list of conditions and the following disclaimer in the documentation
-and/or other materials provided with the distribution.<BR>
-<BR>
-3. The names of the contributors may not be used to endorse or promote
-products derived from this software without specific prior written
-permission.<BR>
-<BR>
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
-LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGE.<BR>
-<BR>
-<HR>
-<A HREF="cil017.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil019.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/cil019.html b/cil/doc/cil019.html
deleted file mode 100644
index 84e3f8b60b8869e1f2b945ada65c2e1235a72511..0000000000000000000000000000000000000000
--- a/cil/doc/cil019.html
+++ /dev/null
@@ -1,45 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-Bug reports
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="cil018.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="changes.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc48">19</A> Bug reports</H2>
-We are certain that there are still some remaining bugs in CIL. If you find
-one please file a bug report in our Source Forge space
-<A HREF="javascript:loadTop('http://sourceforge.net/projects/cil')">http://sourceforge.net/projects/cil</A>. <BR>
-<BR>
-You can find there the latest announcements, a source distribution,
-bug report submission instructions and a mailing list: cil-users[at
-sign]lists.sourceforge.net. Please use this list to ask questions about CIL,
-as it will ensure your message is viewed by a broad audience. <BR>
-<BR>
-<HR>
-<A HREF="cil018.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="changes.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/cilly.html b/cil/doc/cilly.html
deleted file mode 100644
index 1a2875815a2f88a73aa4c438c178006535936a7b..0000000000000000000000000000000000000000
--- a/cil/doc/cilly.html
+++ /dev/null
@@ -1,187 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-How to Use CIL
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="cil004.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil006.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc5">5</A> How to Use CIL</H2><A NAME="sec-cil"></A><BR>
-<BR>
-There are two predominant ways to use CIL to write a program analysis or
-transformation. The first is to phrase your analysis as a module that is
-called by our existing driver. The second is to use CIL as a stand-alone
-library. We highly recommend that you use <TT>cilly</TT>, our driver. <BR>
-<BR>
-<A NAME="toc1"></A>
-<H3 CLASS="subsection"><A NAME="htoc6">5.1</A> Using <TT>cilly</TT>, the CIL driver</H3>
-The most common way to use CIL is to write an Ocaml module containing your
-analysis and transformation, which you then link into our boilerplate
-driver application called <TT>cilly</TT>. <TT>cilly</TT> is a Perl script that
-processes and mimics <TT>GCC</TT> and <TT>MSVC</TT> command-line arguments and then
-calls <TT>cilly.byte.exe</TT> or <TT>cilly.asm.exe</TT> (CIL's Ocaml executable). <BR>
-<BR>
-An example of such module is <TT>logwrites.ml</TT>, a transformation that is
-distributed with CIL and whose purpose is to instrument code to print the
-addresses of memory locations being written. (We plan to release a
-C-language interface to CIL so that you can write your analyses in C
-instead of Ocaml.) See Section <A HREF="ext.html#sec-Extension">8</A> for a survey of other example
-modules. <BR>
-<BR>
-Assuming that you have written <TT>/home/necula/logwrites.ml</TT>,
-here is how you use it:
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">Modify <TT>logwrites.ml</TT> so that it includes a CIL “feature
- descriptor” like this:
-<PRE CLASS="verbatim">
-let feature : featureDescr =
- { fd_name = "logwrites";
- fd_enabled = ref false;
- fd_description = "generation of code to log memory writes";
- fd_extraopt = [];
- fd_doit =
- (function (f: file) ->
- let lwVisitor = new logWriteVisitor in
- visitCilFileSameGlobals lwVisitor f)
- }
-</PRE>The <TT>fd_name</TT> field names the feature and its associated
- command-line arguments. The <TT>fd_enabled</TT> field is a <TT>bool ref</TT>.
- “<TT>fd_doit</TT>” will be invoked if <TT>!fd_enabled</TT> is true after
- argument parsing, so initialize the ref cell to true if you want
- this feature to be enabled by default.<BR>
-<BR>
-When the user passes the <TT>--dologwrites</TT>
- command-line option to <TT>cilly</TT>, the variable associated with the
- <TT>fd_enabled</TT> flag is set and the <TT>fd_doit</TT> function is called
- on the <TT>Cil.file</TT> that represents the merger (see Section <A HREF="merger.html#sec-merger">13</A>) of
- all C files listed as arguments. <BR>
-<BR>
-<LI CLASS="li-enumerate">Invoke <TT>configure</TT> with the arguments
-<PRE CLASS="verbatim">
-./configure EXTRASRCDIRS=/home/necula EXTRAFEATURES=logwrites
-</PRE>
- This step works if each feature is packaged into its own ML file, and the
-name of the entry point in the file is <TT>feature</TT>.<BR>
-<BR>
-An alternative way to specify the new features is to change the build files
-yourself, as explained below. You'll need to use this method if a single
-feature is split across multiple files.
-<OL CLASS="enumerate" type=a><LI CLASS="li-enumerate">
- Put <TT>logwrites.ml</TT> in the <TT>src</TT> or <TT>src/ext</TT> directory. This
- will make sure that <TT>make</TT> can find it. If you want to put it in some
- other directory, modify <TT>Makefile.in</TT> and add to <TT>SOURCEDIRS</TT> your
- directory. Alternately, you can create a symlink from <TT>src</TT> or
- <TT>src/ext</TT> to your file.<BR>
-<BR>
-<LI CLASS="li-enumerate">Modify the <TT>Makefile.in</TT> and add your module to the
- <TT>CILLY_MODULES</TT> or
- <TT>CILLY_LIBRARY_MODULES</TT> variables. The order of the modules matters. Add
- your modules somewhere after <TT>cil</TT> and before <TT>main</TT>.<BR>
-<BR>
-<LI CLASS="li-enumerate">If you have any helper files for your module, add those to
- the makefile in the same way. e.g.:
-<PRE CLASS="verbatim">
-CILLY_MODULES = $(CILLY_LIBRARY_MODULES) \
- myutilities1 myutilities2 logwrites \
- main
-</PRE>
- Again, order is important: <TT>myutilities2.ml</TT> will be able to refer
- to Myutilities1 but not Logwrites. If you have any ocamllex or ocamlyacc
- files, add them to both <TT>CILLY_MODULES</TT> and either <TT>MLLS</TT> or
- <TT>MLYS</TT>.<BR>
-<BR>
-<LI CLASS="li-enumerate">Modify <TT>main.ml</TT> so that your new feature descriptor appears in
- the global list of CIL features.
-<PRE CLASS="verbatim">
-let features : C.featureDescr list =
- [ Logcalls.feature;
- Oneret.feature;
- Heapify.feature1;
- Heapify.feature2;
- makeCFGFeature;
- Partial.feature;
- Simplemem.feature;
- Logwrites.feature; (* add this line to include the logwrites feature! *)
- ]
- @ Feature_config.features
-</PRE>
- Features are processed in the order they appear on this list. Put
- your feature last on the list if you plan to run any of CIL's
- built-in features (such as makeCFGfeature) before your own.</OL><BR>
-Standard code in <TT>cilly</TT> takes care of adding command-line arguments,
- printing the description, and calling your function automatically.
- Note: do not worry about introducing new bugs into CIL by adding a single
- line to the feature list. <BR>
-<BR>
-<LI CLASS="li-enumerate">Now you can invoke the <TT>cilly</TT> application on a preprocessed file, or
- instead use the <TT>cilly</TT> driver which provides a convenient compiler-like
- interface to <TT>cilly</TT>. See Section <A HREF="cil007.html#sec-driver">7</A> for details using <TT>cilly</TT>.
- Remember to enable your analysis by passing the right argument (e.g.,
- <TT>--dologwrites</TT>). </OL>
-<A NAME="toc2"></A>
-<H3 CLASS="subsection"><A NAME="htoc7">5.2</A> Using CIL as a library</H3>
-CIL can also be built as a library that is called from your stand-alone
-application. Add <TT>cil/src</TT>, <TT>cil/src/frontc</TT>, <TT>cil/obj/x86_LINUX</TT>
-(or <TT>cil/obj/x86_WIN32</TT>) to your Ocaml project <TT>-I</TT> include paths.
-Building CIL will also build the library <TT>cil/obj/*/cil.cma</TT> (or
-<TT>cil/obj/*/cil.cmxa</TT>). You can then link your application against that
-library. <BR>
-<BR>
-You can call the <TT>Frontc.parse: string -> unit -> Cil.file</TT> function with
-the name of a file containing the output of the C preprocessor.
-The <TT>Mergecil.merge: Cil.file list -> string -> Cil.file</TT> function merges
-multiple files. You can then invoke your analysis function on the resulting
-<TT>Cil.file</TT> data structure. You might want to call
-<TT>Rmtmps.removeUnusedTemps</TT> first to clean up the prototypes and variables
-that are not used. Then you can call the function <TT>Cil.dumpFile:
-cilPrinter -> out_channel -> Cil.file -> unit</TT> to print the file to a
-given output channel. A good <TT>cilPrinter</TT> to use is
-<TT>defaultCilPrinter</TT>. <BR>
-<BR>
-Check out <TT>src/main.ml</TT> and <TT>bin/cilly</TT> for other good ideas
-about high-level file processing. Again, we highly recommend that you just
-our <TT>cilly</TT> driver so that you can avoid spending time re-inventing the
-wheel to provide drop-in support for standard <TT>makefile</TT>s. <BR>
-<BR>
-Here is a concrete example of compiling and linking your project against
-CIL. Imagine that your program analysis or transformation is contained in
-the single file <TT>main.ml</TT>.
-<PRE CLASS="verbatim">
-$ ocamlopt -c -I $(CIL)/obj/x86_LINUX/ main.ml
-$ ocamlopt -ccopt -L$(CIL)/obj/x86_LINUX/ -o main unix.cmxa str.cmxa \
- $(CIL)/obj/x86_LINUX/cil.cmxa main.cmx
-</PRE>
-The first line compiles your analysis, the second line links it against CIL
-(as a library) and the Ocaml Unix library. For more information about
-compiling and linking Ocaml programs, see the Ocaml home page
-at <A HREF="javascript:loadTop('http://caml.inria.fr/ocaml/')">http://caml.inria.fr/ocaml/</A>. <BR>
-<BR>
-In the next section we give an overview of the API that you can use
-to write your analysis and transformation. <BR>
-<BR>
-<HR>
-<A HREF="cil004.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil006.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/cilpp.haux b/cil/doc/cilpp.haux
deleted file mode 100644
index 1b9fa16b7b4362e76f3e9297f47c9c284f35fc9f..0000000000000000000000000000000000000000
--- a/cil/doc/cilpp.haux
+++ /dev/null
@@ -1,64 +0,0 @@
-\@addtocsec{htoc}{1}{0}{\@print{1}\quad{}Introduction}
-\@addtocsec{htoc}{2}{0}{\@print{2}\quad{}Installation}
-\@addtocsec{htoc}{3}{0}{\@print{3}\quad{}Distribution Contents}
-\@addtocsec{htoc}{4}{0}{\@print{4}\quad{}Compiling C to CIL}
-\newlabel{sec-cabs2cil}{{4}{X}}
-\@addtocsec{htoc}{5}{0}{\@print{5}\quad{}How to Use CIL}
-\newlabel{sec-cil}{{5}{X}}
-\@addtocsec{htoc}{6}{1}{\@print{5.1}\quad{}Using \t{cilly}, the CIL driver}
-\@addtocsec{htoc}{7}{1}{\@print{5.2}\quad{}Using CIL as a library}
-\@addtocsec{htoc}{8}{0}{\@print{6}\quad{}CIL API Documentation}
-\newlabel{sec-api}{{6}{X}}
-\@addtocsec{htoc}{9}{1}{\@print{6.1}\quad{}Using the visitor}
-\newlabel{sec-visitor}{{6.1}{X}}
-\@addtocsec{htoc}{10}{1}{\@print{6.2}\quad{}Interpreted Constructors and Deconstructors}
-\@addtocsec{htoc}{11}{2}{\@print{6.2.1}\quad{}Performance considerations for interpreted constructors}
-\@addtocsec{htoc}{12}{1}{\@print{6.3}\quad{}Printing and Debugging support}
-\@addtocsec{htoc}{13}{1}{\@print{6.4}\quad{}Attributes}
-\newlabel{sec-attrib}{{6.4}{X}}
-\@addtocsec{htoc}{14}{0}{\@print{7}\quad{}The CIL Driver}
-\newlabel{sec-driver}{{7}{X}}
-\@addtocsec{htoc}{15}{1}{\@print{7.1}\quad{}\t{cilly} Options}
-\@addtocsec{htoc}{16}{1}{\@print{7.2}\quad{}\t{cilly.asm} Options}
-\newlabel{sec-cilly-asm-options}{{7.2}{X}}
-\@addtocsec{htoc}{17}{0}{\@print{8}\quad{}Library of CIL Modules}
-\newlabel{sec-Extension}{{8}{X}}
-\@addtocsec{htoc}{18}{1}{\@print{8.1}\quad{}Control-Flow Graphs}
-\newlabel{sec-cfg}{{8.1}{X}}
-\@addtocsec{htoc}{19}{2}{\@print{8.1.1}\quad{}The CFG module (new in CIL 1.3.5)}
-\@addtocsec{htoc}{20}{2}{\@print{8.1.2}\quad{}Simplified control flow}
-\@addtocsec{htoc}{21}{1}{\@print{8.2}\quad{}Data flow analysis framework}
-\@addtocsec{htoc}{22}{1}{\@print{8.3}\quad{}Dominators}
-\@addtocsec{htoc}{23}{1}{\@print{8.4}\quad{}Points-to Analysis}
-\@addtocsec{htoc}{24}{1}{\@print{8.5}\quad{}StackGuard}
-\@addtocsec{htoc}{25}{1}{\@print{8.6}\quad{}Heapify}
-\@addtocsec{htoc}{26}{1}{\@print{8.7}\quad{}One Return}
-\@addtocsec{htoc}{27}{1}{\@print{8.8}\quad{}Partial Evaluation and Constant Folding}
-\@addtocsec{htoc}{28}{1}{\@print{8.9}\quad{}Reaching Definitions}
-\@addtocsec{htoc}{29}{1}{\@print{8.10}\quad{}Available Expressions}
-\@addtocsec{htoc}{30}{1}{\@print{8.11}\quad{}Liveness Analysis}
-\@addtocsec{htoc}{31}{1}{\@print{8.12}\quad{}Dead Code Elimination}
-\@addtocsec{htoc}{32}{1}{\@print{8.13}\quad{}Simple Memory Operations}
-\@addtocsec{htoc}{33}{1}{\@print{8.14}\quad{}Simple Three-Address Code}
-\@addtocsec{htoc}{34}{1}{\@print{8.15}\quad{}Converting C to C++}
-\@addtocsec{htoc}{35}{0}{\@print{9}\quad{}Controlling CIL}
-\@addtocsec{htoc}{36}{0}{\@print{10}\quad{}GCC Extensions}
-\@addtocsec{htoc}{37}{0}{\@print{11}\quad{}CIL Limitations}
-\@addtocsec{htoc}{38}{0}{\@print{12}\quad{}Known Bugs and Limitations}
-\@addtocsec{htoc}{39}{0}{\@print{13}\quad{}Using the merger}
-\newlabel{sec-merger}{{13}{X}}
-\@addtocsec{htoc}{40}{0}{\@print{14}\quad{}Using the patcher}
-\newlabel{sec-patcher}{{14}{X}}
-\@addtocsec{htoc}{41}{0}{\@print{15}\quad{}Debugging support}
-\newlabel{sec-debugger}{{15}{X}}
-\@addtocsec{htoc}{42}{0}{\@print{16}\quad{}Who Says C is Simple?}
-\newlabel{sec-simplec}{{16}{X}}
-\@addtocsec{htoc}{43}{1}{\@print{16.1}\quad{}Standard C}
-\@addtocsec{htoc}{44}{1}{\@print{16.2}\quad{}GCC ugliness}
-\newlabel{sec-ugly-gcc}{{16.2}{X}}
-\@addtocsec{htoc}{45}{1}{\@print{16.3}\quad{}Microsoft VC ugliness}
-\@addtocsec{htoc}{46}{0}{\@print{17}\quad{}Authors}
-\@addtocsec{htoc}{47}{0}{\@print{18}\quad{}License}
-\@addtocsec{htoc}{48}{0}{\@print{19}\quad{}Bug reports}
-\@addtocsec{htoc}{49}{0}{\@print{20}\quad{}Changes}
-\newlabel{sec-changes}{{20}{X}}
diff --git a/cil/doc/cilpp.htoc b/cil/doc/cilpp.htoc
deleted file mode 100644
index d5bc0e5e57ada9d207a9f8ed433c5a9e5ae50261..0000000000000000000000000000000000000000
--- a/cil/doc/cilpp.htoc
+++ /dev/null
@@ -1,65 +0,0 @@
-\begin{tocenv}
-\tocitem \@locref{htoc1}{\begin{@norefs}\@print{1}\quad{}Introduction\end{@norefs}}
-\tocitem \@locref{htoc2}{\begin{@norefs}\@print{2}\quad{}Installation\end{@norefs}}
-\tocitem \@locref{htoc3}{\begin{@norefs}\@print{3}\quad{}Distribution Contents\end{@norefs}}
-\tocitem \@locref{htoc4}{\begin{@norefs}\@print{4}\quad{}Compiling C to CIL\end{@norefs}}
-\tocitem \@locref{htoc5}{\begin{@norefs}\@print{5}\quad{}How to Use CIL\end{@norefs}}
-\begin{tocenv}
-\tocitem \@locref{htoc6}{\begin{@norefs}\@print{5.1}\quad{}Using \t{cilly}, the CIL driver\end{@norefs}}
-\tocitem \@locref{htoc7}{\begin{@norefs}\@print{5.2}\quad{}Using CIL as a library\end{@norefs}}
-\end{tocenv}
-\tocitem \@locref{htoc8}{\begin{@norefs}\@print{6}\quad{}CIL API Documentation\end{@norefs}}
-\begin{tocenv}
-\tocitem \@locref{htoc9}{\begin{@norefs}\@print{6.1}\quad{}Using the visitor\end{@norefs}}
-\tocitem \@locref{htoc10}{\begin{@norefs}\@print{6.2}\quad{}Interpreted Constructors and Deconstructors\end{@norefs}}
-\begin{tocenv}
-\tocitem \@locref{htoc11}{\begin{@norefs}\@print{6.2.1}\quad{}Performance considerations for interpreted constructors\end{@norefs}}
-\end{tocenv}
-\tocitem \@locref{htoc12}{\begin{@norefs}\@print{6.3}\quad{}Printing and Debugging support\end{@norefs}}
-\tocitem \@locref{htoc13}{\begin{@norefs}\@print{6.4}\quad{}Attributes\end{@norefs}}
-\end{tocenv}
-\tocitem \@locref{htoc14}{\begin{@norefs}\@print{7}\quad{}The CIL Driver\end{@norefs}}
-\begin{tocenv}
-\tocitem \@locref{htoc15}{\begin{@norefs}\@print{7.1}\quad{}\t{cilly} Options\end{@norefs}}
-\tocitem \@locref{htoc16}{\begin{@norefs}\@print{7.2}\quad{}\t{cilly.asm} Options\end{@norefs}}
-\end{tocenv}
-\tocitem \@locref{htoc17}{\begin{@norefs}\@print{8}\quad{}Library of CIL Modules\end{@norefs}}
-\begin{tocenv}
-\tocitem \@locref{htoc18}{\begin{@norefs}\@print{8.1}\quad{}Control-Flow Graphs\end{@norefs}}
-\begin{tocenv}
-\tocitem \@locref{htoc19}{\begin{@norefs}\@print{8.1.1}\quad{}The CFG module (new in CIL 1.3.5)\end{@norefs}}
-\tocitem \@locref{htoc20}{\begin{@norefs}\@print{8.1.2}\quad{}Simplified control flow\end{@norefs}}
-\end{tocenv}
-\tocitem \@locref{htoc21}{\begin{@norefs}\@print{8.2}\quad{}Data flow analysis framework\end{@norefs}}
-\tocitem \@locref{htoc22}{\begin{@norefs}\@print{8.3}\quad{}Dominators\end{@norefs}}
-\tocitem \@locref{htoc23}{\begin{@norefs}\@print{8.4}\quad{}Points-to Analysis\end{@norefs}}
-\tocitem \@locref{htoc24}{\begin{@norefs}\@print{8.5}\quad{}StackGuard\end{@norefs}}
-\tocitem \@locref{htoc25}{\begin{@norefs}\@print{8.6}\quad{}Heapify\end{@norefs}}
-\tocitem \@locref{htoc26}{\begin{@norefs}\@print{8.7}\quad{}One Return\end{@norefs}}
-\tocitem \@locref{htoc27}{\begin{@norefs}\@print{8.8}\quad{}Partial Evaluation and Constant Folding\end{@norefs}}
-\tocitem \@locref{htoc28}{\begin{@norefs}\@print{8.9}\quad{}Reaching Definitions\end{@norefs}}
-\tocitem \@locref{htoc29}{\begin{@norefs}\@print{8.10}\quad{}Available Expressions\end{@norefs}}
-\tocitem \@locref{htoc30}{\begin{@norefs}\@print{8.11}\quad{}Liveness Analysis\end{@norefs}}
-\tocitem \@locref{htoc31}{\begin{@norefs}\@print{8.12}\quad{}Dead Code Elimination\end{@norefs}}
-\tocitem \@locref{htoc32}{\begin{@norefs}\@print{8.13}\quad{}Simple Memory Operations\end{@norefs}}
-\tocitem \@locref{htoc33}{\begin{@norefs}\@print{8.14}\quad{}Simple Three-Address Code\end{@norefs}}
-\tocitem \@locref{htoc34}{\begin{@norefs}\@print{8.15}\quad{}Converting C to C++\end{@norefs}}
-\end{tocenv}
-\tocitem \@locref{htoc35}{\begin{@norefs}\@print{9}\quad{}Controlling CIL\end{@norefs}}
-\tocitem \@locref{htoc36}{\begin{@norefs}\@print{10}\quad{}GCC Extensions\end{@norefs}}
-\tocitem \@locref{htoc37}{\begin{@norefs}\@print{11}\quad{}CIL Limitations\end{@norefs}}
-\tocitem \@locref{htoc38}{\begin{@norefs}\@print{12}\quad{}Known Bugs and Limitations\end{@norefs}}
-\tocitem \@locref{htoc39}{\begin{@norefs}\@print{13}\quad{}Using the merger\end{@norefs}}
-\tocitem \@locref{htoc40}{\begin{@norefs}\@print{14}\quad{}Using the patcher\end{@norefs}}
-\tocitem \@locref{htoc41}{\begin{@norefs}\@print{15}\quad{}Debugging support\end{@norefs}}
-\tocitem \@locref{htoc42}{\begin{@norefs}\@print{16}\quad{}Who Says C is Simple?\end{@norefs}}
-\begin{tocenv}
-\tocitem \@locref{htoc43}{\begin{@norefs}\@print{16.1}\quad{}Standard C\end{@norefs}}
-\tocitem \@locref{htoc44}{\begin{@norefs}\@print{16.2}\quad{}GCC ugliness\end{@norefs}}
-\tocitem \@locref{htoc45}{\begin{@norefs}\@print{16.3}\quad{}Microsoft VC ugliness\end{@norefs}}
-\end{tocenv}
-\tocitem \@locref{htoc46}{\begin{@norefs}\@print{17}\quad{}Authors\end{@norefs}}
-\tocitem \@locref{htoc47}{\begin{@norefs}\@print{18}\quad{}License\end{@norefs}}
-\tocitem \@locref{htoc48}{\begin{@norefs}\@print{19}\quad{}Bug reports\end{@norefs}}
-\tocitem \@locref{htoc49}{\begin{@norefs}\@print{20}\quad{}Changes\end{@norefs}}
-\end{tocenv}
diff --git a/cil/doc/ciltoc.html b/cil/doc/ciltoc.html
deleted file mode 100644
index 7fe4c80e5ffb1d8587254eaaa9baa0dd3f80f6f1..0000000000000000000000000000000000000000
--- a/cil/doc/ciltoc.html
+++ /dev/null
@@ -1,92 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-
-<HEAD>
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-</HEAD>
-
-<BODY >
-<!--HEVEA command line is: /usr/bin/hevea -exec xxdate.exe ../../cilpp -->
-<!--HACHA command line is: /usr/bin/hacha -o ciltoc.html cil.html -->
-
-
-
-<TABLE CLASS="title">
-<TR><TD></TD>
-</TR></TABLE><BR>
-<UL>
-<LI><A HREF="cil001.html">Introduction</A>
-<LI><A HREF="cil002.html">Installation</A>
-<LI><A HREF="cil003.html">Distribution Contents</A>
-<LI><A HREF="cil004.html">Compiling C to CIL</A>
-<LI><A HREF="cilly.html">How to Use CIL</A>
-<UL>
-<LI><A HREF="cilly.html#toc1">Using <TT>cilly</TT>, the CIL driver</A>
-<LI><A HREF="cilly.html#toc2">Using CIL as a library</A>
-</UL>
-<LI><A HREF="cil006.html">CIL API Documentation</A>
-<UL>
-<LI><A HREF="cil006.html#toc3">Using the visitor</A>
-<LI><A HREF="cil006.html#toc4">Interpreted Constructors and Deconstructors</A>
-<LI><A HREF="cil006.html#toc5">Printing and Debugging support</A>
-<LI><A HREF="cil006.html#toc6">Attributes</A>
-</UL>
-<LI><A HREF="cil007.html">The CIL Driver</A>
-<UL>
-<LI><A HREF="cil007.html#toc7"><TT>cilly</TT> Options</A>
-<LI><A HREF="cil007.html#toc8"><TT>cilly.asm</TT> Options</A>
-</UL>
-<LI><A HREF="ext.html">Library of CIL Modules</A>
-<UL>
-<LI><A HREF="ext.html#toc9">Control-Flow Graphs</A>
-<LI><A HREF="ext.html#toc10">Data flow analysis framework</A>
-<LI><A HREF="ext.html#toc11">Dominators</A>
-<LI><A HREF="ext.html#toc12">Points-to Analysis</A>
-<LI><A HREF="ext.html#toc13">StackGuard</A>
-<LI><A HREF="ext.html#toc14">Heapify</A>
-<LI><A HREF="ext.html#toc15">One Return</A>
-<LI><A HREF="ext.html#toc16">Partial Evaluation and Constant Folding</A>
-<LI><A HREF="ext.html#toc17">Reaching Definitions</A>
-<LI><A HREF="ext.html#toc18">Available Expressions</A>
-<LI><A HREF="ext.html#toc19">Liveness Analysis</A>
-<LI><A HREF="ext.html#toc20">Dead Code Elimination</A>
-<LI><A HREF="ext.html#toc21">Simple Memory Operations</A>
-<LI><A HREF="ext.html#toc22">Simple Three-Address Code</A>
-<LI><A HREF="ext.html#toc23">Converting C to C++</A>
-</UL>
-<LI><A HREF="cil009.html">Controlling CIL</A>
-<LI><A HREF="cil010.html">GCC Extensions</A>
-<LI><A HREF="cil011.html">CIL Limitations</A>
-<LI><A HREF="cil012.html">Known Bugs and Limitations</A>
-<LI><A HREF="merger.html">Using the merger</A>
-<LI><A HREF="patcher.html">Using the patcher</A>
-<LI><A HREF="cil015.html">Debugging support</A>
-<LI><A HREF="cil016.html">Who Says C is Simple?</A>
-<UL>
-<LI><A HREF="cil016.html#toc24">Standard C</A>
-<LI><A HREF="cil016.html#toc25">GCC ugliness</A>
-<LI><A HREF="cil016.html#toc26">Microsoft VC ugliness</A>
-</UL>
-<LI><A HREF="cil017.html">Authors</A>
-<LI><A HREF="cil018.html">License</A>
-<LI><A HREF="cil019.html">Bug reports</A>
-<LI><A HREF="changes.html">Changes</A>
-</UL>
-<!--FOOTER-->
-<HR SIZE=2><BLOCKQUOTE CLASS="quote"><EM>This document was translated from L<sup>A</sup>T<sub>E</sub>X by
-</EM><A HREF="http://pauillac.inria.fr/~maranget/hevea/index.html"><EM>H<FONT SIZE=2><sup>E</sup></FONT>V<FONT SIZE=2><sup>E</sup></FONT>A</EM></A><EM>.</EM></BLOCKQUOTE></BODY>
-</HTML>
diff --git a/cil/doc/contents_motif.gif b/cil/doc/contents_motif.gif
deleted file mode 100644
index 5d3d016702478a74ae10ef900888bdd3c379aa3b..0000000000000000000000000000000000000000
Binary files a/cil/doc/contents_motif.gif and /dev/null differ
diff --git a/cil/doc/examples/ex1.txt b/cil/doc/examples/ex1.txt
deleted file mode 100644
index 2fe6c2105e6c812f685caf80eab4863d4b9f5007..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex1.txt
+++ /dev/null
@@ -1,16 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex1.c"
-long x ;
-#line 3 "cilcode.tmp/ex1.c"
-static long long y ;
-#line 6 "cilcode.tmp/ex1.c"
-int main(void)
-{
-
- {
-#line 6
- return ((int )((long long )x + y));
-}
-}
diff --git a/cil/doc/examples/ex10.txt b/cil/doc/examples/ex10.txt
deleted file mode 100644
index 7213b4c37dbc60db4a84d137bbba49eb3cd5287b..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex10.txt
+++ /dev/null
@@ -1,10 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex10.c"
-char foo[13] =
-#line 1
- { (char )'f', (char )'o', (char )'o', (char )' ',
- (char )'p', (char )'l', (char )'u', (char )'s',
- (char )' ', (char )'b', (char )'a', (char )'r',
- (char )'\000'};
diff --git a/cil/doc/examples/ex11.txt b/cil/doc/examples/ex11.txt
deleted file mode 100644
index 683df519d85adafb9b1db0f931280961424c68ed..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex11.txt
+++ /dev/null
@@ -1,5 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex11.c"
-char *foo = (char *)"foo plus bar ";
diff --git a/cil/doc/examples/ex12.txt b/cil/doc/examples/ex12.txt
deleted file mode 100644
index d04d83d82a6c16f70ccd1686a750838a6e66b4e4..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex12.txt
+++ /dev/null
@@ -1,32 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 2 "cilcode.tmp/ex12.c"
-struct foo {
- int f1 ;
- int f2 ;
-};
-#line 1 "cilcode.tmp/ex12.c"
-int main(void)
-{ int x ;
- struct foo a[3] ;
-
- {
-#line 1
- x = 5;
-#line 2
- a[0].f1 = 1;
-#line 2
- a[0].f2 = 2;
-#line 2
- a[1].f1 = 3;
-#line 2
- a[1].f2 = 4;
-#line 2
- a[2].f1 = 5;
-#line 2
- a[2].f2 = 0;
-#line 3
- return (0);
-}
-}
diff --git a/cil/doc/examples/ex13.txt b/cil/doc/examples/ex13.txt
deleted file mode 100644
index 6486ad6eeead4ddb6aab4d9514f6f61cf77f96a2..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex13.txt
+++ /dev/null
@@ -1,21 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex13.c"
-int x = 5;
-#line 2 "cilcode.tmp/ex13.c"
-int main(void)
-{ int x___0 ;
- int x___1 ;
-
- {
-#line 3
- x___0 = 6;
-#line 5
- x___1 = 7;
-#line 6
- return (x___1);
-#line 8
- return (x___0);
-}
-}
diff --git a/cil/doc/examples/ex14.txt b/cil/doc/examples/ex14.txt
deleted file mode 100644
index 72fc719ef1a9ded3b825df9b1d49ded3806ef45c..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex14.txt
+++ /dev/null
@@ -1,22 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex14.c"
-int x = 5;
-#line 5
-int main(void) ;
-#line 5 "cilcode.tmp/ex14.c"
-static int x___1 = 7;
-#line 2 "cilcode.tmp/ex14.c"
-int main(void)
-{ int x___0 ;
-
- {
-#line 3
- x___0 = 6;
-#line 6
- return (x___1);
-#line 8
- return (x___0);
-}
-}
diff --git a/cil/doc/examples/ex15.txt b/cil/doc/examples/ex15.txt
deleted file mode 100644
index 4f64ae9b68c5b98e20b9ce5110a60147116aae98..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex15.txt
+++ /dev/null
@@ -1,14 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex15.c"
-int foo(void)
-{ int x ;
-
- {
-#line 2
- x = 5;
-#line 3
- return (0);
-}
-}
diff --git a/cil/doc/examples/ex16.txt b/cil/doc/examples/ex16.txt
deleted file mode 100644
index 82290c2871fddda0b6a8edcb42c41320f4c7d797..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex16.txt
+++ /dev/null
@@ -1,22 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex16.c"
-extern int f(int ) ;
-#line 1 "cilcode.tmp/ex16.c"
-int main(void)
-{ int x ;
- int tmp ;
- int tmp___0 ;
-
- {
-#line 2
- tmp = x;
-#line 2
- x ++;
-#line 2
- tmp___0 = f(x);
-#line 2
- return (tmp + tmp___0);
-}
-}
diff --git a/cil/doc/examples/ex17.txt b/cil/doc/examples/ex17.txt
deleted file mode 100644
index 20bbaa7adfa9e06fce3138281d911c5d0b7d5e6d..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex17.txt
+++ /dev/null
@@ -1,81 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex17.c"
-int main(void)
-{ int x ;
- int y ;
- int tmp ;
- int z ;
- int tmp___0 ;
-
- {
-#line 2
- if (x) {
-#line 2
- tmp = 2;
- } else {
-#line 2
- tmp = 4;
- }
-#line 2
- y = tmp;
-#line 3
- if (x) {
-#line 3
- tmp___0 = 1;
- } else {
-#line 3
- if (y) {
-#line 3
- tmp___0 = 1;
- } else {
-#line 3
- tmp___0 = 0;
- }
- }
-#line 3
- z = tmp___0;
-#line 5
- if (x) {
-#line 5
- if (y) {
-#line 5
- return (0);
- } else {
-#line 5
- return (1);
- }
- } else {
-#line 5
- return (1);
- }
-#line 8
- if (x) {
-#line 8
- if (y) {
- goto _L;
- } else {
- goto _L___0;
- }
- } else {
- _L___0: /* CIL Label */
-#line 8
- if (z) {
- _L: /* CIL Label */
-#line 8
- x ++;
-#line 8
- y ++;
-#line 8
- z ++;
-#line 8
- x ++;
-#line 8
- y ++;
-#line 8
- return (z);
- }
- }
-}
-}
diff --git a/cil/doc/examples/ex18.txt b/cil/doc/examples/ex18.txt
deleted file mode 100644
index bcdb7ef2941c1e81ba35043f7f1c7cc2214c0ee4..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex18.txt
+++ /dev/null
@@ -1,20 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex18.c"
-extern int f() ;
-#line 1 "cilcode.tmp/ex18.c"
-int main(void)
-{ int tmp___0 ;
-
- {
-#line 2
- tmp___0 = f();
- if (! tmp___0) {
-#line 2
- tmp___0 = 4;
- }
-#line 2
- return (tmp___0);
-}
-}
diff --git a/cil/doc/examples/ex19.txt b/cil/doc/examples/ex19.txt
deleted file mode 100644
index 3b82868fe11cd208caa42b30c3d793716788f249..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex19.txt
+++ /dev/null
@@ -1,42 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex19.c"
-int main(void)
-{ int x ;
- int i ;
-
- {
-#line 2
- i = 0;
-#line 2
- while (i < 5) {
-#line 3
- if (i == 5) {
- goto __Cont;
- }
-#line 4
- if (i == 4) {
-#line 4
- break;
- }
-#line 5
- i += 2;
- __Cont: /* CIL Label */
-#line 2
- i ++;
- }
-#line 7
- while (x < 5) {
-#line 8
- if (x == 3) {
-#line 8
- continue;
- }
-#line 9
- x ++;
- }
-#line 11
- return (0);
-}
-}
diff --git a/cil/doc/examples/ex2.txt b/cil/doc/examples/ex2.txt
deleted file mode 100644
index 20313828c4c1651bec30133214a7349dc2a9ab74..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex2.txt
+++ /dev/null
@@ -1,9 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex2.c"
-struct __anonstruct_s_1 {
- int x ;
-};
-#line 1 "cilcode.tmp/ex2.c"
-struct __anonstruct_s_1 s ;
diff --git a/cil/doc/examples/ex20.txt b/cil/doc/examples/ex20.txt
deleted file mode 100644
index 7a51db3b6dc2798f68a5fa37ab1ebb7bd2c2befd..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex20.txt
+++ /dev/null
@@ -1,26 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex20.c"
-int main(void)
-{ int x ;
- int y ;
- int z ;
-
- {
-#line 1
- x = 5;
-#line 1
- y = x;
-#line 2
- x ++;
- L:
-#line 2
- y -= x;
-#line 2
- z = y;
- goto L;
-#line 3
- return (0);
-}
-}
diff --git a/cil/doc/examples/ex21.txt b/cil/doc/examples/ex21.txt
deleted file mode 100644
index 3f331e42541fafb936c149f5076ef2fefe5a5e13..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex21.txt
+++ /dev/null
@@ -1,25 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex21.c"
-int main(void)
-{ int x ;
- int y ;
- int z ;
- int *tmp ;
-
- {
-#line 2
- if (x) {
-#line 2
- tmp = & y;
- } else {
-#line 2
- tmp = & z;
- }
-#line 2
- x ++;
-#line 2
- return (tmp - & x);
-}
-}
diff --git a/cil/doc/examples/ex22.txt b/cil/doc/examples/ex22.txt
deleted file mode 100644
index 2224e7c7d438ee8833edf92b7bc6232c43789815..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex22.txt
+++ /dev/null
@@ -1,16 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 327 "/usr/include/stdio.h"
-extern int printf(char const * __restrict __format , ...) ;
-#line 7 "cilcode.tmp/ex22.c"
-int main(void)
-{
-
- {
-#line 9
- printf((char const * __restrict )"Hello world\n");
-#line 10
- return (0);
-}
-}
diff --git a/cil/doc/examples/ex23.txt b/cil/doc/examples/ex23.txt
deleted file mode 100644
index d48a1358318ac50884432c1178f19e06159489ab..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex23.txt
+++ /dev/null
@@ -1,56 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex23.c"
-int foo(int predicate )
-{ int x ;
-
- {
-#line 2
- x = 0;
-#line 4
- if (predicate == 0) {
- goto switch_0_0;
- } else {
-#line 5
- if (predicate == 1) {
- goto switch_0_1;
- } else {
-#line 6
- if (predicate == 2) {
- goto switch_0_2;
- } else {
-#line 7
- if (predicate == 3) {
- goto switch_0_3;
- } else {
- {
- goto switch_0_default;
-#line 3
- if (0) {
- switch_0_0: /* CIL Label */
-#line 4
- return (111);
- switch_0_1: /* CIL Label */
-#line 5
- x ++;
- switch_0_2: /* CIL Label */
-#line 6
- return (x + 3);
- switch_0_3: /* CIL Label */
- goto switch_0_break;
- switch_0_default: /* CIL Label */ ;
-#line 8
- return (222);
- } else {
- switch_0_break: /* CIL Label */ ;
- }
- }
- }
- }
- }
- }
-#line 10
- return (333);
-}
-}
diff --git a/cil/doc/examples/ex24.txt b/cil/doc/examples/ex24.txt
deleted file mode 100644
index 587ce674d8ce0f74829b4e5921f11c8632bd20af..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex24.txt
+++ /dev/null
@@ -1,59 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-extern void * stackguard_get_ra();
-extern void stackguard_set_ra(void *new_ra);
-/* You must provide an implementation for functions that get and set the
- * return address. Such code is unfortunately architecture specific.
- */
-struct stackguard_stack {
- void * data;
- struct stackguard_stack * next;
-} * stackguard_stack;
-
-void stackguard_push(void *ra) {
- void * old = stackguard_stack;
- stackguard_stack = (struct stackguard_stack *)
- malloc(sizeof(stackguard_stack));
- stackguard_stack->data = ra;
- stackguard_stack->next = old;
-}
-
-void * stackguard_pop() {
- void * ret = stackguard_stack->data;
- void * next = stackguard_stack->next;
- free(stackguard_stack);
- stackguard_stack->next = next;
- return ret;
-}
-#line 3 "cilcode.tmp/ex24.c"
-extern int ( /* missing proto */ scanf)() ;
-#line 1 "cilcode.tmp/ex24.c"
-int dangerous(void)
-{ char array[10] ;
- void *return_address ;
-
- {
- return_address = (void *)stackguard_get_ra();
- stackguard_push(return_address);
-#line 3
- scanf("%s", array);
- {
- return_address = (void *)stackguard_pop();
- stackguard_set_ra(return_address);
-#line 4
- return (0);
- }
-}
-}
-#line 6 "cilcode.tmp/ex24.c"
-int main(void)
-{ int tmp ;
-
- {
-#line 7
- tmp = dangerous();
-#line 7
- return (tmp);
-}
-}
diff --git a/cil/doc/examples/ex25.txt b/cil/doc/examples/ex25.txt
deleted file mode 100644
index 88f6902e444775ef89606056a1d3d3bcc9236307..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex25.txt
+++ /dev/null
@@ -1,40 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 3 "cilcode.tmp/ex25.c"
-extern int ( /* missing proto */ scanf)() ;
-#line 1 "cilcode.tmp/ex25.c"
-struct dangerous_heapify {
- char array[10] ;
-};
-#line 1 "cilcode.tmp/ex25.c"
-int dangerous(void)
-{ struct dangerous_heapify *dangerous_heapify ;
- int __cil_tmp3 ;
-
- {
-#line 1
- dangerous_heapify = (struct dangerous_heapify *)malloc(sizeof(struct dangerous_heapify ));
-#line 3
- scanf("%s", dangerous_heapify->array);
- {
-#line 4
- __cil_tmp3 = 0;
-#line 4
- free(dangerous_heapify);
-#line 4
- return (__cil_tmp3);
- }
-}
-}
-#line 6 "cilcode.tmp/ex25.c"
-int main(void)
-{ int tmp ;
-
- {
-#line 7
- tmp = dangerous();
-#line 7
- return (tmp);
-}
-}
diff --git a/cil/doc/examples/ex26.txt b/cil/doc/examples/ex26.txt
deleted file mode 100644
index 8f5b1718890d5ba081cbb567ca38d2a8d554575f..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex26.txt
+++ /dev/null
@@ -1,29 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex26.c"
-int foo(int predicate )
-{ int __retres ;
-
- {
-#line 2
- if (predicate <= 0) {
-#line 3
- __retres = 1;
- goto return_label;
- } else {
-#line 5
- if (predicate > 5) {
-#line 6
- __retres = 2;
- goto return_label;
- }
-#line 7
- __retres = 3;
- goto return_label;
- }
- return_label: /* CIL Label */
-#line 1
- return (__retres);
-}
-}
diff --git a/cil/doc/examples/ex27.txt b/cil/doc/examples/ex27.txt
deleted file mode 100644
index 60591132ad8b694d7d2b50d011e9b188c6726798..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex27.txt
+++ /dev/null
@@ -1,51 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex27.c"
-int foo(int x , int y )
-{ int unknown ;
-
- {
-#line 3
- if (unknown) {
-#line 4
- return (9);
- }
-#line 5
- return (x + 3);
-}
-}
-#line 8 "cilcode.tmp/ex27.c"
-int main(void)
-{ int a ;
- int b ;
- int c ;
- int tmp ;
- int tmp___0 ;
-
- {
- {
-#line 10
- tmp = foo(5, 7);
-#line 10
- tmp___0 = foo(6, 7);
-#line 10
- a = tmp + tmp___0;
-#line 11
- b = 4;
-#line 12
- c = 16;
- }
- {
- {
-#line 16
- return (20);
- }
-#line 13
- if (0) {
-#line 14
- return (b - c);
- }
- }
-}
-}
diff --git a/cil/doc/examples/ex28.txt b/cil/doc/examples/ex28.txt
deleted file mode 100644
index 098b144a2c31602d8dab7d5397ea1df171658c5e..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex28.txt
+++ /dev/null
@@ -1,24 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex28.c"
-int main(void)
-{ int ***three ;
- int **two ;
- int **mem_3 ;
- int *mem_4 ;
- int *mem_5 ;
-
- {
-#line 4
- mem_3 = (*three);
-#line 4
- mem_4 = (*mem_3);
-#line 4
- mem_5 = (*two);
-#line 4
- (*mem_4) = (*mem_5);
-#line 5
- return (0);
-}
-}
diff --git a/cil/doc/examples/ex29.txt b/cil/doc/examples/ex29.txt
deleted file mode 100644
index 7df8f681dff422710c235941718a7a3cc70c917e..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex29.txt
+++ /dev/null
@@ -1,53 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 2 "cilcode.tmp/ex29.c"
-struct mystruct {
- int a ;
- int b ;
-};
-#line 1 "cilcode.tmp/ex29.c"
-int main(void)
-{ struct mystruct m ;
- int local ;
- int arr[3] ;
- int *ptr ;
- unsigned int __cil_tmp5 ;
- unsigned int __cil_tmp6 ;
- int __cil_tmp7 ;
- unsigned int __cil_tmp8 ;
- int *__cil_tmp9 ;
- int __cil_tmp10 ;
- unsigned int __cil_tmp11 ;
- unsigned int __cil_tmp12 ;
- unsigned int __cil_tmp13 ;
- int m_b14 ;
- int m_a15 ;
-
- {
-#line 10
- ptr = & local;
-#line 11
- __cil_tmp5 = 2 * 4U;
-#line 11
- __cil_tmp6 = (unsigned int )(arr) + __cil_tmp5;
-#line 11
- __cil_tmp7 = (*((int *)__cil_tmp6));
-#line 11
- __cil_tmp8 = (unsigned int )__cil_tmp7;
-#line 11
- __cil_tmp9 = & local;
-#line 11
- __cil_tmp10 = (*__cil_tmp9);
-#line 11
- __cil_tmp11 = (unsigned int )__cil_tmp10;
-#line 11
- __cil_tmp12 = __cil_tmp11 + 8U;
-#line 11
- __cil_tmp13 = __cil_tmp12 + __cil_tmp8;
-#line 11
- m_a15 = (int )__cil_tmp13;
-#line 12
- return (m_a15);
-}
-}
diff --git a/cil/doc/examples/ex3.txt b/cil/doc/examples/ex3.txt
deleted file mode 100644
index 2ca8ac95354f192971c50c4163b8cff42ceca046..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex3.txt
+++ /dev/null
@@ -1,20 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex3.c"
-union baz {
- int x1 ;
- double x2 ;
-};
-#line 1 "cilcode.tmp/ex3.c"
-struct bar {
- union baz u1 ;
- int y ;
-};
-#line 1 "cilcode.tmp/ex3.c"
-struct foo {
- struct bar s1 ;
- int z ;
-};
-#line 1 "cilcode.tmp/ex3.c"
-struct foo f ;
diff --git a/cil/doc/examples/ex30.txt b/cil/doc/examples/ex30.txt
deleted file mode 100644
index 729cfb06648af6546c578c91ba8ef7cbc9753707..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex30.txt
+++ /dev/null
@@ -1,12 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex30.c"
-int main(void)
-{ int x ;
-
- {
-#line 2
- return (x == (x != 0));
-}
-}
diff --git a/cil/doc/examples/ex31.txt b/cil/doc/examples/ex31.txt
deleted file mode 100644
index ab7d4716f4810d397da2fc4f599ca839eb69b3da..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex31.txt
+++ /dev/null
@@ -1,12 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex31.c"
-int main(void)
-{
-
- {
-#line 1
- return ((int )((1U - sizeof(int )) >> 32));
-}
-}
diff --git a/cil/doc/examples/ex32.txt b/cil/doc/examples/ex32.txt
deleted file mode 100644
index f2b6b5b1ee03ca49adf510bc412cc9b54d8a76d3..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex32.txt
+++ /dev/null
@@ -1,16 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex32.c"
-int x = 5;
-#line 2 "cilcode.tmp/ex32.c"
-int f(void)
-{ int x___0 ;
-
- {
-#line 3
- x___0 = 3;
-#line 6
- return (x);
-}
-}
diff --git a/cil/doc/examples/ex33.txt b/cil/doc/examples/ex33.txt
deleted file mode 100644
index f73178f977f4ba5c64afca7c8e62e65c75cafa68..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex33.txt
+++ /dev/null
@@ -1,24 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex33.c"
-int (*pf)(void) ;
-#line 2 "cilcode.tmp/ex33.c"
-int f(void)
-{
-
- {
-#line 4
- pf = & f;
-#line 5
- pf = & f;
-#line 6
- ((*pf))();
-#line 7
- ((*pf))();
-#line 8
- f();
-#line 9
- return (0);
-}
-}
diff --git a/cil/doc/examples/ex34.txt b/cil/doc/examples/ex34.txt
deleted file mode 100644
index 494ca916d9678d80720844de812fb9d8893d76ad..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex34.txt
+++ /dev/null
@@ -1,15 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex34.c"
-struct __anonstruct_nested_2 {
- int y ;
- int z ;
-};
-#line 1 "cilcode.tmp/ex34.c"
-struct __anonstruct_i_1 {
- int x ;
- struct __anonstruct_nested_2 nested ;
-};
-#line 1 "cilcode.tmp/ex34.c"
-struct __anonstruct_i_1 i = {1, {2, 6}};
diff --git a/cil/doc/examples/ex35.txt b/cil/doc/examples/ex35.txt
deleted file mode 100644
index 1af7447c7cae4b8304f8f982eb8096f7c49faba9..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex35.txt
+++ /dev/null
@@ -1,32 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex35.c"
-struct __anonstruct_T1_1 {
- char *key ;
- char *value ;
-};
-#line 1 "cilcode.tmp/ex35.c"
-typedef struct __anonstruct_T1_1 T1;
-#line 7 "cilcode.tmp/ex35.c"
-struct __anonstruct_T3_2 {
- long type ;
- char *value ;
-};
-#line 7 "cilcode.tmp/ex35.c"
-typedef struct __anonstruct_T3_2 T3;
-#line 13 "cilcode.tmp/ex35.c"
-struct __anonstruct_T3_2 __constr_expr_0 = {1L, (char *)1};
-#line 13 "cilcode.tmp/ex35.c"
-T1 a[1] = { {(char *)"", (char *)(& __constr_expr_0)}};
-#line 20 "cilcode.tmp/ex35.c"
-int main(void)
-{ T3 *pt3 ;
-
- {
-#line 21
- pt3 = (T3 *)a[0].value;
-#line 22
- return ((int )pt3->value);
-}
-}
diff --git a/cil/doc/examples/ex36.txt b/cil/doc/examples/ex36.txt
deleted file mode 100644
index adbcdaaa86545741e11faf2b151f5b1ff66b7372..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex36.txt
+++ /dev/null
@@ -1,20 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex36.c"
-int main(void)
-{ int __constr_expr_0[4] ;
-
- {
-#line 1
- __constr_expr_0[0] = 1;
-#line 1
- __constr_expr_0[1] = 2;
-#line 1
- __constr_expr_0[2] = 3;
-#line 1
- __constr_expr_0[3] = 4;
-#line 1
- return (__constr_expr_0[1]);
-}
-}
diff --git a/cil/doc/examples/ex37.txt b/cil/doc/examples/ex37.txt
deleted file mode 100644
index 00d6ca44d86cd32ea5aae3cbac9d2f6319229cae..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex37.txt
+++ /dev/null
@@ -1,14 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 3 "cilcode.tmp/ex37.c"
-int foo(void) ;
-#line 1 "cilcode.tmp/ex37.c"
-int foo(void)
-{
-
- {
-#line 5
- return (0);
-}
-}
diff --git a/cil/doc/examples/ex38.txt b/cil/doc/examples/ex38.txt
deleted file mode 100644
index 706e13d9215d0a94e81275a4914a53168f544521..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex38.txt
+++ /dev/null
@@ -1,12 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex38.c"
-unsigned long foo(void)
-{
-
- {
-#line 2
- return (536870911UL);
-}
-}
diff --git a/cil/doc/examples/ex39.txt b/cil/doc/examples/ex39.txt
deleted file mode 100644
index 2c8c25f93db1d618b88b4d1be25898dfabcd3b7c..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex39.txt
+++ /dev/null
@@ -1,25 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex39.c"
-int main(void)
-{ int x ;
- int y ;
- int z ;
- int *tmp ;
-
- {
-#line 2
- if (x) {
-#line 2
- tmp = & y;
- } else {
-#line 2
- tmp = & z;
- }
-#line 2
- x ++;
-#line 2
- return (tmp - & x);
-}
-}
diff --git a/cil/doc/examples/ex4.txt b/cil/doc/examples/ex4.txt
deleted file mode 100644
index 00a22d31ad1b6cee6545d87f14140c92872a5373..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex4.txt
+++ /dev/null
@@ -1,16 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 2 "cilcode.tmp/ex4.c"
-struct foo {
- int x ;
-};
-#line 1 "cilcode.tmp/ex4.c"
-int main(void)
-{ struct foo foo ;
-
- {
-#line 8
- return (foo.x);
-}
-}
diff --git a/cil/doc/examples/ex40.txt b/cil/doc/examples/ex40.txt
deleted file mode 100644
index c41496b3deca581c617f8f42f099b65d5fafb50e..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex40.txt
+++ /dev/null
@@ -1,20 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex40.c"
-extern int f() ;
-#line 1 "cilcode.tmp/ex40.c"
-int main(void)
-{ int tmp___0 ;
-
- {
-#line 2
- tmp___0 = f();
- if (! tmp___0) {
-#line 2
- tmp___0 = -1;
- }
-#line 2
- return (tmp___0);
-}
-}
diff --git a/cil/doc/examples/ex41.txt b/cil/doc/examples/ex41.txt
deleted file mode 100644
index f1196f39f3f0ca3f28d60b50d23b5e73ab67c148..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex41.txt
+++ /dev/null
@@ -1,69 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex41.c"
-static void *jtab[2] ;
-#line 4
-static int doit(int x ) ;
-#line 4 "cilcode.tmp/ex41.c"
-static int jtab_init = 0;
-#line 2 "cilcode.tmp/ex41.c"
-static int doit(int x )
-{ unsigned int __compgoto ;
-
- {
-#line 5
- if (! jtab_init) {
-#line 6
- jtab[0] = (void *)0;
-#line 7
- jtab[1] = (void *)1;
-#line 8
- jtab_init = 1;
- }
-#line 10
- __compgoto = (unsigned int )jtab[x];
-#line 10
- switch (__compgoto) {
- case 1:
- goto lbl2;
- case 0:
- goto lbl1;
- default:
-#line 10
- (*((int *)0)) = 0;
- }
- lbl1:
-#line 12
- return (0);
- lbl2:
-#line 14
- return (1);
-}
-}
-#line 18
-extern int ( /* missing proto */ exit)() ;
-#line 17 "cilcode.tmp/ex41.c"
-int main(void)
-{ int tmp ;
- int tmp___0 ;
-
- {
-#line 18
- tmp = doit(0);
-#line 18
- if (tmp != 0) {
-#line 18
- exit(1);
- }
-#line 19
- tmp___0 = doit(1);
-#line 19
- if (tmp___0 != 1) {
-#line 19
- exit(1);
- }
-#line 20
- exit(0);
-}
-}
diff --git a/cil/doc/examples/ex42.txt b/cil/doc/examples/ex42.txt
deleted file mode 100644
index b0f40b88ac8695d9f1d96d15245796a186e67ad9..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex42.txt
+++ /dev/null
@@ -1,22 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex42.c"
-int main(void)
-{ int tmp ;
-
- {
- goto L;
-#line 1
- if (0) {
- L:
-#line 1
- tmp = 1;
- } else {
-#line 1
- tmp = 0;
- }
-#line 1
- return (tmp);
-}
-}
diff --git a/cil/doc/examples/ex43.txt b/cil/doc/examples/ex43.txt
deleted file mode 100644
index 4104f79750ec971feb0c6ecc384f3e6073980873..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex43.txt
+++ /dev/null
@@ -1,46 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex43.c"
-__inline static int foo__extinline(void)
-{
-
- {
-#line 1
- return (1);
-}
-}
-#line 2 "cilcode.tmp/ex43.c"
-int firstuse(void)
-{ int tmp ;
-
- {
-#line 2
- tmp = foo__extinline();
-#line 2
- return (tmp);
-}
-}
-#line 5 "cilcode.tmp/ex43.c"
-int foo(void)
-{
-
- {
-#line 5
- return (2);
-}
-}
-#line 7 "cilcode.tmp/ex43.c"
-int main(void)
-{ int tmp ;
- int tmp___0 ;
-
- {
-#line 8
- tmp = foo();
-#line 8
- tmp___0 = firstuse();
-#line 8
- return (tmp + tmp___0);
-}
-}
diff --git a/cil/doc/examples/ex44.txt b/cil/doc/examples/ex44.txt
deleted file mode 100644
index 06f83ba3eb499e1079e0ed66fe8f932d64a250c1..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex44.txt
+++ /dev/null
@@ -1,31 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex44.c"
-struct s {
- int i1 ;
- int i2 ;
-};
-#line 1 "cilcode.tmp/ex44.c"
-union u {
- int i ;
- struct s s ;
-};
-#line 8 "cilcode.tmp/ex44.c"
-union u x = {6};
-#line 10 "cilcode.tmp/ex44.c"
-int main(void)
-{ struct s y ;
- union u z ;
-
- {
-#line 11
- y.i1 = 1;
-#line 11
- y.i2 = 2;
-#line 12
- z.s = y;
-#line 13
- return (0);
-}
-}
diff --git a/cil/doc/examples/ex45.txt b/cil/doc/examples/ex45.txt
deleted file mode 100644
index aaafca3a2ddadce20e8b01c03a87b74b94b9678f..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex45.txt
+++ /dev/null
@@ -1,11 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex45.c"
-char i8 ;
-#line 2 "cilcode.tmp/ex45.c"
-short i16 ;
-#line 3 "cilcode.tmp/ex45.c"
-int i32 ;
-#line 4 "cilcode.tmp/ex45.c"
-long long i64 ;
diff --git a/cil/doc/examples/ex46.txt b/cil/doc/examples/ex46.txt
deleted file mode 100644
index 1f87ec2f7eb6f00bec7bd71015883a00209d759b..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex46.txt
+++ /dev/null
@@ -1,23 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex46.c"
-static int bar(int x , char y )
-{
-
- {
-#line 2
- return (x + (int )y);
-}
-}
-#line 6 "cilcode.tmp/ex46.c"
-int foo(int x , char y )
-{ int tmp ;
-
- {
-#line 6
- tmp = bar(x, y);
-#line 6
- return (tmp);
-}
-}
diff --git a/cil/doc/examples/ex47.txt b/cil/doc/examples/ex47.txt
deleted file mode 100644
index cc5c3067b6f327edc0fd614debd504f95998617e..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex47.txt
+++ /dev/null
@@ -1,28 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex47.c"
-struct __anonstruct____missing_field_name_3 {
- int u ;
- int v ;
-};
-#line 1 "cilcode.tmp/ex47.c"
-struct __anonstruct____missing_field_name_2 {
- int y ;
- int z ;
- struct __anonstruct____missing_field_name_3 __annonCompField1 ;
-};
-#line 1 "cilcode.tmp/ex47.c"
-struct __anonstruct_a_1 {
- int x ;
- struct __anonstruct____missing_field_name_2 __annonCompField2 ;
-};
-#line 1 "cilcode.tmp/ex47.c"
-int main(void)
-{ struct __anonstruct_a_1 a ;
-
- {
-#line 10
- return ((((a.x + a.__annonCompField2.y) + a.__annonCompField2.z) + a.__annonCompField2.__annonCompField1.u) + a.__annonCompField2.__annonCompField1.v);
-}
-}
diff --git a/cil/doc/examples/ex5.txt b/cil/doc/examples/ex5.txt
deleted file mode 100644
index d750bb59a77c8acb8c139ae677000e1da711538f..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex5.txt
+++ /dev/null
@@ -1,27 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex5.c"
-int f(double x ) ;
-#line 3
-int g(double x ) ;
-#line 2 "cilcode.tmp/ex5.c"
-int f(double x )
-{ int tmp ;
-
- {
-#line 3
- tmp = g(x);
-#line 3
- return (tmp);
-}
-}
-#line 5 "cilcode.tmp/ex5.c"
-int g(double x )
-{
-
- {
-#line 6
- return ((int )x);
-}
-}
diff --git a/cil/doc/examples/ex6.txt b/cil/doc/examples/ex6.txt
deleted file mode 100644
index c33eb9e31b602b5391af6447d3ccb11d1549eda5..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex6.txt
+++ /dev/null
@@ -1,7 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex6.c"
-int a1[3] = { 1, 2, 3};
-#line 2 "cilcode.tmp/ex6.c"
-int a2[8] ;
diff --git a/cil/doc/examples/ex7.txt b/cil/doc/examples/ex7.txt
deleted file mode 100644
index 55434c709c5cca0a60202c4b0536a4409ec2dc60..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex7.txt
+++ /dev/null
@@ -1,22 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 2 "cilcode.tmp/ex7.c"
-enum __anonenum_x_1 {
- FIVE = 5,
- SIX = 6,
- SEVEN = 7,
- FOUR = 4,
- EIGHT = 8
-} ;
-#line 1 "cilcode.tmp/ex7.c"
-int main(void)
-{ enum __anonenum_x_1 x ;
-
- {
-#line 2
- x = 5;
-#line 8
- return ((int )x);
-}
-}
diff --git a/cil/doc/examples/ex8.txt b/cil/doc/examples/ex8.txt
deleted file mode 100644
index 323a41e991001a47745b6bfec029869714978e4c..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex8.txt
+++ /dev/null
@@ -1,13 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 2 "cilcode.tmp/ex8.c"
-struct foo {
- int x ;
- int y ;
-};
-#line 1 "cilcode.tmp/ex8.c"
-int a1[5] = { 1, 2, 3, 0,
- 0};
-#line 2 "cilcode.tmp/ex8.c"
-struct foo s1 = {4, 0};
diff --git a/cil/doc/examples/ex9.txt b/cil/doc/examples/ex9.txt
deleted file mode 100644
index 22e976cac7b4ed7e8d8520d10c2df99b7c1ba214..0000000000000000000000000000000000000000
--- a/cil/doc/examples/ex9.txt
+++ /dev/null
@@ -1,16 +0,0 @@
-/* Generated by CIL v. 1.3.5 */
-/* print_CIL_Input is true */
-
-#line 1 "cilcode.tmp/ex9.c"
-struct inner {
- int z ;
-};
-#line 1 "cilcode.tmp/ex9.c"
-struct foo {
- int x ;
- int y ;
- int a[5] ;
- struct inner inner ;
-};
-#line 1 "cilcode.tmp/ex9.c"
-struct foo s = {0, 8, {0, 5, 5, 4, 0}, {3}};
diff --git a/cil/doc/ext.html b/cil/doc/ext.html
deleted file mode 100644
index 532e2258855bf66c1022f7e0f5a13ff6486cc021..0000000000000000000000000000000000000000
--- a/cil/doc/ext.html
+++ /dev/null
@@ -1,506 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-Library of CIL Modules
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="cil007.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil009.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc17">8</A> Library of CIL Modules</H2> <A NAME="sec-Extension"></A><BR>
-<BR>
-We are developing a suite of modules that use CIL for program analyses and
-transformations that we have found useful. You can use these modules directly
-on your code, or generally as inspiration for writing similar modules. A
-particularly big and complex application written on top of CIL is CCured
-(<A HREF="../ccured/index.html"><TT>../ccured/index.html</TT></A>).<BR>
-<BR>
-<A NAME="toc9"></A>
-<H3 CLASS="subsection"><A NAME="htoc18">8.1</A> Control-Flow Graphs</H3> <A NAME="sec-cfg"></A>
-The <A HREF="api/Cil.html#TYPEstmt">Cil.stmt</A> datatype includes fields for intraprocedural
-control-flow information: the predecessor and successor statements of
-the current statement. This information is not computed by default.
-If you want to use the control-flow graph, or any of the extensions in
-this section that require it, you have to explicitly ask CIL to
-compute the CFG.<BR>
-<BR>
-
-<H4 CLASS="subsubsection"><A NAME="htoc19">8.1.1</A> The CFG module (new in CIL 1.3.5)</H4>
-The best way to compute the CFG is with the CFG module. Just invoke
-<A HREF="api/Cfg.html#VALcomputeFileCFG">Cfg.computeFileCFG</A> on your file. The <A HREF="api/Cfg.html">Cfg</A> API
-describes the rest of actions you can take with this module, including
-computing the CFG for one function at a time, or printing the CFG in
-<TT>dot</TT> form.<BR>
-<BR>
-
-<H4 CLASS="subsubsection"><A NAME="htoc20">8.1.2</A> Simplified control flow</H4>
-CIL can reduce high-level C control-flow constructs like <TT>switch</TT> and
-<TT>continue</TT> to lower-level <TT>goto</TT>s. This completely eliminates some
-possible classes of statements from the program and may make the result
-easier to analyze (e.g., it simplifies data-flow analysis).<BR>
-<BR>
-You can invoke this transformation on the command line with
-<TT>--domakeCFG</TT> or programatically with <A HREF="api/Cil.html#VALprepareCFG">Cil.prepareCFG</A>.
-After calling Cil.prepareCFG, you can use <A HREF="api/Cil.html#VALcomputeCFGInfo">Cil.computeCFGInfo</A>
-to compute the CFG information and find the successor and predecessor
-of each statement.<BR>
-<BR>
-For a concrete example, you can see how <TT>cilly --domakeCFG</TT>
-transforms the following code (note the fall-through in case 1):
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int foo (int predicate) {
- int x = 0;
- switch (predicate) {
- case 0: return 111;
- case 1: x = x + 1;
- case 2: return (x+3);
- case 3: break;
- default: return 222;
- }
- return 333;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex23.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<A NAME="toc10"></A>
-<H3 CLASS="subsection"><A NAME="htoc21">8.2</A> Data flow analysis framework</H3>
-The <A HREF="api/Dataflow.html">Dataflow</A> module (click for the ocamldoc) contains a
-parameterized framework for forward and backward data flow
-analyses. You provide the transfer functions and this module does the
-analysis. You must compute control-flow information (Section <A HREF="#sec-cfg">8.1</A>)
-before invoking the Dataflow module.<BR>
-<BR>
-<A NAME="toc11"></A>
-<H3 CLASS="subsection"><A NAME="htoc22">8.3</A> Dominators</H3>
-The module <A HREF="api/Dominators.html">Dominators</A> contains the computation of immediate
- dominators. It uses the <A HREF="api/Dataflow.html">Dataflow</A> module. <BR>
-<BR>
-<A NAME="toc12"></A>
-<H3 CLASS="subsection"><A NAME="htoc23">8.4</A> Points-to Analysis</H3>
-The module <TT>ptranal.ml</TT> contains two interprocedural points-to
-analyses for CIL: <TT>Olf</TT> and <TT>Golf</TT>. <TT>Olf</TT> is the default.
-(Switching from <TT>olf.ml</TT> to <TT>golf.ml</TT> requires a change in
-<TT>Ptranal</TT> and a recompiling <TT>cilly</TT>.)<BR>
-<BR>
-The analyses have the following characteristics:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-Not based on C types (inferred pointer relationships are sound
- despite most kinds of C casts)
-<LI CLASS="li-itemize">One level of subtyping
-<LI CLASS="li-itemize">One level of context sensitivity (Golf only)
-<LI CLASS="li-itemize">Monomorphic type structures
-<LI CLASS="li-itemize">Field insensitive (fields of structs are conflated)
-<LI CLASS="li-itemize">Demand-driven (points-to queries are solved on demand)
-<LI CLASS="li-itemize">Handle function pointers
-</UL>
-The analysis itself is factored into two components: <TT>Ptranal</TT>,
-which walks over the CIL file and generates constraints, and <TT>Olf</TT>
-or <TT>Golf</TT>, which solve the constraints. The analysis is invoked
-with the function <TT>Ptranal.analyze_file: Cil.file ->
- unit</TT>. This function builds the points-to graph for the CIL file
-and stores it internally. There is currently no facility for clearing
-internal state, so <TT>Ptranal.analyze_file</TT> should only be called
-once.<BR>
-<BR>
-The constructed points-to graph supports several kinds of queries,
-including alias queries (may two expressions be aliased?) and
-points-to queries (to what set of locations may an expression point?).<BR>
-<BR>
-The main interface with the alias analysis is as follows:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>Ptranal.may_alias: Cil.exp -> Cil.exp -> bool</TT>. If
- <TT>true</TT>, the two expressions may have the same value.
-<LI CLASS="li-itemize"><TT>Ptranal.resolve_lval: Cil.lval -> (Cil.varinfo
- list)</TT>. Returns the list of variables to which the given
- left-hand value may point.
-<LI CLASS="li-itemize"><TT>Ptranal.resolve_exp: Cil.exp -> (Cil.varinfo list)</TT>.
- Returns the list of variables to which the given expression may
- point.
-<LI CLASS="li-itemize"><TT>Ptranal.resolve_funptr: Cil.exp -> (Cil.fundec
- list)</TT>. Returns the list of functions to which the given
- expression may point.
-</UL>
-The precision of the analysis can be customized by changing the values
-of several flags:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>Ptranal.no_sub: bool ref</TT>.
- If <TT>true</TT>, subtyping is disabled. Associated commandline option:
- <B>--ptr_unify</B>.
-<LI CLASS="li-itemize"><TT>Ptranal.analyze_mono: bool ref</TT>.
- (Golf only) If <TT>true</TT>, context sensitivity is disabled and the
- analysis is effectively monomorphic. Commandline option:
- <B>--ptr_mono</B>.
-<LI CLASS="li-itemize"><TT>Ptranal.smart_aliases: bool ref</TT>.
- (Golf only) If <TT>true</TT>, “smart” disambiguation of aliases is
- enabled. Otherwise, aliases are computed by intersecting points-to
- sets. This is an experimental feature.
-<LI CLASS="li-itemize"><TT>Ptranal.model_strings: bool ref</TT>.
- Make the alias analysis model string constants by treating them as
- pointers to chars. Commandline option: <B>--ptr_model_strings</B>
-<LI CLASS="li-itemize"><TT>Ptranal.conservative_undefineds: bool ref</TT>.
- Make the most pessimistic assumptions about globals if an undefined
- function is present. Such a function can write to every global
- variable. Commandline option: <B>--ptr_conservative</B>
-</UL>
-In practice, the best precision/efficiency tradeoff is achieved by
-setting <TT>Ptranal.no_sub</TT> to <TT>false</TT>, <TT>Ptranal.analyze_mono</TT> to
-<TT>true</TT>, and <TT>Ptranal.smart_aliases</TT> to <TT>false</TT>. These are the
-default values of the flags.<BR>
-<BR>
-There are also a few flags that can be used to inspect or serialize
-the results of the analysis.
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>Ptranal.debug_may_aliases</TT>.
- Print the may-alias relationship of each pair of expressions in the
- program. Commandline option: <B>--ptr_may_aliases</B>.
-<LI CLASS="li-itemize"><TT>Ptranal.print_constraints: bool ref</TT>.
- If <TT>true</TT>, the analysis will print each constraint as it is
- generated.
-<LI CLASS="li-itemize"><TT>Ptranal.print_types: bool ref</TT>.
- If <TT>true</TT>, the analysis will print the inferred type of each
- variable in the program.<BR>
-<BR>
-If <TT>Ptranal.analyze_mono</TT> and <TT>Ptranal.no_sub</TT> are both
- <TT>true</TT>, this output is sufficient to reconstruct the points-to
- graph. One nice feature is that there is a pretty printer for
- recursive types, so the print routine does not loop.
-<LI CLASS="li-itemize"><TT>Ptranal.compute_results: bool ref</TT>.
- If <TT>true</TT>, the analysis will print out the points-to set of each
- variable in the program. This will essentially serialize the
- points-to graph.
-</UL>
-<A NAME="toc13"></A>
-<H3 CLASS="subsection"><A NAME="htoc24">8.5</A> StackGuard</H3>
-The module <TT>heapify.ml</TT> contains a transformation similar to the one
-described in “StackGuard: Automatic Adaptive Detection and Prevention of
-Buffer-Overflow Attacks”, <EM>Proceedings of the 7th USENIX Security
-Conference</EM>. In essence it modifies the program to maintain a separate
-stack for return addresses. Even if a buffer overrun attack occurs the
-actual correct return address will be taken from the special stack. <BR>
-<BR>
-Although it does work, this CIL module is provided mainly as an example of
-how to perform a simple source-to-source program analysis and
-transformation. As an optimization only functions that contain a dangerous
-local array make use of the special return address stack. <BR>
-<BR>
-For a concrete example, you can see how <TT>cilly --dostackGuard</TT>
-transforms the following dangerous code:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int dangerous() {
- char array[10];
- scanf("%s",array); // possible buffer overrun!
- }
-
- int main () {
- return dangerous();
- }
-</FONT></PRE>
-See the <A HREF="examples/ex24.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<A NAME="toc14"></A>
-<H3 CLASS="subsection"><A NAME="htoc25">8.6</A> Heapify</H3>
-The module <TT>heapify.ml</TT> also contains a transformation that moves all
-dangerous local arrays to the heap. This also prevents a number of buffer
-overruns. <BR>
-<BR>
-For a concrete example, you can see how <TT>cilly --doheapify</TT>
-transforms the following dangerous code:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int dangerous() {
- char array[10];
- scanf("%s",array); // possible buffer overrun!
- }
-
- int main () {
- return dangerous();
- }
-</FONT></PRE>
-See the <A HREF="examples/ex25.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<A NAME="toc15"></A>
-<H3 CLASS="subsection"><A NAME="htoc26">8.7</A> One Return</H3>
-The module <TT>oneret.ml</TT> contains a transformation the ensures that all
-function bodies have at most one return statement. This simplifies a number
-of analyses by providing a canonical exit-point. <BR>
-<BR>
-For a concrete example, you can see how <TT>cilly --dooneRet</TT>
-transforms the following code:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int foo (int predicate) {
- if (predicate <= 0) {
- return 1;
- } else {
- if (predicate > 5)
- return 2;
- return 3;
- }
- }
-</FONT></PRE>
-See the <A HREF="examples/ex26.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<A NAME="toc16"></A>
-<H3 CLASS="subsection"><A NAME="htoc27">8.8</A> Partial Evaluation and Constant Folding</H3>
-The <TT>partial.ml</TT> module provides a simple interprocedural partial
-evaluation and constant folding data-flow analysis and transformation. This
-transformation requires the <TT>--domakeCFG</TT> option. <BR>
-<BR>
-For a concrete example, you can see how <TT>cilly --domakeCFG --dopartial</TT>
-transforms the following code (note the eliminated <TT>if</TT> branch and the
-partial optimization of <TT>foo</TT>):
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int foo(int x, int y) {
- int unknown;
- if (unknown)
- return y+2;
- return x+3;
- }
-
- int main () {
- int a,b,c;
- a = foo(5,7) + foo(6,7);
- b = 4;
- c = b * b;
- if (b > c)
- return b-c;
- else
- return b+c;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex27.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<A NAME="toc17"></A>
-<H3 CLASS="subsection"><A NAME="htoc28">8.9</A> Reaching Definitions</H3>
-The <TT>reachingdefs.ml</TT> module uses the dataflow framework and CFG
-information to calculate the definitions that reach each
-statement. After computing the CFG (Section <A HREF="#sec-cfg">8.1</A>) and calling
-<TT>computeRDs</TT> on a
-function declaration, <TT>ReachingDef.stmtStartData</TT> will contain a
-mapping from statement IDs to data about which definitions reach each
-statement. In particular, it is a mapping from statement IDs to a
-triple the first two members of which are used internally. The third
-member is a mapping from variable IDs to Sets of integer options. If
-the set contains <TT>Some(i)</TT>, then the definition of that variable
-with ID <TT>i</TT> reaches that statement. If the set contains <TT>None</TT>,
-then there is a path to that statement on which there is no definition
-of that variable. Also, if the variable ID is unmapped at a
-statement, then no definition of that variable reaches that statement.<BR>
-<BR>
-To summarize, reachingdefs.ml has the following interface:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>computeRDs</TT> – Computes reaching definitions. Requires that
-CFG information has already been computed for each statement.
-<LI CLASS="li-itemize"><TT>ReachingDef.stmtStartData</TT> – contains reaching
-definition data after <TT>computeRDs</TT> is called.
-<LI CLASS="li-itemize"><TT>ReachingDef.defIdStmtHash</TT> – Contains a mapping
-from definition IDs to the ID of the statement in which
-the definition occurs.
-<LI CLASS="li-itemize"><TT>getRDs</TT> – Takes a statement ID and returns
-reaching definition data for that statement.
-<LI CLASS="li-itemize"><TT>instrRDs</TT> – Takes a list of instructions and the
-definitions that reach the first instruction, and for
-each instruction calculates the definitions that reach
-either into or out of that instruction.
-<LI CLASS="li-itemize"><TT>rdVisitorClass</TT> – A subclass of nopCilVisitor that
-can be extended such that the current reaching definition
-data is available when expressions are visited through
-the <TT>get_cur_iosh</TT> method of the class.
-</UL>
-<A NAME="toc18"></A>
-<H3 CLASS="subsection"><A NAME="htoc29">8.10</A> Available Expressions</H3>
-The <TT>availexps.ml</TT> module uses the dataflow framework and CFG
-information to calculate something similar to a traditional available
-expressions analysis. After <TT>computeAEs</TT> is called following a CFG
-calculation (Section <A HREF="#sec-cfg">8.1</A>), <TT>AvailableExps.stmtStartData</TT> will
-contain a mapping
-from statement IDs to data about what expressions are available at
-that statement. The data for each statement is a mapping for each
-variable ID to the whole expression available at that point(in the
-traditional sense) which the variable was last defined to be. So,
-this differs from a traditional available expressions analysis in that
-only whole expressions from a variable definition are considered rather
-than all expressions.<BR>
-<BR>
-The interface is as follows:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>computeAEs</TT> – Computes available expressions. Requires
-that CFG information has already been comptued for each statement.
-<LI CLASS="li-itemize"><TT>AvailableExps.stmtStartData</TT> – Contains available
-expressions data for each statement after <TT>computeAEs</TT> has been
-called.
-<LI CLASS="li-itemize"><TT>getAEs</TT> – Takes a statement ID and returns
-available expression data for that statement.
-<LI CLASS="li-itemize"><TT>instrAEs</TT> – Takes a list of instructions and
-the availalbe expressions at the first instruction, and
-for each instruction calculates the expressions available
-on entering or exiting each instruction.
-<LI CLASS="li-itemize"><TT>aeVisitorClass</TT> – A subclass of nopCilVisitor that
-can be extended such that the current available expressions
-data is available when expressions are visited through the
-<TT>get_cur_eh</TT> method of the class.
-</UL>
-<A NAME="toc19"></A>
-<H3 CLASS="subsection"><A NAME="htoc30">8.11</A> Liveness Analysis</H3>
-The <TT>liveness.ml</TT> module uses the dataflow framework and
-CFG information to calculate which variables are live at
-each program point. After <TT>computeLiveness</TT> is called
-following a CFG calculation (Section <A HREF="#sec-cfg">8.1</A>), <TT>LiveFlow.stmtStartData</TT> will
-contain a mapping for each statement ID to a set of <TT>varinfo</TT>s
-for varialbes live at that program point.<BR>
-<BR>
-The interface is as follows:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>computeLiveness</TT> – Computes live variables. Requires
-that CFG information has already been computed for each statement.
-<LI CLASS="li-itemize"><TT>LiveFlow.stmtStartData</TT> – Contains live variable data
-for each statement after <TT>computeLiveness</TT> has been called.
-</UL>
-Also included in this module is a command line interface that
-will cause liveness data to be printed to standard out for
-a particular function or label.
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>–doliveness</TT> – Instructs cilly to comptue liveness
-information and to print on standard out the variables live
-at the points specified by <TT>–live_func</TT> and <TT>live_label</TT>.
-If both are ommitted, then nothing is printed.
-<LI CLASS="li-itemize"><TT>–live_func</TT> – The name of the function whose
-liveness data is of interest. If <TT>–live_label</TT> is ommitted,
-then data for each statement is printed.
-<LI CLASS="li-itemize"><TT>–live_label</TT> – The name of the label at which
-the liveness data will be printed.
-</UL>
-<A NAME="toc20"></A>
-<H3 CLASS="subsection"><A NAME="htoc31">8.12</A> Dead Code Elimination</H3>
-The module <TT>deadcodeelim.ml</TT> uses the reaching definitions
-analysis to eliminate assignment instructions whose results
-are not used. The interface is as follows:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>elim_dead_code</TT> – Performs dead code elimination
-on a function. Requires that CFG information has already
-been computed (Section <A HREF="#sec-cfg">8.1</A>).
-<LI CLASS="li-itemize"><TT>dce</TT> – Performs dead code elimination on an
-entire file. Requires that CFG information has already
-been computed.
-</UL>
-<A NAME="toc21"></A>
-<H3 CLASS="subsection"><A NAME="htoc32">8.13</A> Simple Memory Operations</H3>
-The <TT>simplemem.ml</TT> module allows CIL lvalues that contain memory
-accesses to be even futher simplified via the introduction of
-well-typed temporaries. After this transformation all lvalues involve
-at most one memory reference.<BR>
-<BR>
-For a concrete example, you can see how <TT>cilly --dosimpleMem</TT>
-transforms the following code:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int main () {
- int ***three;
- int **two;
- ***three = **two;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex28.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<A NAME="toc22"></A>
-<H3 CLASS="subsection"><A NAME="htoc33">8.14</A> Simple Three-Address Code</H3>
-The <TT>simplify.ml</TT> module further reduces the complexity of program
-expressions and gives you a form of three-address code. After this
-transformation all expressions will adhere to the following grammar:
-<PRE CLASS="verbatim">
- basic::=
- Const _
- Addrof(Var v, NoOffset)
- StartOf(Var v, NoOffset)
- Lval(Var v, off), where v is a variable whose address is not taken
- and off contains only "basic"
-
- exp::=
- basic
- Lval(Mem basic, NoOffset)
- BinOp(bop, basic, basic)
- UnOp(uop, basic)
- CastE(t, basic)
-
- lval ::=
- Mem basic, NoOffset
- Var v, off, where v is a variable whose address is not taken and off
- contains only "basic"
-</PRE>In addition, all <TT>sizeof</TT> and <TT>alignof</TT> forms are turned into
-constants. Accesses to arrays and variables whose address is taken are
-turned into "Mem" accesses. All field and index computations are turned
-into address arithmetic.<BR>
-<BR>
-For a concrete example, you can see how <TT>cilly --dosimplify</TT>
-transforms the following code:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
- int main() {
- struct mystruct {
- int a;
- int b;
- } m;
- int local;
- int arr[3];
- int *ptr;
-
- ptr = &local;
- m.a = local + sizeof(m) + arr[2];
- return m.a;
- }
-</FONT></PRE>
-See the <A HREF="examples/ex29.txt">CIL output</A> for this
-code fragment<BR>
-<BR>
-<A NAME="toc23"></A>
-<H3 CLASS="subsection"><A NAME="htoc34">8.15</A> Converting C to C++</H3>
-The module canonicalize.ml performs several transformations to correct
-differences between C and C++, so that the output is (hopefully) valid
-C++ code. This may be incomplete — certain fixes which are necessary
-for some programs are not yet implemented.<BR>
-<BR>
-Using the <TT>--doCanonicalize</TT> option with CIL will perform the
-following changes to your program:
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
-Any variables that use C++ keywords as identifiers are renamed.
-<LI CLASS="li-enumerate">C allows global variables to have multiple declarations and
- multiple (equivalent) definitions. This transformation removes
- all but one declaration and all but one definition.
-<LI CLASS="li-enumerate"><TT>__inline</TT> is #defined to <TT>inline</TT>, and <TT>__restrict</TT>
- is #defined to nothing.
-<LI CLASS="li-enumerate">C allows function pointers with no specified arguments to be used on
- any argument list. To make C++ accept this code, we insert a cast
- from the function pointer to a type that matches the arguments. Of
- course, this does nothing to guarantee that the pointer actually has
- that type.
-<LI CLASS="li-enumerate">Makes casts from int to enum types explicit. (CIL changes enum
- constants to int constants, but doesn't use a cast.)
-</OL>
-<HR>
-<A HREF="cil007.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil009.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/header.html b/cil/doc/header.html
deleted file mode 100644
index cfedee9009a0aea3f9c5612c79a5a1e0d0ffbd5c..0000000000000000000000000000000000000000
--- a/cil/doc/header.html
+++ /dev/null
@@ -1,18 +0,0 @@
-<html>
-
-<head>
-<meta http-equiv="Content-Language" content="en-us">
-<meta name="GENERATOR" content="Microsoft FrontPage 5.0">
-<meta name="ProgId" content="FrontPage.Editor.Document">
-<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
-<title>CIL Documentation (v. 1.3.5)</title>
-<base target="contents">
-</head>
-
-<body>
-
-<h1 align="center">CIL - Infrastructure for C Program Analysis and Transformation (v. 1.3.5)</h1>
-
-</body>
-
-</html>
diff --git a/cil/doc/index.html b/cil/doc/index.html
deleted file mode 100644
index 77ec1606a146c513b47556a3e640269a06fdd605..0000000000000000000000000000000000000000
--- a/cil/doc/index.html
+++ /dev/null
@@ -1,26 +0,0 @@
-<html>
-
-<head>
-<meta name="GENERATOR" content="Microsoft FrontPage 5.0">
-<meta name="ProgId" content="FrontPage.Editor.Document">
-<base target="main">
-<title>CIL Documentation (v. 1.3.5)</title>
-</head>
-
-<frameset rows="64,*">
- <frame name="banner" scrolling="auto" noresize target="contents"
- src="header.html">
- <frameset cols="267,*">
- <frame name="contents" target="main" src="ciltoc.html" scrolling="auto">
- <frame name="main" src="cil001.html" scrolling="auto">
- </frameset>
- <noframes>
- <body>
-
- <p>This page uses frames, but your browser doesn't support them.</p>
-
- </body>
- </noframes>
-</frameset>
-
-</html>
\ No newline at end of file
diff --git a/cil/doc/merger.html b/cil/doc/merger.html
deleted file mode 100644
index 636dd2a85655683c35f33d8986a8e05dc35b17b3..0000000000000000000000000000000000000000
--- a/cil/doc/merger.html
+++ /dev/null
@@ -1,167 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-Using the merger
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="cil012.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="patcher.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc39">13</A> Using the merger</H2><A NAME="sec-merger"></A><BR>
-<BR>
-There are many program analyses that are more effective when
-done on the whole program.<BR>
-<BR>
-The merger is a tool that combines all of the C source files in a project
-into a single C file. There are two tasks that a merger must perform:
-<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
-Detect what are all the sources that make a project and with what
-compiler arguments they are compiled.<BR>
-<BR>
-<LI CLASS="li-enumerate">Merge all of the source files into a single file.
-</OL>
-For the first task the merger impersonates a compiler and a linker (both a
-GCC and a Microsoft Visual C mode are supported) and it expects to be invoked
-(from a build script or a Makefile) on all sources of the project. When
-invoked to compile a source the merger just preprocesses the source and saves
-the result using the name of the requested object file. By preprocessing at
-this time the merger is able to take into account variations in the command
-line arguments that affect preprocessing of different source files.<BR>
-<BR>
-When the merger is invoked to link a number of object files it collects the
-preprocessed sources that were stored with the names of the object files, and
-invokes the merger proper. Note that arguments that affect the compilation or
-linking must be the same for all source files.<BR>
-<BR>
-For the second task, the merger essentially concatenates the preprocessed
-sources with care to rename conflicting file-local declarations (we call this
-process alpha-conversion of a file). The merger also attempts to remove
-duplicate global declarations and definitions. Specifically the following
-actions are taken:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-File-scope names (<TT>static</TT> globals, names of types defined with
-<TT>typedef</TT>, and structure/union/enumeration tags) are given new names if they
-conflict with declarations from previously processed sources. The new name is
-formed by appending the suffix <TT>___n</TT>, where <TT>n</TT> is a unique integer
-identifier. Then the new names are applied to their occurrences in the file. <BR>
-<BR>
-<LI CLASS="li-itemize">Non-static declarations and definitions of globals are never renamed.
-But we try to remove duplicate ones. Equality of globals is detected by
-comparing the printed form of the global (ignoring the line number directives)
-after the body has been alpha-converted. This process is intended to remove
-those declarations (e.g. function prototypes) that originate from the same
-include file. Similarly, we try to eliminate duplicate definitions of
-<TT>inline</TT> functions, since these occasionally appear in include files.<BR>
-<BR>
-<LI CLASS="li-itemize">The types of all global declarations with the same name from all files
-are compared for type isomorphism. During this process, the merger detects all
-those isomorphisms between structures and type definitions that are <B>required</B> for the merged program to be legal. Such structure tags and
-typenames are coalesced and given the same name. <BR>
-<BR>
-<LI CLASS="li-itemize">Besides the structure tags and type names that are required to be
-isomorphic, the merger also tries to coalesce definitions of structures and
-types with the same name from different file. However, in this case the merger
-will not give an error if such definitions are not isomorphic; it will just
-use different names for them. <BR>
-<BR>
-<LI CLASS="li-itemize">In rare situations, it can happen that a file-local global in
-encountered first and it is not renamed, only to discover later when
-processing another file that there is an external symbol with the same name.
-In this case, a second pass is made over the merged file to rename the
-file-local symbol.
-</UL>
-Here is an example of using the merger:<BR>
-<BR>
-The contents of <TT>file1.c</TT> is:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-struct foo; // Forward declaration
-extern struct foo *global;
-</FONT></PRE>
-The contents of <TT>file2.c</TT> is:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-struct bar {
- int x;
- struct bar *next;
-};
-extern struct bar *global;
-struct foo {
- int y;
-};
-extern struct foo another;
-void main() {
-}
-</FONT></PRE>
-There are several ways in which one might create an executable from these
-files:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<PRE CLASS="verbatim">
-gcc file1.c file2.c -o a.out
-</PRE><BR>
-<BR>
-<LI CLASS="li-itemize"><PRE CLASS="verbatim">
-gcc -c file1.c -o file1.o
-gcc -c file2.c -o file2.o
-ld file1.o file2.o -o a.out
-</PRE><BR>
-<BR>
-<LI CLASS="li-itemize"><PRE CLASS="verbatim">
-gcc -c file1.c -o file1.o
-gcc -c file2.c -o file2.o
-ar r libfile2.a file2.o
-gcc file1.o libfile2.a -o a.out
-</PRE><BR>
-<BR>
-<LI CLASS="li-itemize"><PRE CLASS="verbatim">
-gcc -c file1.c -o file1.o
-gcc -c file2.c -o file2.o
-ar r libfile2.a file2.o
-gcc file1.o -lfile2 -o a.out
-</PRE></UL>
-In each of the cases above you must replace all occurrences of <TT>gcc</TT> and
-<TT>ld</TT> with <TT>cilly --merge</TT>, and all occurrences of <TT>ar</TT> with <TT>cilly
---merge --mode=AR</TT>. It is very important that the <TT>--merge</TT> flag be used
-throughout the build process. If you want to see the merged source file you
-must also pass the <TT>--keepmerged</TT> flag to the linking phase. <BR>
-<BR>
-The result of merging file1.c and file2.c is:
-<PRE CLASS="verbatim"><FONT COLOR=blue>
-// from file1.c
-struct foo; // Forward declaration
-extern struct foo *global;
-
-// from file2.c
-struct foo {
- int x;
- struct foo *next;
-};
-struct foo___1 {
- int y;
-};
-extern struct foo___1 another;
-</FONT></PRE>
-<HR>
-<A HREF="cil012.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="patcher.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/next_motif.gif b/cil/doc/next_motif.gif
deleted file mode 100644
index 3f84bacfb26ea6a4141ad407ff4fb77954171fea..0000000000000000000000000000000000000000
Binary files a/cil/doc/next_motif.gif and /dev/null differ
diff --git a/cil/doc/patcher.html b/cil/doc/patcher.html
deleted file mode 100644
index 2c727e233b4e7569c6ed7da1db9d055ce0b3fbde..0000000000000000000000000000000000000000
--- a/cil/doc/patcher.html
+++ /dev/null
@@ -1,126 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
- "http://www.w3.org/TR/REC-html40/loose.dtd">
-<HTML>
-<HEAD>
-
-
-
-<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
-<META name="GENERATOR" content="hevea 1.08">
-
-<base target="main">
-<script language="JavaScript">
-<!-- Begin
-function loadTop(url) {
- parent.location.href= url;
-}
-// -->
-</script>
-<LINK rel="stylesheet" type="text/css" href="cil.css">
-<TITLE>
-Using the patcher
-</TITLE>
-</HEAD>
-<BODY >
-<A HREF="merger.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil015.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-<HR>
-
-<H2 CLASS="section"><A NAME="htoc40">14</A> Using the patcher</H2><A NAME="sec-patcher"></A><BR>
-<BR>
-Occasionally we have needed to modify slightly the standard include files.
-So, we developed a simple mechanism that allows us to create modified copies
-of the include files and use them instead of the standard ones. For this
-purpose we specify a patch file and we run a program caller Patcher which
-makes modified copies of include files and applies the patch.<BR>
-<BR>
-The patcher is invoked as follows:
-<PRE CLASS="verbatim">
-bin/patcher [options]
-
-Options:
- --help Prints this help message
- --verbose Prints a lot of information about what is being done
- --mode=xxx What tool to emulate:
- GNUCC - GNU CC
- MSVC - MS VC cl compiler
-
- --dest=xxx The destination directory. Will make one if it does not exist
- --patch=xxx Patch file (can be specified multiple times)
- --ppargs=xxx An argument to be passed to the preprocessor (can be specified
- multiple times)
-
- --ufile=xxx A user-include file to be patched (treated as \#include "xxx")
- --sfile=xxx A system-include file to be patched (treated as \#include <xxx>)
-
- --clean Remove all files in the destination directory
- --dumpversion Print the version name used for the current compiler
-
- All of the other arguments are passed to the preprocessor. You should pass
- enough arguments (e.g., include directories) so that the patcher can find the
- right include files to be patched.
-</PRE>
- Based on the given <TT>mode</TT> and the current version of the compiler (which
-the patcher can print when given the <TT>dumpversion</TT> argument) the patcher
-will create a subdirectory of the <TT>dest</TT> directory (say <TT>/usr/home/necula/cil/include</TT>), such as:
-<PRE CLASS="verbatim">
-/usr/home/necula/cil/include/gcc_2.95.3-5
-</PRE>
- In that file the patcher will copy the modified versions of the include files
-specified with the <TT>ufile</TT> and <TT>sfile</TT> options. Each of these options can
-be specified multiple times. <BR>
-<BR>
-The patch file (specified with the <TT>patch</TT> option) has a format inspired by
-the Unix <TT>patch</TT> tool. The file has the following grammar:
-<PRE CLASS="verbatim">
-<<< flags
-patterns
-===
-replacement
->>>
-</PRE>
- The flags are a comma separated, case-sensitive, sequence of keywords or
-keyword = value. The following flags are supported:
-<UL CLASS="itemize"><LI CLASS="li-itemize">
-<TT>file=foo.h</TT> - will only apply the patch on files whose name is
- <TT>foo.h</TT>.
-<LI CLASS="li-itemize"><TT>optional</TT> - this means that it is Ok if the current patch does not
-match any of the processed files.
-<LI CLASS="li-itemize"><TT>group=foo</TT> - will add this patch to the named group. If this is not
-specified then a unique group is created to contain just the current patch.
-When all files specified in the command line have been patched, an error
-message is generated for all groups for whom no member patch was used. We use
-this mechanism to receive notice when the patch triggers are out-dated with
-respect to the new include files.
-<LI CLASS="li-itemize"><TT>system=sysname</TT> - will only consider this pattern on a given
-operating system. The “sysname” is reported by the “$Ô” variable in
-Perl, except that Windows is always considered to have sysname
-“cygwin.” For Linux use “linux” (capitalization matters).
-<LI CLASS="li-itemize"><TT>ateof</TT> - In this case the patterns are ignored and the replacement
-text is placed at the end of the patched file. Use the <TT>file</TT> flag if you
-want to restrict the files in which this replacement is performed.
-<LI CLASS="li-itemize"><TT>atsof</TT> - The patterns are ignored and the replacement text is placed
-at the start of the patched file. Uf the <TT>file</TT> flag to restrict the
-application of this patch to a certain file.
-<LI CLASS="li-itemize"><TT>disabled</TT> - Use this flag if you want to disable the pattern.
-</UL>
-The patterns can consist of several groups of lines separated by the <TT>|||</TT>
-marker. Each of these group of lines is a multi-line pattern that if found in
-the file will be replaced with the text given at the end of the block. <BR>
-<BR>
-The matching is space-insensitive.<BR>
-<BR>
-All of the markers <TT><<<</TT>, <TT>|||</TT>, <TT>===</TT> and <TT>>>></TT> must appear at the
-beginning of a line but they can be followed by arbitrary text (which is
-ignored).<BR>
-<BR>
-The replacement text can contain the special keyword <TT>@__pattern__@</TT>,
-which is substituted with the pattern that matched. <BR>
-<BR>
-<HR>
-<A HREF="merger.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
-<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
-<A HREF="cil015.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
-</BODY>
-</HTML>
diff --git a/cil/doc/previous_motif.gif b/cil/doc/previous_motif.gif
deleted file mode 100644
index 8c8a3e6430050e67e2e71dbd1f99fb9caf6176bf..0000000000000000000000000000000000000000
Binary files a/cil/doc/previous_motif.gif and /dev/null differ
diff --git a/cil/install-sh b/cil/install-sh
deleted file mode 100644
index e9de23842dcd44d2953129c866b1ad25f7e1f1d9..0000000000000000000000000000000000000000
--- a/cil/install-sh
+++ /dev/null
@@ -1,251 +0,0 @@
-#!/bin/sh
-#
-# install - install a program, script, or datafile
-# This comes from X11R5 (mit/util/scripts/install.sh).
-#
-# Copyright 1991 by the Massachusetts Institute of Technology
-#
-# Permission to use, copy, modify, distribute, and sell this software and its
-# documentation for any purpose is hereby granted without fee, provided that
-# the above copyright notice appear in all copies and that both that
-# copyright notice and this permission notice appear in supporting
-# documentation, and that the name of M.I.T. not be used in advertising or
-# publicity pertaining to distribution of the software without specific,
-# written prior permission. M.I.T. makes no representations about the
-# suitability of this software for any purpose. It is provided "as is"
-# without express or implied warranty.
-#
-# Calling this script install-sh is preferred over install.sh, to prevent
-# `make' implicit rules from creating a file called install from it
-# when there is no Makefile.
-#
-# This script is compatible with the BSD install script, but was written
-# from scratch. It can only install one file at a time, a restriction
-# shared with many OS's install programs.
-
-
-# set DOITPROG to echo to test this script
-
-# Don't use :- since 4.3BSD and earlier shells don't like it.
-doit="${DOITPROG-}"
-
-
-# put in absolute paths if you don't have them in your path; or use env. vars.
-
-mvprog="${MVPROG-mv}"
-cpprog="${CPPROG-cp}"
-chmodprog="${CHMODPROG-chmod}"
-chownprog="${CHOWNPROG-chown}"
-chgrpprog="${CHGRPPROG-chgrp}"
-stripprog="${STRIPPROG-strip}"
-rmprog="${RMPROG-rm}"
-mkdirprog="${MKDIRPROG-mkdir}"
-
-transformbasename=""
-transform_arg=""
-instcmd="$mvprog"
-chmodcmd="$chmodprog 0755"
-chowncmd=""
-chgrpcmd=""
-stripcmd=""
-rmcmd="$rmprog -f"
-mvcmd="$mvprog"
-src=""
-dst=""
-dir_arg=""
-
-while [ x"$1" != x ]; do
- case $1 in
- -c) instcmd="$cpprog"
- shift
- continue;;
-
- -d) dir_arg=true
- shift
- continue;;
-
- -m) chmodcmd="$chmodprog $2"
- shift
- shift
- continue;;
-
- -o) chowncmd="$chownprog $2"
- shift
- shift
- continue;;
-
- -g) chgrpcmd="$chgrpprog $2"
- shift
- shift
- continue;;
-
- -s) stripcmd="$stripprog"
- shift
- continue;;
-
- -t=*) transformarg=`echo $1 | sed 's/-t=//'`
- shift
- continue;;
-
- -b=*) transformbasename=`echo $1 | sed 's/-b=//'`
- shift
- continue;;
-
- *) if [ x"$src" = x ]
- then
- src=$1
- else
- # this colon is to work around a 386BSD /bin/sh bug
- :
- dst=$1
- fi
- shift
- continue;;
- esac
-done
-
-if [ x"$src" = x ]
-then
- echo "install: no input file specified"
- exit 1
-else
- true
-fi
-
-if [ x"$dir_arg" != x ]; then
- dst=$src
- src=""
-
- if [ -d $dst ]; then
- instcmd=:
- chmodcmd=""
- else
- instcmd=mkdir
- fi
-else
-
-# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
-# might cause directories to be created, which would be especially bad
-# if $src (and thus $dsttmp) contains '*'.
-
- if [ -f $src -o -d $src ]
- then
- true
- else
- echo "install: $src does not exist"
- exit 1
- fi
-
- if [ x"$dst" = x ]
- then
- echo "install: no destination specified"
- exit 1
- else
- true
- fi
-
-# If destination is a directory, append the input filename; if your system
-# does not like double slashes in filenames, you may need to add some logic
-
- if [ -d $dst ]
- then
- dst="$dst"/`basename $src`
- else
- true
- fi
-fi
-
-## this sed command emulates the dirname command
-dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
-
-# Make sure that the destination directory exists.
-# this part is taken from Noah Friedman's mkinstalldirs script
-
-# Skip lots of stat calls in the usual case.
-if [ ! -d "$dstdir" ]; then
-defaultIFS='
-'
-IFS="${IFS-${defaultIFS}}"
-
-oIFS="${IFS}"
-# Some sh's can't handle IFS=/ for some reason.
-IFS='%'
-set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'`
-IFS="${oIFS}"
-
-pathcomp=''
-
-while [ $# -ne 0 ] ; do
- pathcomp="${pathcomp}${1}"
- shift
-
- if [ ! -d "${pathcomp}" ] ;
- then
- $mkdirprog "${pathcomp}"
- else
- true
- fi
-
- pathcomp="${pathcomp}/"
-done
-fi
-
-if [ x"$dir_arg" != x ]
-then
- $doit $instcmd $dst &&
-
- if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
- if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
- if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
- if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
-else
-
-# If we're going to rename the final executable, determine the name now.
-
- if [ x"$transformarg" = x ]
- then
- dstfile=`basename $dst`
- else
- dstfile=`basename $dst $transformbasename |
- sed $transformarg`$transformbasename
- fi
-
-# don't allow the sed command to completely eliminate the filename
-
- if [ x"$dstfile" = x ]
- then
- dstfile=`basename $dst`
- else
- true
- fi
-
-# Make a temp file name in the proper directory.
-
- dsttmp=$dstdir/#inst.$$#
-
-# Move or copy the file name to the temp name
-
- $doit $instcmd $src $dsttmp &&
-
- trap "rm -f ${dsttmp}" 0 &&
-
-# and set any options; do chmod last to preserve setuid bits
-
-# If any of these fail, we abort the whole thing. If we want to
-# ignore errors from any of these, just make sure not to ignore
-# errors from the above "$doit $instcmd $src $dsttmp" command.
-
- if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
- if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
- if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
- if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&
-
-# Now rename the file to the real destination.
-
- $doit $rmcmd -f $dstdir/$dstfile &&
- $doit $mvcmd $dsttmp $dstdir/$dstfile
-
-fi &&
-
-
-exit 0
diff --git a/cil/lib/Cilly.pm b/cil/lib/Cilly.pm
deleted file mode 100644
index fa7aa53b7f24333437c94bbd2f3f122f2382c9de..0000000000000000000000000000000000000000
--- a/cil/lib/Cilly.pm
+++ /dev/null
@@ -1,2137 +0,0 @@
-#
-#
-# Copyright (c) 2001-2002,
-# George C. Necula <necula@cs.berkeley.edu>
-# Scott McPeak <smcpeak@cs.berkeley.edu>
-# Wes Weimer <weimer@cs.berkeley.edu>
-# All rights reserved.
-#
-# Redistribution and use in source and binary forms, with or without
-# modification, are permitted provided that the following conditions are
-# met:
-#
-# 1. Redistributions of source code must retain the above copyright
-# notice, this list of conditions and the following disclaimer.
-#
-# 2. Redistributions in binary form must reproduce the above copyright
-# notice, this list of conditions and the following disclaimer in the
-# documentation and/or other materials provided with the distribution.
-#
-# 3. The names of the contributors may not be used to endorse or promote
-# products derived from this software without specific prior written
-# permission.
-#
-# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
-# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
-# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
-# OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-# EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-#
-
-
-
-# This module implements a compiler stub that parses the command line
-# arguments of gcc and Microsoft Visual C (along with some arguments for the
-# script itself) and gives hooks into preprocessing, compilation and linking.
-
-
-$::cilbin = 'bin';
-
-package Cilly;
-@ISA = ();
-
-use strict;
-use File::Basename;
-use File::Copy;
-use File::Spec;
-use Data::Dumper;
-use Carp;
-use Text::ParseWords;
-
-use KeptFile;
-use OutputFile;
-use TempFile;
-
-$Cilly::savedSourceExt = "_saved.c";
-
-# Pass to new a list of command arguments
-sub new {
- my ($proto, @args) = @_;
-
- my $class = ref($proto) || $proto;
-
- my $ref =
- { CFILES => [], # C input files
- SFILES => [], # Assembly language files
- OFILES => [], # Other input files
- IFILES => [], # Already preprocessed files
- EARLY_PPARGS => [], # Preprocessor args, first (pre-CIL) pass only
- PPARGS => [], # Preprocessor args
- CCARGS => [], # Compiler args
- LINKARGS => [], # Linker args
- NATIVECAML => 1, # this causes the native code boxer to be used
- RELEASELIB => 0, # if true, use the release runtime library (if any)
- # IDASHI => 1, # if true, pass "-I-" to gcc's preprocessor
- IDASHDOT => 1, # if true, pass "-I." to gcc's preprocessor
- VERBOSE => 0, # when true, print extra detail
- TRACE_COMMANDS => 1, # when true, echo commands being run
- SEPARATE => ! $::default_is_merge,
- LIBDIR => [],
- OPERATION => 'TOEXE', # This is the default for all compilers
- };
- my $self = bless $ref, $class;
-
- if(! @args) {
- print "No arguments passed\n";
- $self->printHelp();
- exit 0;
- }
- # Look for the --mode argument first. If not found it is GCC
- my $mode = $::default_mode;
- {
- my @args1 = ();
- foreach my $arg (@args) {
- if($arg =~ m|--mode=(.+)$|) {
- $mode = $1;
- } else {
- push @args1, $arg;
- }
- }
- @args = @args1; # These are the argument after we extracted the --mode
-
- }
- if(defined $self->{MODENAME} && $self->{MODENAME} ne $mode) {
- die "Cannot re-specify the compiler";
- }
- {
- my $compiler;
- if($mode eq "MSVC") {
- unshift @Cilly::ISA, qw(MSVC);
- $compiler = MSVC->new($self);
- } elsif($mode eq "GNUCC") {
- unshift @Cilly::ISA, qw(GNUCC);
- $compiler = GNUCC->new($self);
- } elsif($mode eq "MSLINK") {
- unshift @Cilly::ISA, qw(MSLINK);
- $compiler = MSLINK->new($self);
- } elsif($mode eq "MSLIB") {
- unshift @Cilly::ISA, qw(MSLIB);
- $compiler = MSLIB->new($self);
- } elsif($mode eq "AR") {
- unshift @Cilly::ISA, qw(AR);
- $compiler = AR->new($self);
- } else {
- die "Don't know about compiler $mode\n";
- }
- # Now grab the fields from the compiler and put them inside self
- my $key;
- foreach $key (keys %{$compiler}) {
- $self->{$key} = $compiler->{$key};
- }
-
- # For MSVC we have to use --save-temps because otherwise the
- # temporary files get deleted somehow before CL gets at them !
- if($mode ne "GNUCC" && $mode ne "AR") {
- $self->{SAVE_TEMPS} = '.';
- }
- }
-
- # Scan and process the arguments
- $self->setDefaultArguments;
- collectArgumentList($self, @args);
-
- # sm: if an environment variable is set, then do not merge; this
- # is intended for use in ./configure scripts, where merging delays
- # the reporting of errors that the script is expecting
- if (defined($ENV{"CILLY_NOMERGE"})) {
- $self->{SEPARATE} = 1;
- if($self->{VERBOSE}) { print STDERR "Merging disabled by CILLY_NOMERGE\n"; }
- }
-
-# print Dumper($self);
-
- return $self;
-}
-
-# Hook to let subclasses set/override default arguments
-sub setDefaultArguments {
-}
-
-# work through an array of arguments, processing each one
-sub collectArgumentList {
- my ($self, @args) = @_;
-
- # Scan and process the arguments
- while($#args >= 0) {
- my $arg = $self->fetchNextArg(\@args);
-
- if(! defined($arg)) {
- last;
- }
- if($arg eq "") { next; }
-
- #print("arg: $arg\n");
-#
-# my $arg = shift @args; # Grab the next one
- if(! $self->collectOneArgument($arg, \@args)) {
- print "Warning: Unknown argument $arg\n";
- push @{$self->{CCARGS}}, $arg;
- }
- }
-}
-
-# Grab the next argument
-sub fetchNextArg {
- my ($self, $pargs) = @_;
- return shift @{$pargs};
-}
-
-# Collecting arguments. Take a look at one argument. If we understand it then
-# we return 1. Otherwise we return 0. Might pop some more arguments from pargs.
-sub collectOneArgument {
- my($self, $arg, $pargs) = @_;
- my $res;
- # Maybe it is a compiler option or a source file
- if($self->compilerArgument($self->{OPTIONS}, $arg, $pargs)) { return 1; }
-
- if($arg eq "--help" || $arg eq "-help") {
- $self->printVersion();
- $self->printHelp();
- exit 1;
- }
- if($arg eq "--version" || $arg eq "-version") {
- $self->printVersion(); exit 0;
- }
- if($arg eq "--verbose") {
- $self->{VERBOSE} = 1; return 1;
- }
- if($arg eq "--flatten_linker_scripts") {
- $self->{FLATTEN_LINKER_SCRIPTS} = 1; return 1;
- }
- if($arg eq '--nomerge') {
- $self->{SEPARATE} = 1;
- return 1;
- }
- if($arg eq '--merge') {
- $self->{SEPARATE} = 0;
- return 1;
- }
- if($arg =~ "--ccargs=(.+)\$") {
- push @{$self->{CCARGS}}, $1;
- return 1;
- }
- if($arg eq '--trueobj') {
- $self->{TRUEOBJ} = 1;
- return 1;
- }
- # zf: force curing when linking to a lib
- if ($arg eq '--truelib') {
- $self->{TRUELIB} = 1;
- return 1;
- }
- if($arg eq '--keepmerged') {
- $self->{KEEPMERGED} = 1;
- return 1;
- }
- if($arg eq '--stdoutpp') {
- $self->{STDOUTPP} = 1;
- return 1;
- }
- if($arg =~ m|--save-temps=(.+)$|) {
- if(! -d $1) {
- die "Cannot find directory $1";
- }
- $self->{SAVE_TEMPS} = $1;
- return 1;
- }
- if($arg eq '--save-temps') {
- $self->{SAVE_TEMPS} = '.';
- return 1;
- }
- if($arg =~ m|--leavealone=(.+)$|) {
- push @{$self->{LEAVEALONE}}, $1;
- return 1;
- }
- if($arg =~ m|--includedir=(.+)$|) {
- push @{$self->{INCLUDEDIR}}, $1; return 1;
- }
- if($arg =~ m|--stages|) {
- $self->{SHOWSTAGES} = 1;
- push @{$self->{CILARGS}}, $arg;
- return 1;
- }
- if($arg eq "--bytecode") {
- $self->{NATIVECAML} = 0; return 1;
- }
-# if($arg eq "--no-idashi") {
-# $self->{IDASHI} = 0; return 1;
-# }
- if($arg eq "--no-idashdot") {
- $self->{IDASHDOT} = 0; return 1;
- }
-
- # sm: response file
- if($arg =~ m|-@(.+)$| ||
- (($self->{MODENAME} eq "MSVC" ||
- $self->{MODENAME} eq "MSLINK" ||
- $self->{MODENAME} eq "MSLIB") && $arg =~ m|@(.+)$|)) {
- my $fname = $1; # name of response file
- &classifyArgDebug("processing response file: $fname\n");
-
- # read the lines into an array
- if (!open(RF, "<$fname")) {
- die("cannot open response file $fname: $!\n");
- }
- my @respArgs = ();
- while(<RF>) {
- # Drop spaces and empty lines
- my ($middle) = ($_ =~ m|\s*(\S.*\S)\s*|);
- if($middle ne "") {
- # Sometimes we have multiple arguments in one line :-()
- if($middle =~ m|\s| &&
- $middle !~ m|[\"]|) {
- # Contains spaces and no quotes
- my @middles = split(/\s+/, $middle);
- push @respArgs, @middles;
- } else {
- push @respArgs, $middle;
- }
-# print "Arg:$middle\n";
- }
- }
- close(RF) or die;
-
-
- # Scan and process the arguments
- collectArgumentList($self, @respArgs);
-
- #print("done with response file: $fname\n");
- return 1; # argument undestood
- }
- if($arg eq "-@" || ($self->{MODENAME} eq "MSVC" && $arg eq "@")) {
- # sm: I didn't implement the case where it takes the next argument
- # because I wasn't sure how to grab add'l args (none of the
- # cases above do..)
- die("For ccured/cilly, please don't separate the -@ from the\n",
- "response file name. e.g., use -@", "respfile.\n");
- }
-
- # Intercept the --out argument
- if($arg =~ m|^--out=(\S+)$|) {
- $self->{CILLY_OUT} = $1;
- push @{$self->{CILARGS}}, "--out", $1;
- return 1;
- }
- # All other arguments starting with -- are passed to CIL
- if($arg =~ m|^--|) {
- # Split the ==
- if($arg =~ m|^(--\S+)=(.+)$|) {
- push @{$self->{CILARGS}}, $1, $2; return 1;
- } else {
- push @{$self->{CILARGS}}, $arg; return 1;
- }
- }
- return 0;
-}
-
-
-sub printVersion {
- system ($CilCompiler::compiler, '--version');
-}
-
-sub printHelp {
- my($self) = @_;
- $self->usage();
- print <<EOF;
-
-Options:
- --mode=xxx What tool to emulate:
- GNUCC - GNU gcc
- AR - GNU ar
- MSVC - MS VC cl compiler
- MSLINK - MS VC link linker
- MSLIB - MS VC lib linker
- This option must be the first one! If it is not found there
- then GNUCC mode is assumed.
- --help (or -help) Prints this help message.
- --verbose Prints a lot of information about what is being done.
- --save-temps Keep temporary files in the current directory.
- --save-temps=xxx Keep temporary files in the given directory.
-
- --nomerge Apply CIL separately to each source file as they are compiled.
- By default CIL is applied to the whole program during linking.
- --merge Apply CIL to the merged program.
- --keepmerged Save the merged file. Only useful if --nomerge is not given.
- --trueobj Do not write preprocessed sources in .obj/.o files but
- create some other files (e.g. foo.o_saved.c).
- --truelib When linking to a library (with -r or -i), output real
- object files instead of preprocessed sources. This only
- works for GCC right now.
- --leavealone=xxx Leave alone files whose base name is xxx. This means
- they are not merged and not processed with CIL.
- --includedir=xxx Adds a new include directory to replace existing ones
- --bytecode Invoke the bytecode (as opposed to native code) system
-
-EOF
-# --no-idashi Do not use '-I-' with the gcc preprocessor.
- $self->helpMessage();
-}
-
-# For printing the first line of the help message
-sub usage {
- my ($self) = @_;
- print "<No usage is defined>";
-}
-
-# The rest of the help message
-sub helpMessage {
- my ($self) = @_;
- print <<EOF;
-Send bugs to necula\@cs.berkeley.edu.
-EOF
-}
-
-
-#
-# Normalize a file name to always use slashes
-#
-sub normalizeFileName {
- my($f) = @_;
- $f =~ s|\\|/|g;
- return $f;
-}
-
-#
-# The basic routines: for ech source file preprocess, compile, then link
-# everything
-#
-#
-
-
-# LINKING into a library (with COMPILATION and PREPROCESSING)
-sub straight_linktolib {
- my ($self, $psrcs, $dest, $ppargs, $ccargs, $ldargs) = @_;
- my @sources = ref($psrcs) ? @{$psrcs} : ($psrcs);
- my @dest = $dest eq "" ? () : ($self->{OUTLIB} . $dest);
- # Pass the linkargs last because some libraries must be passed after
- # the sources
- my @cmd = (@{$self->{LDLIB}}, @dest, @{$ppargs}, @{$ccargs}, @sources, @{$ldargs});
- return $self->runShell(@cmd);
-}
-
-# Customize the linking into libraries
-sub linktolib {
- my($self, $psrcs, $dest, $ppargs, $ccargs, $ldargs) = @_;
- if($self->{VERBOSE}) { print STDERR "Linking into library $dest\n"; }
-
- # Now collect the files to be merged
- my ($tomerge, $trueobjs, $ccargs) =
- $self->separateTrueObjects($psrcs, $ccargs);
-
- if($self->{SEPARATE} || @{$tomerge} == 0) {
- # Not merging. Regular linking.
-
- return $self->straight_linktolib($psrcs, $dest,
- $ppargs, $ccargs, $ldargs);
- }
- # We are merging. Merge all the files into a single one
-
- if(@{$trueobjs} > 0) {
- # We have some true objects. Save them into an additional file
- my $trueobjs_file = "$dest" . "_trueobjs";
- if($self->{VERBOSE}) {
- print STDERR
- "Saving additional true object files in $trueobjs_file\n";
- }
- open(TRUEOBJS, ">$trueobjs_file") || die "Cannot write $trueobjs_file";
- foreach my $true (@{$trueobjs}) {
- my $abs = File::Spec->rel2abs($true);
- print TRUEOBJS "$abs\n";
- }
- close(TRUEOBJS);
- }
- if(@{$tomerge} == 1) { # Just copy the file over
- (!system('cp', '-f', ${$tomerge}[0], $dest))
- || die "Cannot copy ${$tomerge}[0] to $dest\n";
- return ;
- }
- #
- # We must do real merging
- #
- # Prepare the name of the CIL output file based on dest
- my ($base, $dir, $ext) = fileparse($dest, "(\\.[^.]+)");
-
- # Now prepare the command line for invoking cilly
- my ($aftercil, @cmd) = $self->MergeCommand ($psrcs, $dir, $base);
- die unless $cmd[0];
-
- if($self->{MODENAME} eq "MSVC") {
- push @cmd, "--MSVC";
- }
- if($self->{VERBOSE}) {
- push @cmd, "--verbose";
- }
- if(defined $self->{CILARGS}) {
- push @cmd, @{$self->{CILARGS}};
- }
- # Eliminate duplicates
-
- # Add the arguments
- if(@{$tomerge} > 20) {
- my $extraFile = "___extra_files";
- open(TOMERGE, ">$extraFile") || die $!;
- #FRANJO added the following on February 15th, 2005
- #REASON: extrafiles was TempFIle=HASH(0x12345678)
- # instead of actual filename
- my @normalized = @{$tomerge} ;
- $_ = (ref $_ ? $_->filename : $_) foreach @normalized;
- foreach my $fl (@normalized) {
- print TOMERGE "$fl\n";
- }
- close(TOMERGE);
- push @cmd, '--extrafiles', $extraFile;
- } else {
- push @cmd, @{$tomerge};
- }
- push @cmd, "--mergedout", $dest;
- # Now run cilly
- return $self->runShell(@cmd);
-}
-
-############
-############ PREPROCESSING
-############
-#
-# All flavors of preprocessing return the destination file
-#
-
-# THIS IS THE ENTRY POINT FOR COMPILING SOURCE FILES
-sub preprocess_compile {
- my ($self, $src, $dest, $early_ppargs, $ppargs, $ccargs) = @_;
- &mydebug("preprocess_compile(src=$src, dest=$dest)\n");
- Carp::confess "bad dest: $dest" unless $dest->isa('OutputFile');
-
- my ($base, $dir, $ext) = fileparse($src, "\\.[^.]+");
- if($ext eq ".c" || $ext eq ".cpp" || $ext eq ".cc") {
- if($self->leaveAlone($src)) {
- print "Leaving alone $src\n";
- # We leave this alone. So just compile as usual
- return $self->straight_compile($src, $dest, $early_ppargs, $ppargs, $ccargs);
- }
- my $out = $self->preprocessOutputFile($src);
- $out = $self->preprocess($src, $out,
- [@{$early_ppargs}, @{$ppargs},
- "$self->{DEFARG}CIL=1"]);
- return $self->compile($out, $dest, $ppargs, $ccargs);
- }
- if($ext eq ".i") {
- return $self->compile($src, $dest, $ppargs, $ccargs);
- }
- if($ext eq ".$::cilbin") {
- return $self->compile($src, $dest, $ppargs, $ccargs);
- }
-}
-
-# THIS IS THE ENTRY POINT FOR JUST PREPROCESSING A FILE
-sub preprocess {
- my($self, $src, $dest, $ppargs) = @_;
- Carp::confess "bad dest: $dest" unless $dest->isa('OutputFile');
- return $self->preprocess_before_cil($src, $dest, $ppargs);
-}
-
-# Find the name of the preprocessed file before CIL processing
-sub preprocessOutputFile {
- my($self, $src) = @_;
- return $self->outputFile($src, 'i');
-}
-
-# Find the name of the preprocessed file after CIL processing
-sub preprocessAfterOutputFile {
- my($self, $src) = @_;
- return $self->outputFile($src, 'cil.i');
-}
-
-# When we use CIL we have two separate preprocessing stages. First is the
-# preprocessing before the CIL sees the code and the is the preprocessing
-# after CIL sees the code
-
-sub preprocess_before_cil {
- my ($self, $src, $dest, $ppargs) = @_;
- Carp::confess "bad dest: $dest" unless $dest->isa('OutputFile');
- my @args = @{$ppargs};
-
- # See if we must force some includes
- if(defined $self->{INCLUDEDIR} && !defined($ENV{"CILLY_NOCURE"})) {
- # And force the other includes. Put them at the begining
- if(($self->{MODENAME} eq 'GNUCC') &&
- # sm: m88k doesn't work if I pass -I.
- $self->{IDASHDOT}) {
- unshift @args, "-I.";
- }
- if(! defined($self->{VERSION})) {
- $self->setVersion();
- }
- unshift @args,
- map { my $dir = $_;
- $self->{INCARG} . $dir . "/" . $self->{VERSION} }
- @{$self->{INCLUDEDIR}};
- #matth: include the main include dir as well as the compiler-specific directory
- unshift @args,
- map { my $dir = $_;
- $self->{INCARG} . $dir }
- @{$self->{INCLUDEDIR}};
- if($self->{MODENAME} eq 'GNUCC') {
- # sm: this is incompatible with wu-ftpd, but is apparently needed
- # for apache.. more investigation is needed
- # update: now when I try it, apache works without -I- also.. but
- # I'll make this into a switchable flag anyway
- # matth: this breaks other tests. Let's try without.
-# if ($self->{IDASHI}) {
-# unshift @args, "-I-";
-# }
- }
- }
-
- return $self->straight_preprocess($src, $dest, \@args);
-}
-
-# Preprocessing after CIL
-sub preprocess_after_cil {
- my ($self, $src, $dest, $ppargs) = @_;
- Carp::confess "bad dest: $dest" unless $dest->isa('OutputFile');
- return $self->straight_preprocess($src, $dest, $ppargs);
-}
-
-#
-# This is intended to be the true invocation of the underlying preprocessor
-# You should not override this method
-sub straight_preprocess {
- my ($self, $src, $dest, $ppargs) = @_;
- Carp::confess "bad dest: $dest" unless $dest->isa('OutputFile');
- if($self->{VERBOSE}) {
- my $srcname = ref $src ? $src->filename : $src;
- print STDERR "Preprocessing $srcname\n";
- }
- if($self->{MODENAME} eq "MSVC" ||
- $self->{MODENAME} eq "MSLINK" ||
- $self->{MODENAME} eq "MSLIB") {
- $self->MSVC::msvc_preprocess($src, $dest, $ppargs);
- } else {
-# print Dumper($self);
- my @cmd = (@{$self->{CPP}}, @{$ppargs},
- $src, $self->makeOutArguments($self->{OUTCPP}, $dest));
- $self->runShell(@cmd);
-
- }
- return $dest;
-}
-
-
-#
-#
-#
-# COMPILATION
-#
-#
-
-sub compile {
- my($self, $src, $dest, $ppargs, $ccargs) = @_;
- &mydebug("Cilly.compile(src=$src, dest=$dest->{filename})\n");
- Carp::confess "bad dest: $dest->{filename}"
- unless $dest->isa('OutputFile');
-
- if($self->{SEPARATE}) {
- # Now invoke CIL and compile afterwards
- return $self->applyCilAndCompile([$src], $dest, $ppargs, $ccargs);
- }
- # We are merging
- # If we are merging then we just save the preprocessed source
- my ($mtime, $res, $outfile);
- if(! $self->{TRUEOBJ}) {
- $outfile = $dest->{filename}; $mtime = 0; $res = $dest;
- } else {
- # Do the real compilation
- $res = $self->straight_compile($src, $dest, $ppargs, $ccargs);
- # Now stat the result
- my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
- $atime,$mtime_1,$ctime,$blksize,$blocks) = stat($dest->{filename});
- if(! defined($mtime_1)) {
- die "Cannot stat the result of compilation $dest->{filename}";
- }
- $mtime = $mtime_1;
- $outfile = $dest->{filename} . $Cilly::savedSourceExt;
- }
- my $srcname = ref $src ? $src->filename : $src;
- if($self->{VERBOSE}) {
- print STDERR "Saving source $srcname into $outfile\n";
- }
- open(OUT, ">$outfile") || die "Cannot create $outfile";
- my $toprintsrc = $srcname;
- $toprintsrc =~ s|\\|/|g;
- print OUT "#pragma merger($mtime,\"$toprintsrc\",\"" .
- join(',', @{$ccargs}), "\")\n";
- open(IN, '<', $srcname) || die "Cannot read $srcname";
- while(<IN>) {
- print OUT $_;
- }
- close(OUT);
- close(IN);
- return $res;
-}
-
-sub makeOutArguments {
- my ($self, $which, $dest) = @_;
- $dest = $dest->{filename} if ref $dest;
- if($self->{MODENAME} eq "MSVC" ||
- $self->{MODENAME} eq "MSLINK" ||
- $self->{MODENAME} eq "MSLIB") {
- # A single argument
- return ("$which$dest");
- } else {
- return ($which, $dest);
- }
-}
-# This is the actual invocation of the underlying compiler. You should not
-# override this
-sub straight_compile {
- my ($self, $src, $dest, $ppargs, $ccargs) = @_;
- if($self->{VERBOSE}) {
- print STDERR 'Compiling ', ref $src ? $src->filename : $src, ' into ',
- $dest->filename, "\n";
- }
- my @dest =
- $dest eq "" ? () : $self->makeOutArguments($self->{OUTOBJ}, $dest);
- my @forcec = @{$self->{FORCECSOURCE}};
- my @cmd = (@{$self->{CC}}, @{$ppargs}, @{$ccargs},
- @dest, @forcec, $src);
- return $self->runShell(@cmd);
-}
-
-# This is compilation after CIL
-sub compile_cil {
- my ($self, $src, $dest, $ppargs, $ccargs) = @_;
- return $self->straight_compile($src, $dest, $ppargs, $ccargs);
-}
-
-
-
-# THIS IS THE ENTRY POINT FOR JUST ASSEMBLING FILES
-sub assemble {
- my ($self, $src, $dest, $ppargs, $ccargs) = @_;
- if($self->{VERBOSE}) { print STDERR "Assembling $src\n"; }
- my @dest =
- $dest eq "" ? () : $self->makeOutArguments($self->{OUTOBJ}, $dest);
- my @cmd = (@{$self->{CC}}, @{$ppargs}, @{$ccargs},
- @dest, $src);
- return $self->runShell(@cmd);
-}
-
-
-
-#
-# This is intended to be the true invocation of the underlying linker
-# You should not override this method
-sub straight_link {
- my ($self, $psrcs, $dest, $ppargs, $ccargs, $ldargs) = @_;
- my @sources = ref($psrcs) ? @{$psrcs} : ($psrcs);
- my @dest =
- $dest eq "" ? () : $self->makeOutArguments($self->{OUTEXE}, $dest);
- # Pass the linkargs last because some libraries must be passed after
- # the sources
- my @cmd = (@{$self->{LD}}, @dest,
- @{$ppargs}, @{$ccargs}, @sources, @{$ldargs});
- return $self->runShell(@cmd);
-}
-
-#
-# See if some libraries are actually lists of files
-sub expandLibraries {
- my ($self) = @_;
-
- my @tolink = @{$self->{OFILES}};
-
- # Go through the sources and replace all libraries with the files that
- # they contain
- my @tolink1 = ();
- while($#tolink >= 0) {
- my $src = shift @tolink;
-# print "Looking at $src\n";
- # See if the source is a library. Then maybe we should get instead the
- # list of files
- if($src =~ m|\.$self->{LIBEXT}$| && -f "$src.files") {
- open(FILES, "<$src.files") || die "Cannot read $src.files";
- while(<FILES>) {
- # Put them back in the "tolink" to process them recursively
- while($_ =~ m|[\r\n]$|) {
- chop;
- }
- unshift @tolink, $_;
- }
- close(FILES);
- next;
- }
- # This is not for us
- push @tolink1, $src;
- next;
- }
- $self->{OFILES} = \@tolink1;
-}
-
-# Go over a list of object files and separate them into those that are
-# actually sources to be merged, and the true object files
-#
-sub separateTrueObjects {
- my ($self, $psrcs, $ccargs) = @_;
-
- my @sources = @{$psrcs};
-# print "Sources are @sources\n";
- my @tomerge = ();
- my @othersources = ();
-
- my @ccmerged = @{$ccargs};
- foreach my $src (@sources) {
- my ($combsrc, $combsrcname, $mtime);
- my $srcname = ref $src ? $src->filename : $src;
- if(! $self->{TRUEOBJ}) {
- # We are using the object file itself to save the sources
- $combsrcname = $srcname;
- $combsrc = $src;
- $mtime = 0;
- } else {
- $combsrcname = $srcname . $Cilly::savedSourceExt;
- $combsrc = $combsrcname;
- if(-f $combsrcname) {
- my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
- $atime,$mtime_1,$ctime,$blksize,$blocks) = stat($srcname);
- $mtime = $mtime_1;
- } else {
- $mtime = 0;
- }
- }
- # Look inside and see if it is one of the files created by us
- open(IN, "<$combsrcname") || die "Cannot read $combsrcname";
- my $fstline = <IN>;
- close(IN);
- if($fstline =~ m|CIL|) {
- goto ToMerge;
- }
- if($fstline =~ m|^\#pragma merger\((\d+),\".*\",\"(.*)\"\)$|) {
- my $mymtime = $1;
- # Get the CC flags
- my @thisccargs = split(/,/, $2);
- foreach my $arg (@thisccargs) {
- # print "Looking at $arg\n ccmerged=@ccmerged\n";
- if(! grep(/$arg/, @ccmerged)) {
- # print " adding it\n";
- push @ccmerged, $arg
- }
- }
- ToMerge:
- if($mymtime == $mtime) { # It is ours
- # See if we have this already
- if(! grep { $_ eq $srcname } @tomerge) { # It is ours
- push @tomerge, $combsrc;
- # See if there is a a trueobjs file also
- my $trueobjs = $combsrcname . "_trueobjs";
- if(-f $trueobjs) {
- open(TRUEOBJS, "<$trueobjs")
- || die "Cannot read $trueobjs";
- while(<TRUEOBJS>) {
- chop;
- push @othersources, $_;
- }
- close(TRUEOBJS);
- }
- }
- next;
- }
- }
- push @othersources, $combsrc;
- }
- # If we are merging, turn off "warnings are errors" flag
- if(grep(/$self->{WARNISERROR}/, @ccmerged)) {
- @ccmerged = grep(!/$self->{WARNISERROR}/, @ccmerged);
- print STDERR "Turning off warn-is-error flag $self->{WARNISERROR}\n";
- }
-
- return (\@tomerge, \@othersources, \@ccmerged);
-}
-
-
-# Customize the linking
-sub link {
- my($self, $psrcs, $dest, $ppargs, $ccargs, $ldargs) = @_;
- my $destname = ref $dest ? $dest->filename : $dest;
- if($self->{SEPARATE}) {
- if (!defined($ENV{CILLY_DONT_LINK_AFTER_MERGE})) {
- if($self->{VERBOSE}) { print STDERR "Linking into $destname\n"; }
- # Not merging. Regular linking.
- return $self->link_after_cil($psrcs, $dest,
- $ppargs, $ccargs, $ldargs);
- }
- else {
- return 0; # sm: is this value used??
- }
- }
- my $mergedobj = new OutputFile($destname,
- "${destname}_comb.$self->{OBJEXT}");
-
- # We must merge
- if($self->{VERBOSE}) {
- print STDERR "Merging saved sources into $mergedobj->{filename} (in process of linking $destname)\n";
- }
-
- # Now collect the files to be merged
-
- my ($tomerge, $trueobjs, $ccargs) =
- $self->separateTrueObjects($psrcs, $ccargs);
-
- if($self->{VERBOSE}) {
- print STDERR "Will merge the following: ",
- join(' ', @{$tomerge}), "\n";
- print STDERR "Will just link the genuine object files: ",
- join(' ', @{$trueobjs}), "\n";
- print STDERR "After merge compile flags: @{$ccargs}\n";
- }
- # Check the modification times and see if we can just use the combined
- # file instead of merging all over again
- if(@{$tomerge} > 1 && $self->{KEEPMERGED}) {
- my $canReuse = 1;
- my $combFile = new OutputFile($destname,
- "${destname}_comb.c");
- my @tmp = stat($combFile);
- my $combFileMtime = $tmp[9] || 0;
- foreach my $mrg (@{$tomerge}) {
- my @tmp = stat($mrg); my $mtime = $tmp[9];
- if($mtime >= $combFileMtime) { goto DoMerge; }
- }
- if($self->{VERBOSE}) {
- print STDERR "Reusing merged file $combFile\n";
- }
- $self->applyCilAndCompile([$combFile], $mergedobj, $ppargs, $ccargs);
- } else {
- DoMerge:
- $self->applyCilAndCompile($tomerge, $mergedobj, $ppargs, $ccargs);
- }
-
- # Put the merged OBJ at the beginning because maybe some of the trueobjs
- # are libraries which like to be at the end
- unshift @{$trueobjs}, $mergedobj;
-
- # And finally link
- # zf: hack for linking linux stuff
- if ($self->{TRUELIB}) {
- my @cmd = (@{$self->{LDLIB}}, ($dest),
- @{$ppargs}, @{$ccargs}, @{$trueobjs}, @{$ldargs});
- return $self->runShell(@cmd);
- }
-
- # sm: hack: made this conditional for dsw
- if (!defined($ENV{CILLY_DONT_LINK_AFTER_MERGE})) {
- $self->link_after_cil($trueobjs, $dest, $ppargs, $ccargs, $ldargs);
- }
-
-}
-
-sub applyCil {
- my ($self, $ppsrc, $dest) = @_;
-
- # The input files
- my @srcs = @{$ppsrc};
-
- # Now prepare the command line for invoking cilly
- my ($aftercil, @cmd) = $self->CillyCommand ($ppsrc, $dest);
- Carp::confess "$self produced bad output file: $aftercil"
- unless $aftercil->isa('OutputFile');
-
- if($self->{MODENAME} eq "MSVC" ||
- $self->{MODENAME} eq "MSLINK" ||
- $self->{MODENAME} eq "MSLIB") {
- push @cmd, '--MSVC';
- }
- if($self->{VERBOSE}) {
- push @cmd, '--verbose';
- }
- if(defined $self->{CILARGS}) {
- push @cmd, @{$self->{CILARGS}};
- }
-
- # Add the arguments
- if(@srcs > 20) {
- my $extraFile = "___extra_files";
- open(TOMERGE, ">$extraFile") || die $!;
- foreach my $fl (@srcs) {
- my $fname = ref $fl ? $fl->filename : $fl;
- print TOMERGE "$fname\n";
- }
- close(TOMERGE);
- push @cmd, '--extrafiles', $extraFile;
- } else {
- push @cmd, @srcs;
- }
- if(@srcs > 1 && $self->{KEEPMERGED}) {
- my ($base, $dir, undef) = fileparse($dest->filename, qr{\.[^.]+});
- push @cmd, '--mergedout', "$dir$base" . '.c';
- }
- # Now run cilly
- $self->runShell(@cmd);
-
- # Tell the caller where we put the output
- return $aftercil;
-}
-
-
-sub applyCilAndCompile {
- my ($self, $ppsrc, $dest, $ppargs, $ccargs) = @_;
- Carp::confess "$self produced bad destination file: $dest"
- unless $dest->isa('OutputFile');
-
- # The input files
- my @srcs = @{$ppsrc};
- &mydebug("Cilly.PM.applyCilAndCompile(srcs=[",join(',',@{$ppsrc}),"])\n");
-
- # Now run cilly
- my $aftercil = $self->applyCil($ppsrc, $dest);
- Carp::confess "$self produced bad output file: $aftercil"
- unless $aftercil->isa('OutputFile');
-
- # Now preprocess
- my $aftercilpp = $self->preprocessAfterOutputFile($aftercil);
- $self->preprocess_after_cil($aftercil, $aftercilpp, $ppargs);
-
- if (!defined($ENV{CILLY_DONT_COMPILE_AFTER_MERGE})) {
- # Now compile
- return $self->compile_cil($aftercilpp, $dest, $ppargs, $ccargs);
- }
-}
-
-# Linking after CIL
-sub link_after_cil {
- my ($self, $psrcs, $dest, $ppargs, $ccargs, $ldargs) = @_;
- if (!defined($ENV{CILLY_DONT_COMPILE_AFTER_MERGE})) {
- return $self->straight_link($psrcs, $dest, $ppargs, $ccargs, $ldargs);
- }
-}
-
-# See if we must merge this one
-sub leaveAlone {
- my($self, $filename) = @_;
- my ($base, $dir, $ext) = fileparse($filename, "(\\.[^.]+)");
- if(grep { $_ eq $base } @{$self->{LEAVEALONE}}) {
- return 1;
- } else {
- return 0;
- }
-}
-
-
-# DO EVERYTHING
-sub doit {
- my ($self) = @_;
- my $file;
- my $out;
-
-# print Dumper($self);
-
- # Maybe we must preprocess only
- if($self->{OPERATION} eq "TOI" || $self->{OPERATION} eq 'SPECIAL') {
- # Then we do not do anything
- my @cmd = (@{$self->{CPP}},
- @{$self->{EARLY_PPARGS}},
- @{$self->{PPARGS}}, @{$self->{CCARGS}},
- @{$self->{CFILES}}, @{$self->{SFILES}});
- push @cmd, @{$self->{OUTARG}} if defined $self->{OUTARG};
-
- return $self->runShell(@cmd);
- }
- # We expand some libraries names. Maybe they just contain some
- # new object files
- $self->expandLibraries();
-
- # Try to guess whether to run in the separate mode. In that case
- # we can go ahead with the compilation, without having to save
- # files
- if(! $self->{SEPARATE} && # Not already separate mode
- $self->{OPERATION} eq "TOEXE" && # We are linking to an executable
- @{$self->{CFILES}} + @{$self->{IFILES}} <= 1) { # At most one source
- # If we have object files, we should keep merging if at least one
- # object file is a disguised source
- my $turnOffMerging = 0;
- if(@{$self->{OFILES}}) {
- my ($tomerge, $trueobjs, $mergedccargs) =
- $self->separateTrueObjects($self->{OFILES}, $self->{CCARGS});
- $self->{CCARGS} = $mergedccargs;
- $turnOffMerging = (@{$tomerge} == 0);
- } else {
- $turnOffMerging = 1;
- }
- if($turnOffMerging) {
- if($self->{VERBOSE}) {
- print STDERR
- "Turn off merging because the program contains one file\n";
- }
- $self->{SEPARATE} = 1;
- }
- }
-
- # Turn everything into OBJ files
- my @tolink = ();
-
- foreach $file (@{$self->{IFILES}}, @{$self->{CFILES}}) {
- $out = $self->compileOutputFile($file);
- $self->preprocess_compile($file, $out,
- $self->{EARLY_PPARGS},
- $self->{PPARGS}, $self->{CCARGS});
- push @tolink, $out;
- }
- # Now do the assembly language file
- foreach $file (@{$self->{SFILES}}) {
- $out = $self->assembleOutputFile($file);
- $self->assemble($file, $out, $self->{PPARGS}, $self->{CCARGS});
- push @tolink, $out;
- }
- # Now add the original object files. Put them last because libraries like
- # to be last.
- push @tolink, @{$self->{OFILES}};
-
- # See if we must stop after compilation
- if($self->{OPERATION} eq "TOOBJ") {
- return;
- }
-
- # See if we must create a library only
- if($self->{OPERATION} eq "TOLIB") {
- if (!$self->{TRUELIB}) {
- # zf: Creating a library containing merged source
- $out = $self->linkOutputFile(@tolink);
- $self->linktolib(\@tolink, $out,
- $self->{PPARGS}, $self->{CCARGS},
- $self->{LINKARGS});
- return;
- } else {
- # zf: Linking to a true library. Do real curing.
- # Only difference from TOEXE is that we use "partial linking" of the
- # underlying linker
- if ($self->{VERBOSE}) {
- print STDERR "Linking to a true library!";
- }
- push @{$self->{CCARGS}}, "-r";
- $out = $self->linkOutputFile(@tolink);
- $self->link(\@tolink, $out,
- $self->{PPARGS}, $self->{CCARGS}, $self->{LINKARGS});
- return;
- }
-
- }
-
- # Now link all of the files into an executable
- if($self->{OPERATION} eq "TOEXE") {
- $out = $self->linkOutputFile(@tolink);
- $self->link(\@tolink, $out,
- $self->{PPARGS}, $self->{CCARGS}, $self->{LINKARGS});
- return;
- }
-
- die "I don't understand OPERATION:$self->{OPERATION}\n";
-}
-
-sub classifyArgDebug {
- if(0) { print @_; }
-}
-
-sub mydebug {
- if(0) { print @_; }
-}
-
-sub compilerArgument {
- my($self, $options, $arg, $pargs) = @_;
- &classifyArgDebug("Classifying arg: $arg\n");
- my $idx = 0;
- for($idx=0; $idx < $#$options; $idx += 2) {
- my $key = ${$options}[$idx];
- my $action = ${$options}[$idx + 1];
- &classifyArgDebug("Try match with $key\n");
- if($arg =~ m|^$key|) {
- &classifyArgDebug(" match with $key\n");
- my @fullarg = ($arg);
- my $onemore;
- if(defined $action->{'ONEMORE'}) {
- &classifyArgDebug(" expecting one more\n");
- # Maybe the next arg is attached
- my $realarg;
- ($realarg, $onemore) = ($arg =~ m|^($key)(.+)$|);
- if(! defined $onemore) {
- # Grab the next argument
- $onemore = $self->fetchNextArg($pargs);
- $onemore = "eIfNecessary($onemore);
- push @fullarg, $onemore;
- } else {
- $onemore = "eIfNecessary($onemore);
- }
- &classifyArgDebug(" onemore=$onemore\n");
- }
- # Now see what action we must perform
- my $argument_done = 1;
- if(defined $action->{'RUN'}) {
- &{$action->{'RUN'}}($self, @fullarg, $onemore, $pargs);
- $argument_done = 1;
- }
- # Quote special SHELL caracters
- @fullarg = map { $_ =~ s%([<>;&|])%'$1'%g; $_ } @fullarg;
- # print "fullarg = ", @fullarg, "\n";
- if(defined $action->{'TYPE'}) {
- &classifyArgDebug(" type=$action->{TYPE}\n");
- if($action->{TYPE} eq 'EARLY_PREPROC') {
- push @{$self->{EARLY_PPARGS}}, @fullarg; return 1;
- }
- elsif($action->{TYPE} eq "PREPROC") {
- push @{$self->{PPARGS}}, @fullarg; return 1;
- }
- elsif($action->{TYPE} eq 'SPECIAL') {
- push @{$self->{PPARGS}}, @fullarg;
- $self->{OPERATION} = 'SPECIAL';
- return 1;
- }
- elsif($action->{TYPE} eq "CC") {
- push @{$self->{CCARGS}}, @fullarg; return 1;
- }
- elsif($action->{TYPE} eq "LINKCC") {
- push @{$self->{CCARGS}}, @fullarg;
- push @{$self->{LINKARGS}}, @fullarg; return 1;
- }
- elsif($action->{TYPE} eq "ALLARGS") {
- push @{$self->{PPARGS}}, @fullarg;
- push @{$self->{CCARGS}}, @fullarg;
- push @{$self->{LINKARGS}}, @fullarg; return 1;
- }
- elsif($action->{TYPE} eq "LINK") {
- push @{$self->{LINKARGS}}, @fullarg; return 1;
- }
- elsif($action->{TYPE} eq "CSOURCE") {
- OutputFile->protect(@fullarg);
- $fullarg[0] = &normalizeFileName($fullarg[0]);
- push @{$self->{CFILES}}, @fullarg; return 1;
- }
- elsif($action->{TYPE} eq "ASMSOURCE") {
- OutputFile->protect(@fullarg);
- $fullarg[0] = &normalizeFileName($fullarg[0]);
- push @{$self->{SFILES}}, @fullarg; return 1;
- }
- elsif($action->{TYPE} eq "OSOURCE") {
- OutputFile->protect(@fullarg);
- $fullarg[0] = &normalizeFileName($fullarg[0]);
- push @{$self->{OFILES}}, @fullarg; return 1;
- }
- elsif($action->{TYPE} eq "ISOURCE") {
- OutputFile->protect(@fullarg);
- $fullarg[0] = &normalizeFileName($fullarg[0]);
- push @{$self->{IFILES}}, @fullarg; return 1;
- }
- elsif($action->{TYPE} eq 'OUT') {
- if(defined($self->{OUTARG})) {
- print "Warning: output file is multiply defined: @{$self->{OUTARG}} and @fullarg\n";
- }
- $fullarg[0] = &normalizeFileName($fullarg[0]);
- $self->{OUTARG} = [@fullarg]; return 1;
- }
- print " Do not understand TYPE\n"; return 1;
- }
- if($argument_done) { return 1; }
- print "Don't know what to do with option $arg\n";
- return 0;
- }
- }
- return 0;
-}
-
-
-sub runShell {
- my ($self, @cmd) = @_;
-
- my $msvcFriends =
- ($self->{MODENAME} eq "MSVC" ||
- $self->{MODENAME} eq "MSLINK" ||
- $self->{MODENAME} eq "MSLIB");
-
- foreach (@cmd) {
- $_ = $_->filename if ref;
- # If we are in MSVC mode then we might have to convert the files
- # from cygwin names to the actual Windows names
- if($msvcFriends && $^O eq "cygwin") {
- my $arg = $_;
- if ($arg =~ m|^/| && -f $arg) {
- my $mname = `cygpath -m $arg`;
- chop $mname;
- if($mname ne "") { $_ = $mname; }
- }
- }
- }
-
- # sm: I want this printed to stderr instead of stdout
- # because the rest of 'make' output goes there and this
- # way I can capture to a coherent file
- # sm: removed conditional on verbose since there's already
- # so much noise in the output, and this is the *one* piece
- # of information I *always* end up digging around for..
- if($self->{TRACE_COMMANDS}) { print STDERR "@cmd\n"; }
-
- # weimer: let's have a sanity check
- my $code = system { $cmd[0] } @cmd;
- if ($code != 0) {
- # sm: now that we always print, don't echo the command again,
- # since that makes the output more confusing
- #die "Possible error with @cmd!\n";
- $code >>= 8; # extract exit code portion
-
- exit $code;
- }
- return $code;
-}
-
-sub quoteIfNecessary {
- my($arg) = @_;
- # If it contains spaces or "" then it must be quoted
- if($arg =~ m|\s| || $arg =~ m|\"|) {
- return "\'$arg\'";
- } else {
- return $arg;
- }
-}
-
-
-sub cilOutputFile {
- Carp::croak 'bad argument count' unless @_ == 3;
- my ($self, $basis, $suffix) = @_;
-
- if (defined $self->{SAVE_TEMPS}) {
- return new KeptFile($basis, $suffix, $self->{SAVE_TEMPS});
- } else {
- return $self->outputFile($basis, $suffix);
- }
-}
-
-
-sub outputFile {
- Carp::confess 'bad argument count' unless @_ == 3;
- my ($self, $basis, $suffix) = @_;
-
- if (defined $self->{SAVE_TEMPS}) {
- return new KeptFile($basis, $suffix, $self->{SAVE_TEMPS});
- } else {
- return new TempFile($basis, $suffix);
- }
-}
-
-
-###########################################################################
-####
-#### MS CL specific code
-####
-package MSVC;
-
-use strict;
-use File::Basename;
-use Data::Dumper;
-
-# For MSVC we remember which was the first source, because we use that to
-# determine the name of the output file
-sub setFirstSource {
- my ($self, $src) = @_;
-
- if(! defined ($self->{FIRST_SOURCE})) {
- $self->{FIRST_SOURCE} = $src;
- }
-}
-
-sub new {
- my ($proto, $stub) = @_;
- my $class = ref($proto) || $proto;
- # Create $self
-
- my $self =
- { NAME => 'Microsoft cl compiler',
- MODENAME => 'MSVC',
- CC => ['cl', '/nologo', '/D_MSVC', '/c'],
- CPP => ['cl', '/nologo', '/D_MSVC', '/P'],
- LD => ['cl', '/nologo', '/D_MSVC'],
- DEFARG => "/D",
- INCARG => "/I",
- DEBUGARG => ['/Zi', '/MLd', '/DEBUG'],
- OPTIMARG => ['/Ox', '/G6'],
- OBJEXT => "obj",
- LIBEXT => "lib", # Library extension (without the .)
- EXEEXT => ".exe", # Executable extension (with the .)
- OUTOBJ => "/Fo",
- OUTEXE => "/Fe",
- WARNISERROR => "/WX",
- FORCECSOURCE => ['/Tc'],
- LINEPATTERN => "^#line\\s+(\\d+)\\s+\"(.+)\"",
-
- OPTIONS =>
-# Describe the compiler options as a list of patterns and associated actions.
-# The patterns are matched in order against the _begining_ of the argument.
-#
-# If the action contains ONEMORE => 1 then the argument is expected to be
-# parameterized by a following word. The word can be attached immediately to
-# the end of the argument or in a separate word.
-#
-# If the action contains TYPE => "..." then the argument is put into
-# one of several lists, as follows: "PREPROC" in ppargs; "CC" in
-# ccargs; "LINK" in linkargs; "LINKCC" both in ccargs and linkargs;
-# "ALLARGS" in ppargs, ccargs, and linkargs; "CSOURCE" in cfiles;
-# "ASMSOURCE" in sfiles; "OSOURCE" in ofiles; "ISOURCE" in ifiles;
-# "OUT" in outarg. "SPECIAL" flags indicate that the compiler should
-# be run directly so that it can perform some special action other
-# than generating code (e.g. printing out version or configuration
-# information).
-#
-# If the TYPE is not defined but the RUN => sub { ... } is defined then the
-# given subroutine is invoked with the self, the argument and the (possibly
-# empty) additional word and a pointer to the list of remaining arguments
-#
- ["^[^/\\-@].*\\.($::cilbin|c|cpp|cc)\$" =>
- { TYPE => 'CSOURCE',
- RUN => sub { &MSVC::setFirstSource(@_); } },
- "[^/].*\\.(asm)\$" => { TYPE => 'ASMSOURCE' },
- "[^/].*\\.i\$" => { TYPE => 'ISOURCE' },
- "[^/\\-@]" => { TYPE => "OSOURCE" },
- "[/\\-]O" => { TYPE => "CC" },
- "[/\\-][DI]" => { TYPE => "PREPROC"},
- "[/\\-]EH" => { TYPE => "CC" },
- "[/\\-]G" => { TYPE => "CC" },
- "[/\\-]F[aA]" => { TYPE => 'CC' },
- "[/\\-]Fo" => { TYPE => 'OUT' },
- "/Fe" => { TYPE => 'OUT',
- RUN => sub { $stub->{OPERATION} = "TOEXE" }},
- "[/\\-]F[dprR]" => { TYPE => "CC" },
- "[/\\-]FI" => { TYPE => "PREPROC" },
- "[/\\-][CXu]" => { TYPE => "PREPROC" },
- "[/\\-]U" => { ONEMORE => 1, TYPE => "PREPROC" },
- "[/\\-](E|EP|P)" => { RUN => sub { push @{$stub->{PPARGS}}, $_[1];
- $stub->{OPERATION} = "PREPROC"; }},
- "[/\\-]c" => { RUN => sub { $stub->{OPERATION} = "TOOBJ"; }},
- "[/\\-](Q|Z|J|nologo|w|W|Zm)" => { TYPE => "CC" },
- "[/\\-]Y(u|c|d|l|X)" => { TYPE => "CC" },
- "[/\\-]T(C|P)" => { TYPE => "PREPROC" },
- "[/\\-]Tc(.+)\$" =>
- { RUN => sub {
- my $arg = $_[1];
- my ($fname) = ($arg =~ m|[/\\-]Tc(.+)$|);
- $fname = &normalizeFileName($fname);
- push @{$stub->{CFILES}}, $fname;
- }},
- "[/\\-]v(d|m)" => { TYPE => "CC" },
- "[/\\-]F" => { TYPE => "CC" },
- "[/\\-]M" => { TYPE => 'LINKCC' },
- "/link" => { RUN => sub { push @{$stub->{LINKARGS}}, "/link",
- @{$_[3]};
- @{$_[3]} = (); } },
- "-cbstring" => { TYPE => "CC" },
- "/" => { RUN =>
- sub { print "Unimplemented MSVC argument $_[1]\n";}},
- ],
- };
- bless $self, $class;
- return $self;
-}
-
-
-sub msvc_preprocess {
- my($self, $src, $dest, $ppargs) = @_;
- my $res;
- my $srcname = ref $src ? $src->filename : $src;
- my ($sbase, $sdir, $sext) =
- fileparse($srcname,
- "(\\.c)|(\\.cc)|(\\.cpp)|(\\.i)");
- # If this is a .cpp file we still hope it is C. Pass the /Tc argument to
- # cl to force this file to be interpreted as a C one
- my @cmd = @{$ppargs};
-
- if($sext eq ".cpp") {
- push @cmd, "/Tc";
- }
- # MSVC cannot be told where to put the output. But we know that it
- # puts it in the current directory
- my $msvcout = "./$sbase.i";
- if($self->{STDOUTPP}) {
- @cmd = ('cmd', '/c', 'cl', '/nologo', '/E', ">$msvcout", '/D_MSVC',
- @cmd);
-
- } else {
- @cmd = ('cl', '/nologo', '/P', '/D_MSVC', @cmd);
- }
- $res = $self->runShell(@cmd, $srcname);
- # Check file equivalence by making sure that all elements of the stat
- # structure are the same, except for the access time.
- my @st1 = stat $msvcout; $st1[8] = 0;
- my @st2 = stat $dest->{filename}; $st2[8] = 0;
- # print Dumper(\@st1, \@st2);
- if($msvcout ne $dest->{filename}) {
- while($#st1 >= 0) {
- if(shift @st1 != shift @st2) {
-# print "$msvcout is NOT the same as $afterpp\n";
- if($self->{VERBOSE}) {
- print STDERR "Copying $msvcout to $dest->{filename} (MSVC_preprocess)\n";
- }
- unlink $dest;
- File::Copy::copy($msvcout, $dest->filename);
- unlink $msvcout;
- return $res;
- }
- }
- }
- return $res;
-}
-
-sub forceIncludeArg {
- my($self, $what) = @_;
- return "/FI$what";
-}
-
-
- # MSVC does not understand the extension .i, so we tell it it is a C file
-sub fixupCsources {
- my (@csources) = @_;
- my @mod_csources = ();
- my $src;
- foreach $src (@csources) {
- my ($sbase, $sdir, $sext) = fileparse($src,
- "\\.[^.]+");
- if($sext eq ".i") {
- push @mod_csources, "/Tc";
- }
- push @mod_csources, $src;
- }
- return @mod_csources;
-}
-
-
-# Emit a line # directive
-sub lineDirective {
- my ($self, $fileName, $lineno) = @_;
- return "#line $lineno \"$fileName\"\n";
-}
-
-# The name of the output file
-sub compileOutputFile {
- my($self, $src) = @_;
-
- die "compileOutputFile: not a C source file: $src\n"
- unless $src =~ /\.($::cilbin|c|cc|cpp|i|asm)$/;
-
- Carp::carp ("compileOutputFile: $self->{OPERATION}, $src",
- Dumper($self->{OUTARG})) if 0;
- if ($self->{OPERATION} eq 'TOOBJ') {
- if(defined $self->{OUTARG}
- && "@{$self->{OUTARG}}" =~ m|[/\\-]Fo(.+)|) {
- my $dest = $1;
- # Perhaps $dest is a directory
- if(-d $dest) {
- return new KeptFile($src, $self->{OBJEXT}, $dest);
- } else {
- return new OutputFile($src, $1);
- }
- } else {
- return new KeptFile($src, $self->{OBJEXT}, '.');
- }
- } else {
-# die "compileOutputfile: operation is not TOOBJ";
- return $self->outputFile($src, $self->{OBJEXT});
- }
-}
-
-sub assembleOutputFile {
- my($self, $src) = @_;
- return $self->compileOutputFile($src);
-}
-
-sub linkOutputFile {
- my($self, $src) = @_;
- $src = $src->filename if ref $src;
- if(defined $self->{OUTARG} && "@{$self->{OUTARG}}" =~ m|/Fe(.+)|) {
- return $1;
- }
- # Use the name of the first source file, in the current directory
- my ($base, $dir, $ext) = fileparse ($src, "\\.[^.]+");
- return "./$base.exe";
-}
-
-sub setVersion {
- my($self) = @_;
- my $cversion = "";
- open(VER, "cl 2>&1|") || die "Cannot start Microsoft CL\n";
- while(<VER>) {
- if($_ =~ m|Compiler Version (\S+) |) {
- $cversion = "cl_$1";
- close(VER);
- $self->{VERSION} = $cversion;
- return;
- }
- }
- die "Cannot find Microsoft CL version\n";
-}
-
-########################################################################
-##
-## MS LINK specific code
-##
-###
-package MSLINK;
-
-use strict;
-
-use File::Basename;
-use Data::Dumper;
-
-sub new {
- my ($proto, $stub) = @_;
- my $class = ref($proto) || $proto;
-
- # Create a MSVC compiler object
- my $msvc = MSVC->new($stub);
-
- # Create $self
-
- my $self =
- { NAME => 'Microsoft linker',
- MODENAME => 'MSLINK',
- CC => $msvc->{CC},
- CPP => $msvc->{CPP},
- LD => ['link'],
- DEFARG => $msvc->{DEFARG},
- INCARG => $msvc->{INCARG},
- DEBUGARG => ['/DEBUG'],
- OPTIMARG => [],
- LDLIB => ['lib'],
- OBJEXT => "obj",
- LIBEXT => "lib", # Library extension (without the .)
- EXEEXT => ".exe", # Executable extension (with the .)
- OUTOBJ => $msvc->{OUTOBJ},
- OUTEXE => "-out:", # Keep this form because build.exe looks for it
- WARNISERROR => "/WX",
- LINEPATTERN => "",
- FORCECSOURCE => $msvc->{FORCECSOURCE},
-
- MSVC => $msvc,
-
- OPTIONS =>
- ["[^/\\-@]" => { TYPE => 'OSOURCE' },
- "[/\\-](OUT|out):" => { TYPE => 'OUT' },
- "^((/)|(\\-[^\\-]))" => { TYPE => 'LINK' },
- ],
- };
- bless $self, $class;
- return $self;
-}
-
-
-sub forceIncludeArg { # Same as for CL
- my($self, $what) = @_;
- return "/FI$what";
-}
-
-
-
-sub linkOutputFile {
- my($self, $src) = @_;
-# print Dumper($self);
- Carp::confess "Cannot compute the linker output file"
- if ! defined $self->{OUTARG};
-
- if("@{$self->{OUTARG}}" =~ m|.+:(.+)|) {
- return $1;
- }
- die "I do not know what is the link output file\n";
-}
-
-sub setVersion {
- my($self) = @_;
- my $cversion = "";
- open(VER, "link 2>&1|") || die "Cannot start Microsoft LINK\n";
- while(<VER>) {
- if($_ =~ m|Linker Version (\S+)|) {
- $cversion = "link_$1";
- close(VER);
- $self->{VERSION} = $cversion;
- return;
- }
- }
- die "Cannot find Microsoft LINK version\n";
-}
-
-########################################################################
-##
-## MS LIB specific code
-##
-###
-package MSLIB;
-
-our @ISA = qw(MSLINK);
-
-use strict;
-
-use File::Basename;
-use Data::Dumper;
-
-sub new {
- my ($proto, $stub) = @_;
- my $class = ref($proto) || $proto;
-
- # Create a MSVC linker object
- my $self = MSLINK->new($stub);
-
- $self->{NAME} = 'Microsoft librarian';
- $self->{MODENAME} = 'MSLIB';
- $self->{OPERATION} = "TOLIB";
- $self->{LDLIB} = ['lib'];
- bless $self, $class;
- return $self;
-}
-
-sub setVersion {
- my($self) = @_;
- my $cversion = "";
- open(VER, "lib 2>&1|") || die "Cannot start Microsoft LIB\n";
- while(<VER>) {
- if($_ =~ m|Library Manager Version (\S+)|) {
- $cversion = "lib_$1";
- close(VER);
- $self->{VERSION} = $cversion;
- return;
- }
- }
- die "Cannot find Microsoft LINK version\n";
-}
-
-########################################################################
-##
-## GNU ar specific code
-##
-###
-package AR;
-
-use strict;
-
-use File::Basename;
-use Data::Dumper;
-
-sub new {
- my ($proto, $stub) = @_;
- my $class = ref($proto) || $proto;
- # Create $self
-
- my $self =
- { NAME => 'Archiver',
- MODENAME => 'ar',
- CC => ['no_compiler_in_ar_mode'],
- CPP => ['no_compiler_in_ar_mode'],
- LDLIB => ['ar', 'crv'],
- DEFARG => "??DEFARG",
- INCARG => '??INCARG',
- DEBUGARG => ['??DEBUGARG'],
- OPTIMARG => [],
- OBJEXT => "o",
- LIBEXT => "a", # Library extension (without the .)
- EXEEXT => "", # Executable extension (with the .)
- OUTOBJ => "??OUTOBJ",
- OUTLIB => "", # But better be first
- LINEPATTERN => "",
-
- OPTIONS =>
- ["^[^-]" => { RUN => \&arArguments } ]
-
- };
- bless $self, $class;
- return $self;
-}
-
-# We handle arguments in a special way for AR
-sub arArguments {
- my ($self, $arg, $onemore, $pargs) = @_;
- # If the first argument starts with -- pass it on
- if($arg =~ m|^--|) {
- return 0;
- }
- # We got here for the first non -- argument.
- # Will handle all arguments at once
- if($self->{VERBOSE}) {
- print "AR called with $arg @{$pargs}\n";
- }
-
- #The r flag is required:
- if($arg !~ m|r| || $#{$pargs} < 0) {
- die "Error: CCured's AR mode implements only the r and cr operations.";
- }
- if($arg =~ /[^crvus]/) {
- die "Error: CCured's AR mode supports only the c, r, u, s, and v flags.";
- }
- if($arg =~ /v/) {
- $self->{VERBOSE} = 1;
- }
-
- if($arg =~ /c/)
- {
- # Command is "cr":
- # Get the name of the library
- my $out = shift @{$pargs};
- $self->{OUTARG} = [$out];
- unlink $out;
- }
- else
- {
- # if the command is "r" alone, we should add to the current library,
- # not replace it, unless the library does not exist
-
- # Get the name of the library
- my $out = shift @{$pargs};
- $self->{OUTARG} = [$out];
-
- #The library is both an input and an output.
- #To avoid problems with reading and writing the same file, move the
- #current version of the library out of the way first.
- if(-f $out) {
-
- my $temp_name = $out . "_old.a";
- if($self->{VERBOSE}) {
- print "Copying $out to $temp_name so we can add "
- . "to it.\n";
- }
- if(-f $temp_name) {
- unlink $temp_name;
- }
- rename $out, $temp_name;
-
- #now use $temp_name as the input. $self->{OUTARG} will,
- # as usual, be the output.
- push @{$self->{OFILES}}, $temp_name;
- } else {
- warn "Library $out not found; creating.";
- }
-
- }
-
- # The rest of the arguments must be object files
- push @{$self->{OFILES}}, @{$pargs};
- $self->{OPERATION} = 'TOLIB';
- @{$pargs} = ();
-# print Dumper($self);
- return 1;
-}
-
-sub linkOutputFile {
- my($self, $src) = @_;
- if(defined $self->{OUTARG}) {
- return "@{$self->{OUTARG}}";
- }
- die "I do not know what is the link output file\n";
-}
-
-sub setVersion {
- # sm: bin/cilly wants this for all "compilers"
-}
-
-
-#########################################################################
-##
-## GNUCC specific code
-##
-package GNUCC;
-
-use strict;
-
-use File::Basename;
-
-# The variable $::cc is inherited from the main script!!
-
-sub new {
- my ($proto, $stub) = @_;
- my $class = ref($proto) || $proto;
- # Create $self
-
- my @native_cc = Text::ParseWords::shellwords($ENV{CILLY_NATIVE_CC} || $::cc);
-
- my $self =
- { NAME => 'GNU CC',
- MODENAME => 'GNUCC', # do not change this since it is used in code
- # sm: added -O since it's needed for inlines to be merged instead of causing link errors
- # sm: removed -O to ease debugging; will address "inline extern" elsewhere
- CC => [@native_cc, '-D_GNUCC', '-c'],
- LD => [@native_cc, '-D_GNUCC'],
- LDLIB => ['ld', '-r', '-o'],
- CPP => [@native_cc, '-D_GNUCC', '-E'],
- DEFARG => "-D",
- INCARG => "-I",
- DEBUGARG => ['-g', '-ggdb'],
- OPTIMARG => ['-O4'],
- CPROFILEARG => '-pg',
- LPROFILEARG => '-pg',
- OBJEXT => "o",
- LIBEXT => "a",
- EXEEXT => "",
- OUTOBJ => '-o',
- OUTEXE => '-o',
- OUTCPP => '-o',
- WARNISERROR => "-Werror",
- FORCECSOURCE => [],
- LINEPATTERN => "^#\\s+(\\d+)\\s+\"(.+)\"",
-
- OPTIONS =>
- [ "[^-].*\\.($::cilbin|c|cpp|cc)\$" => { TYPE => 'CSOURCE' },
- "[^-].*\\.(s|S)\$" => { TYPE => 'ASMSOURCE' },
- "[^-].*\\.i\$" => { TYPE => 'ISOURCE' },
- # .o files can be linker scripts
- "[^-]" => { RUN => sub { &GNUCC::parseLinkerScript(@_); }},
- "-E" => { RUN => sub { $stub->{OPERATION} = "TOI"; }},
- "-pipe\$" => { TYPE => 'ALLARGS' },
- "-[DIU]" => { ONEMORE => 1, TYPE => "PREPROC" },
- "-isystem" => { ONEMORE => 1, TYPE => "PREPROC" },
- '-undef$' => { TYPE => 'PREPROC' },
- '-w$' => { TYPE => 'PREPROC' },
- '-M$' => { TYPE => 'SPECIAL' },
- '-MM$' => { TYPE => 'SPECIAL' },
- '-MF$' => { TYPE => 'EARLY_PREPROC', ONEMORE => 1 },
- '-C$' => { TYPE => 'EARLY_PREPROC'}, # zra
- '-MG$' => { TYPE => 'EARLY_PREPROC' },
- '-MP$' => { TYPE => 'EARLY_PREPROC' },
- '-MT$' => { TYPE => 'EARLY_PREPROC', ONEMORE => 1 },
- '-MQ$' => { TYPE => 'EARLY_PREPROC', ONEMORE => 1 },
- '-MD$' => { TYPE => 'EARLY_PREPROC' },
- '-MMD$' => { TYPE => 'EARLY_PREPROC' },
- "-include" => { ONEMORE => 1, TYPE => "PREPROC" }, # sm
- "-iwithprefix" => { ONEMORE => 1, TYPE => "PREPROC" },
- '-Wp,' => { TYPE => 'PREPROC' },
- "-ansi" => { TYPE => 'ALLARGS' },
- "-c" => { RUN => sub { $stub->{OPERATION} = "TOOBJ"; }},
- "-x" => { ONEMORE => 1, TYPE => "CC" },
- "-v" => { TYPE => 'ALLARGS',
- RUN => sub { $stub->{TRACE_COMMANDS} = 1; } },
- "^-e\$" => { ONEMORE => 1, TYPE => 'LINK' },
- "^-T\$" => { ONEMORE => 1, TYPE => 'LINK' },
- # GCC defines some more macros if the optimization is On so pass
- # the -O to the preprocessor and the compiler
- '-O' => { TYPE => 'ALLARGS' },
- "-S" => { RUN => sub { $stub->{OPERATION} = "TOOBJ";
- push @{$stub->{CCARGS}}, $_[1]; }},
- "-o" => { ONEMORE => 1, TYPE => 'OUT' },
- "-p\$" => { TYPE => 'LINKCC' },
- "-pg" => { TYPE => 'LINKCC' },
- "-a" => { TYPE => 'LINKCC' },
- "-pedantic\$" => { TYPE => 'ALLARGS' },
- "-Wall" => { TYPE => 'CC',
- RUN => sub { push @{$stub->{CILARGS}},"--warnall";}},
- "-W[-a-z]*\$" => { TYPE => 'CC' },
- '-g' => { TYPE => 'ALLARGS' },
- "-save-temps" => { TYPE => 'ALLARGS',
- RUN => sub { if(! defined $stub->{SAVE_TEMPS}) {
- $stub->{SAVE_TEMPS} = '.'; } }},
- '--?print-' => { TYPE => 'SPECIAL' },
- '-dump' => { TYPE => 'SPECIAL' },
- "-l" =>
- { RUN => sub {
- my ($libname) = ($_[1] =~ m|-l(.+)$|);
- # See if we can find this library in the LIBDIR
- my @libdirs = @{$stub->{LIBDIR}};
- if($#libdirs == -1) {
- push @libdirs, '.';
- }
- foreach my $d (@libdirs) {
- if(-f "$d/lib$libname.a") {
- # Pretend that we had a straight argument
- push @{$stub->{OFILES}}, "$d/lib$libname.a";
- return;
- }
- }
- # We get here when we cannot find the library in the LIBDIR
- push @{$stub->{LINKARGS}}, $_[1];
- }},
- "-L" =>
- { RUN => sub {
- # Remember these directories in LIBDIR
- my ($dir) = ($_[1] =~ m|-L(.+)$|);
- push @{$stub->{LIBDIR}}, $dir;
- push @{$stub->{LINKARGS}}, $_[1];
- }},
- "-f" => { TYPE => 'LINKCC' },
- "-r\$" => { RUN => sub { $stub->{OPERATION} = "TOLIB"; }},
- "-i\$" => { RUN => sub { $stub->{OPERATION} = "TOLIB"; }},
- "-m" => { TYPE => 'LINKCC', ONEMORE => 1 },
- "-s\$" => { TYPE => 'LINKCC' },
- "-Xlinker" => { ONEMORE => 1, TYPE => 'LINK' },
- "-nostdlib" => { TYPE => 'LINK' },
- "-nostdinc" => { TYPE => 'PREPROC' },
- '-rdynamic$' => { TYPE => 'LINK' },
- "-static" => { TYPE => 'LINK' },
- "-shared" => { TYPE => 'LINK' },
- "-static-libgcc" => { TYPE => 'LINK' },
- "-shared-libgcc" => { TYPE => 'LINK' },
- '-Wl,--(no-)?whole-archive$' => { TYPE => 'OSOURCE' },
- '-Wl,' => { TYPE => 'LINK' },
- "-traditional" => { TYPE => 'PREPROC' },
- '-std=' => { TYPE => 'ALLARGS' },
- "--start-group" => { RUN => sub { } },
- "--end-group" => { RUN => sub { }},
- "-pthread\$" => { TYPE => 'ALLARGS' },
- ],
-
- };
- bless $self, $class;
- return $self;
-}
-# '
-
-my $linker_script_debug = 0;
-sub parseLinkerScript {
- my($self, $filename, $onemore, $pargs) = @_;
-
- if(! defined($self->{FLATTEN_LINKER_SCRIPTS}) ||
- $filename !~ /\.o$/) {
- NotAScript:
- warn "$filename is not a linker script\n" if $linker_script_debug;
- push @{$self->{OFILES}}, $filename;
- return 1;
- }
- warn "parsing OBJECT FILE:$filename ****************\n" if
- $linker_script_debug;
- open OBJFILE, $filename or die $!;
- my $line = <OBJFILE>;
- if ($line !~ /^INPUT/) {
- close OBJFILE or die $!;
- goto NotAScript;
- }
- warn "\tYES an INPUT file.\n" if $linker_script_debug;
- my @lines = <OBJFILE>; # Read it all and close it
- unshift @lines, $line;
- close OBJFILE or die $!;
- # Process recursively each line from the file
- my @tokens = ();
- my $incomment = 0; # Whether we are in a comment
- foreach my $line (@lines) {
- chomp $line;
- if($incomment) {
- # See where the comment ends
- my $endcomment = index($line, "*/");
- if($endcomment < 0) { # No end on this line
- next; # next line
- } else {
- $line = substr($line, $endcomment + 2);
- $incomment = 0;
- }
- }
- # Drop the comments that are on a single line
- $line =~ s|/\*.*\*/| |g;
- # Here if outside comment. See if a comment starts
- my $startcomment = index($line, "/*");
- if($startcomment >= 0) {
- $incomment = 1;
- $line = substr($line, 0, $startcomment);
- }
- # Split the line into tokens. Sicne we use parentheses in the pattern
- # the separators will be tokens as well
- push @tokens, split(/([(),\s])/, $line);
- }
- print "Found tokens:", join(':', @tokens), "\n"
- if $linker_script_debug;
- # Now parse the file
- my $state = 0;
- foreach my $token (@tokens) {
- if($token eq "" || $token =~ /\s+/) { next; } # Skip spaces
- if($state == 0) {
- if($token eq "INPUT") { $state = 1; next; }
- else { die "Error in script: expecting INPUT"; }
- }
- if($state == 1) {
- if($token eq "(") { $state = 2; next; }
- else { die "Error in script: expecting ( after INPUT"; }
- }
- if($state == 2) {
- if($token eq ")") { $state = 0; next; }
- if($token eq ",") { next; } # Comma could be a separator
- # Now we better see a filename
- if(! -f $token) {
- warn "Linker script mentions inexistent file:$token.Ignoring\n";
- next;
- }
- # Process it recursively because it could be a script itself
- warn "LISTED FILE:$token.\n" if $linker_script_debug;
- $self->parseLinkerScript($token, $onemore, $pargs);
- next;
- }
- die "Invalid linker script parser state\n";
-
- }
-}
-
-sub forceIncludeArg {
- my($self, $what) = @_;
- return ('-include', $what);
-}
-
-
-# Emit a line # directive
-sub lineDirective {
- my ($self, $fileName, $lineno) = @_;
- return "# $lineno \"$fileName\"\n";
-}
-
-# The name of the output file
-sub compileOutputFile {
- my($self, $src) = @_;
-
- die "objectOutputFile: not a C source file: $src\n"
- unless $src =~ /\.($::cilbin|c|cc|cpp|i|s|S)$/;
-
- if ($self->{OPERATION} eq 'TOOBJ') {
- if (defined $self->{OUTARG}
- && "@{$self->{OUTARG}}" =~ m|^-o\s*(\S.+)$|) {
- return new OutputFile($src, $1);
- } else {
- return new KeptFile($src, $self->{OBJEXT}, '.');
- }
- } else {
- return $self->outputFile($src, $self->{OBJEXT});
- }
-}
-
-sub assembleOutputFile {
- my($self, $src) = @_;
- return $self->compileOutputFile($src);
-}
-
-sub linkOutputFile {
- my($self, $src) = @_;
- if(defined $self->{OUTARG} && "@{$self->{OUTARG}}" =~ m|-o\s*(\S.+)|) {
- return $1;
- }
- return "a.out";
-}
-
-sub setVersion {
- my($self) = @_;
- my $cversion = "";
- open(VER, "@{$self->{CC}} -dumpversion "
- . join(' ', @{$self->{PPARGS}}) ." |")
- || die "Cannot start GNUCC";
- while(<VER>) {
- if($_ =~ m|^(\d+\S+)| || $_ =~ m|^(egcs-\d+\S+)|) {
- $cversion = "gcc_$1";
- close(VER) || die "Cannot start GNUCC\n";
- $self->{VERSION} = $cversion;
- return;
- }
- }
- die "Cannot find GNUCC version\n";
-}
-
-1;
-
-
-__END__
-
-
-
diff --git a/cil/lib/KeptFile.pm b/cil/lib/KeptFile.pm
deleted file mode 100644
index 904b5145c5aac5ee5e10d88aae9c5159d775fbb7..0000000000000000000000000000000000000000
--- a/cil/lib/KeptFile.pm
+++ /dev/null
@@ -1,88 +0,0 @@
-package KeptFile;
-use OutputFile;
-@ISA = (OutputFile);
-
-use strict;
-use Carp;
-use File::Basename;
-use File::Spec;
-
-
-########################################################################
-
-
-sub new {
- croak 'bad argument count' unless @_ == 4;
- my ($proto, $basis, $suffix, $dir) = @_;
- my $class = ref($proto) || $proto;
-
- $basis = $basis->basis if ref $basis;
- my ($basename, undef, $basefix) = fileparse($basis, qr{\.[^.]+});
- my $filename = File::Spec->catfile($dir, "$basename.$suffix");
-
- my $self = $class->SUPER::new($basis, $filename);
- return $self;
-}
-
-
-########################################################################
-
-
-1;
-
-__END__
-
-
-=head1 Name
-
-KeptFile - persistent compiler output files
-
-=head1 Synopsis
-
- use KeptFile;
-
- my $cppOut = new KeptFile ('code.c', 'i', '/output/directory');
- system 'cpp', 'code.c', '-o', $cppOut->filename;
-
-=head2 Description
-
-C<KeptFile> represents an intermediate output file generated by some
-stage of a C<Cilly>-based compiler that should be retained after
-compilation. It is a concrete subclass of L<OutputFile|OutputFile>.
-Use C<KeptFile> when the user has asked for intermediate files to be
-retained, such as via gcc's C<-save-temps> flag.
-
-=head2 Public Methods
-
-=over
-
-=item new
-
-C<new KeptFile ($basis, $suffix, $dir)> constructs a new C<KeptFile>
-instance. The new file name is constructed using the base file name
-of C<$basis> with its suffix replaced by C<$suffix> and its path given
-by C<$dir>. For example,
-
- new KeptFile ('/foo/code.c', 'i', '/bar')
-
-yields a C<KeptFile> with file name F</bar/code.i>.
-
-C<$basis> may be either absolute or relative; only the trailing file
-name is used. C<$basis> can also be an C<OutputFile> instance, in
-which case C<< $basis->basis >> is used as the actual basis. See
-L<OutputFile/"basis"> for more information on basis flattening.
-
-C<$suffix> should not include a leading dot; this will be added
-automatically.
-
-C<$dir> may be either absolute or relative. It is common to use F<.>
-as the directory, which puts the C<KeptFile> in the current working
-directory.
-
-=back
-
-=head1 See Also
-
-L<OutputFile>, L<TempFile>.
-
-=cut
diff --git a/cil/lib/OutputFile.pm b/cil/lib/OutputFile.pm
deleted file mode 100644
index 8f02ba23e4689a67c6e24615e395f9af9b7618c2..0000000000000000000000000000000000000000
--- a/cil/lib/OutputFile.pm
+++ /dev/null
@@ -1,213 +0,0 @@
-package OutputFile;
-@ISA = ();
-
-use strict;
-use Carp;
-use File::Basename;
-use File::Spec;
-
-
-########################################################################
-
-
-my $debug = 0;
-
-
-sub new {
- croak 'bad argument count' unless @_ == 3;
- my ($proto, $basis, $filename) = @_;
- my $class = ref($proto) || $proto;
-
- $basis = $basis->basis if ref $basis;
- my $ref = { filename => $filename,
- basis => $basis };
- my $self = bless $ref, $class;
-
- $self->checkRef($filename);
- $self->checkRef($basis);
- $self->checkProtected();
- $self->checkTemporary();
-
- Carp::cluck "OutputFile: filename == $filename, basis == $basis" if $debug;
- return $self;
-}
-
-
-sub filename {
- my ($self) = @_;
- return $self->{filename};
-}
-
-
-sub basis {
- my ($self) = @_;
- return $self->{basis};
-}
-
-
-########################################################################
-
-
-sub checkRef {
- my ($self, $filename) = @_;
- confess "ref found where string expected: $filename" if ref $filename;
- confess "stringified ref found where string expected: $filename" if $filename =~ /\w+=HASH\(0x[0-9a-f]+\)/;
-}
-
-
-sub checkTemporary {
- my ($self) = @_;
- my ($basename, $path) = fileparse $self->filename;
- return if $path eq File::Spec->tmpdir . '/';
- confess "found temporary file in wrong directory: ", $self->filename
- if $basename =~ /^cil-[a-zA-Z0-9]{8}\./;
-}
-
-
-########################################################################
-
-
-my @protected = ();
-
-
-sub checkProtected {
- my ($self) = @_;
- my $abs = File::Spec->rel2abs($self->filename);
-
- foreach (@protected) {
- confess "caught attempt to overwrite protected file: ", $self->filename
- if $_ eq $abs;
- }
-}
-
-
-sub protect {
- my ($self, @precious) = @_;
- push @protected, File::Spec->rel2abs($_)
- foreach @precious;
-}
-
-
-########################################################################
-
-
-1;
-
-__END__
-
-
-=head1 Name
-
-OutputFile - base class for intermediate compiler output files
-
-=head1 Description
-
-C<OutputFile> represents an intermediate output file generated by some
-stage of a C<Cilly>-based compiler. This is an abstract base class
-and should never be instantiated directly. It provides common
-behaviors used by concrete subclasses L<KeptFile|KeptFile> and
-L<TempFile|TempFile>.
-
-=head2 Public Methods
-
-=over
-
-=item filename
-
-An C<OutputFile> instance is a smart wrapper around a file name. C<<
-$out->filename >> returns the name of the file represented by
-C<OutputFile> instance C<$out>. When building a command line, this is
-the string to use for the file. For example:
-
- my $out = ... ; # some OutputFile subclass
- my @argv = ('gcc', '-E', '-o', $out->filename, 'input.c');
- system @argv;
-
-C<Cilly> often creates command vectors with a mix of strings and
-C<OutputFile> objects. This is fine, but before using a mixed vector
-as a command line, you must replace all C<OutputFile> objects with
-their corresponding file names:
-
- my @mixed = (...); # mix of strings and objects
- my @normalized = @mixed;
- $_ = (ref $_ ? $_->filename : $_) foreach @normalized;
- system @normalized;
-
-Common utility methods like C<Cilly::runShell> already do exactly this
-normalization, but you may need to do it yourself if you are running
-external commands on your own.
-
-=item protect
-
-C<OutputFile> contains safety interlocks that help it avoid stomping
-on user input files. C<< OutputFile->protect($precious) >> marks
-C<$precious> as a protected input file which should not be
-overwritten. If any C<OutputFile> tries to claim this same file name,
-an error will be raised. In theory, this never happens. In practice,
-scripts can have bugs, and it's better to be safe than sorry.
-
-C<Cilly> uses this method to register input files that it discovers
-during command line processing. If you add special command line
-processing of your own, or if you identify input files through other
-means, we highly recommend using this method as well. Otherwise,
-there is some risk that a buggy client script could mistakenly create
-an output file that destroys the user's source code.
-
-Note that C<protect> is a class method: call it on the C<OutputFile>
-module, rather than on a specific instance.
-
-=back
-
-=head2 Internal Methods
-
-The following methods are used within C<OutputFile> or by
-C<OutputFile> subclasses. They are not intended for use by outside
-scripts.
-
-=over
-
-=item basis
-
-In addition to L<its own file name|/"filename">, each C<OutputFile>
-instance records a second file name: its I<basis>. The basis file
-name is initialized and used differently by different subclasses, but
-typically represents the input file from which this output file is
-derived. C<< $out->basis >> returns the basis file name for instance
-C<$out>.
-
-When instantiating an C<OutputFile>, the caller can provide either a
-file name string as the basis or another C<OutputFile> instance.
-However, basis file names are not chained: if C<< $a->basis >> is
-F<foo.c>, and C<$b> is constructed with C<$a> as its basis, C<<
-$b->basis >> will return F<foo.c>, not C<$a> or C<< $a->filename >>.
-This flattening is done at construction time.
-
-See L<KeptFile/"new"> and L<TempFile/"new"> for more details on how
-basis file names are used.
-
-=item checkRef
-
-C<< OutputFile->checkRef($filename) >> raises an error if C<$filename>
-is an object reference, or looks like the string representation of an
-object reference. Used to sanity check arguments to various methods.
-
-=item checkTemporary
-
-C<< $out->checkTemporary >> raises an error if C<< $out->filename >>
-looks like a temporary file name but is not in the system temporary
-directory. Used to sanity check arguments in various methods.
-
-=item checkProtected
-
-C<< $out->checkProtected >> raises an error if C<< $out->filename >>
-is listed as a protected file. This check, performed at construction
-time, implements a safety interlock to prevent overwriting of user
-input files. Protected files are registered using L<"protect">.
-
-=back
-
-=head1 See Also
-
-L<KeptFile>, L<TempFile>.
-
-=cut
diff --git a/cil/lib/TempFile.pm b/cil/lib/TempFile.pm
deleted file mode 100644
index 608713cfb8d92d94086d9290a2ef0afd0391c7b2..0000000000000000000000000000000000000000
--- a/cil/lib/TempFile.pm
+++ /dev/null
@@ -1,90 +0,0 @@
-package TempFile;
-use OutputFile;
-@ISA = (OutputFile);
-
-use strict;
-use Carp;
-use File::Temp qw(tempfile);
-
-
-########################################################################
-
-
-sub new {
- croak 'bad argument count' unless @_ == 3;
- my ($proto, $basis, $suffix) = @_;
- my $class = ref($proto) || $proto;
-
- my (undef, $filename) = tempfile('cil-XXXXXXXX',
- DIR => File::Spec->tmpdir,
- SUFFIX => ".$suffix",
- UNLINK => 1);
-
- my $self = $class->SUPER::new($basis, $filename);
- return $self;
-}
-
-
-########################################################################
-
-
-1;
-
-__END__
-
-
-=head1 Name
-
-TempFile - transitory compiler output files
-
-=head1 Synopsis
-
- use TempFile;
-
- my $cppOut = new TempFile ('code.c', 'i');
- system 'cpp', 'code.c', '-o', $cppOut->filename;
-
-=head2 Description
-
-C<TempFile> represents an intermediate output file generated by some
-stage of a C<Cilly>-based compiler that should be removed after
-compilation. It is a concrete subclass of L<OutputFile|OutputFile>.
-Use C<TempFile> when the user has asked not for intermediate files to
-be retained.
-
-All C<TempFile> files are removed when the script terminates. This
-cleanup happens for both normal exits as well as fatal errors.
-However, the standard L<Perl exec function|perlfun/exec> does not
-perform cleanups, and therefore should be avoided in scripts that use
-C<TempFile>.
-
-=head2 Public Methods
-
-=over
-
-=item new
-
-C<new TempFile ($basis, $suffix)> constructs a new C<TempFile>
-instance. The new file name is constructed in some system-specific
-temporary directory with a randomly generated file name that ends with
-C<$suffix>. For example,
-
- new TempFile ('/foo/code.c', 'i')
-
-might yield a C<TempFile> with file name F</var/tmp/cil-x9GyA93R.i>.
-
-C<$basis> gives the basis file name for this instance. The file name
-is not used directly, but is retained in case this instance is later
-passed as the basis for some other C<OutputFile>. See
-L<OutputFile/"basis"> for more information on basis flattening.
-
-C<$suffix> should not include a leading dot; this will be added
-automatically.
-
-=back
-
-=head1 See Also
-
-L<OutputFile>, L<TempFile>.
-
-=cut
diff --git a/cil/ocamlutil/Makefile.ocaml b/cil/ocamlutil/Makefile.ocaml
deleted file mode 100644
index 36ac21a5b4bc8521a3c4d89b217e8d3c9d4feae4..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/Makefile.ocaml
+++ /dev/null
@@ -1,395 +0,0 @@
-# -*- Mode: makefile -*-
-# Copyright (c) 2001-2002,
-# George C. Necula <necula@cs.berkeley.edu>
-# Scott McPeak <smcpeak@cs.berkeley.edu>
-# Wes Weimer <weimer@cs.berkeley.edu>
-# All rights reserved.
-#
-# Redistribution and use in source and binary forms, with or without
-# modification, are permitted provided that the following conditions are
-# met:
-#
-# 1. Redistributions of source code must retain the above copyright
-# notice, this list of conditions and the following disclaimer.
-#
-# 2. Redistributions in binary form must reproduce the above copyright
-# notice, this list of conditions and the following disclaimer in the
-# documentation and/or other materials provided with the distribution.
-#
-# 3. The names of the contributors may not be used to endorse or promote
-# products derived from this software without specific prior written
-# permission.
-#
-# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
-# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
-# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
-# OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-# EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
- # Generic Makefile for Ocaml projects
- # Written by necula@cs.berkeley.edu
- #
- # Features:
- # - keeps byproducts of building in a separate directory
- # - handles dependencies automatically
- # - user specifies just what modules go into a project and
- # everything else is done automatically
- # - you can use one Makefile for several Ocaml projects
- #
- # You must include this file in your Makefile. Before the include point
- # you must defined the following variables (which are glob al for all Ocaml
- # projects specified in one Makefile):
- #
- # CAMLDIR - the directory where to get the ocaml executables from.
- # Must be empty (defaul) or end with a /
- # OBJDIR - the directory where to put all object files. This directory
- # must exist (default obj)
- # DEPENDDIR - the directory where to put dependency files. This directory
- # must exist. (default obj/.depend)
- # NATIVECAML - if set then will use the native compiler
- # UNSAFE - if set then will turn off safety checks (only with NATIVECAML)
- # PROFILE - if set then it will compile and link with "gprof" profiling
- # support (NATIVECAML mode only)
- # ASSEMBLY - if set then it will keep assembly files
- # STATIC - if set then it will compile and link statically
- # (NATIVECAML mode only)
- # PREPROC - the preprocessor command
-
- # MODULES - a list of all modules for all projects defined in the
- # Makefile. Give only the basenames (no directory,
- # no extension). This is used to create the dependencies.
- # SOURCEDIRS - a list of all directories containing sources for all
- # projects defined in a Makefile. This is used to set vpath.
- # MLLS - a list of all .mll (ocamllex input) files for all
- # projects defined in the Makefile.
- # MLYS - a list of all .mly (ocamlyacc input) files for all
- # projects defined in the Makefile.
- # ECHO - if specifically set to nothing then it will print
- # all of the commands issued. Set this in the command line
- # if you want to see what is going on.
- #
- # COMPILEFLAGS - if defined, then it is passed as argument to ocamlc
- # and ocamlopt
- # LINKFLAGS - if defined, then it is passed as argument to
- # ocamlc and ocamlopt, when linking (at start of
- # command line)
- #
- # CAML_CFLAGS - flags used only for the compilation of C files.
- # e.g. '-ccopt <gcc flag>'
- #
- #
- # After you set all of the above you must do the following for EACH separate
- # executable that you want to build.
- #
- # Define the following:
- # PROJECT_EXECUTABLE - the name of the executable you want to build. To take
- # advantage of the naming scheme that separates the
- # bytecode version and the native version, use the
- # $(EXE) variable which is defined to either .byte.exe
- # or .asm.exe. I typically put the executable in
- # $(OBJDIR) as well.
- # PROJECT_MODULES - the base names of the modules that make this
- # executable in the order in which they must be
- # passed to the linker. Make sure that all of
- # the names mentioned here are also mentioned in
- # MODULES.
- # PROJECT_CMODULES - same as modules but for the C modules. These
- # do not need to be mentioned in MODULES. There must be
- # no name clashes with MODULES
- # PROJECT_LIBS - the base names of the libraries that you
- # want to link in the executable.
- #
- #
- # Then include Makefile.ocaml.build to generate a customized
- # rule for making your executable.
- #
- # Example:
- #
- # OBJDIR = obj
- # DEPENDDIR = obj/.depend
- # SOURCEDIRS = src src/special
- # MLLS = mylex
- # MLYS = myparse
- #
- # MODULES = mod11 mod12 mod21 modcommon
- #
- # # Rules for project 1
- # PROJECT_EXECUTABLE = $(OBJDIR)/proj1$(EXE)
- # PROJECT_MODULES = mod11 mod12 modcommon
- # PROJECT_CMODULES =
- # PROJEC_LIBS = unix
- # include Makefile.ocaml.build
- #
- #
- # # Rules for project 2
- # PROJECT_EXECUTABLE = $(OBJDIR)/proj2$(EXE)
- # PROJECT_MODULES = mod21 modcommon
- # PROJECT_CMODULES =
- # PROJEC_LIBS = unix str
- # include Makefile.ocaml.build
-
-
-CAMLLEX = ocamllex
-CAMLYACC= ocamlyacc -v
-CAMLDEP = ocamldep
-
-COMPILEFLAGS += -I $(OBJDIR)
-
-# sm: two styles for echoing compilation progress:
-# style 1, by George:
-# - print English descriptions of what's happening
-# - set ECHO to "" to see *everything*
-# style 2, by Scott:
-# - do not print English descriptions
-# - print every shell command that is executed which has a side effect,
-# so that they could be pasted into a shell to reproduce manually
-# - omit some of the details of dependency generation
-#
-# to be able to choose which style, several variables are used:
-# @$(NARRATIVE) - put this before English descriptions for style 1
-# @$(COMMAND) - put this before shell commands which are to be
-# printed for style 2; the command is *not* executed
-# $(AT) - put this before shell commands which are to be executed,
-# and also printed in style 2
-# $(ECHO) - use in place of '@' for things not printed in either style
-ifdef ECHOSTYLE_SCOTT
- # 'true' silently consumes its arguments, whereas 'echo' prints them
- NARRATIVE := true
- COMMAND := echo
- AT :=
- ECHO := @
-else
- NARRATIVE := echo
- COMMAND := true
- # change these next two definitions to <empty> to echo everything,
- # or leave as @ to suppress echoing
- AT := @
- ECHO := @
-endif
-
-ifdef PREPROC
- COMPILEFLAGS += -pp "$(PREPROC)$"
- DEPFLAGS += -pp "$(PREPROC)"
-endif
-
-COMPILEMSG=
-LINKMSG=
-
-ifdef WIN32
-OBJ = obj
-else
-OBJ = o
-endif
-EXE = $(EXEEXT).exe
-
-
-export EXE
-
-ifdef NATIVECAML
- ifdef PROFILE
- COMPILEFLAGS += -p
- LINKFLAGS += -p
- COMPILEMSG += (profile)
- LINKMSG += (profile)
- endif
- ifdef ASSEMBLY
- COMPILEFLAGS += -S
- endif
- ifdef STATIC
- COMPILEFLAGS += -ccopt -static
- LINKFLAGS += -ccopt -static
- endif
- #foo := $(shell echo "I am in NATIVECAML mode" >&2; echo whatever)
- ifdef WIN32
- COMPILEFLAGS += -ccopt /Ox
- else
- COMPILEFLAGS += -ccopt -O3
- endif
- CAMLC = $(CAMLDIR)ocamlopt $(COMPILEFLAGS)
- CAMLLINK = $(CAMLDIR)ocamlopt $(LINKFLAGS)
- CMO = cmx
- CMC = opt.$(OBJ) # compiled (and optimized) C
- CMXA = cmxa
- EXEEXT = .asm
- MOVEAFTERCAMLC = cmi cmx $(OBJ)
- COMPILETOWHAT = native code
- # sm: by adding -native in native mode, we prevent spurious
- # dependencies on .cmo files which were causing lots of
- # extra recompilation
- CAMLDEP = $(CAMLDIR)ocamldep -native
-else
- CMO = cmo
- CMXA = cma
- CMC = $(OBJ)
- EXEEXT = .byte
- MOVEAFTERCAMLC = cmi cmo
- COMPILETOWHAT = bytecode
- ifdef WIN32
- COMPILEFLAGS += -ccopt /Zi -ccopt /Od
- LINKFLAGS += -ccopt /Zi -ccopt /Od
- else
- COMPILEFLAGS += -g
- LINKFLAGS += -g
- endif
- CAMLC = $(CAMLDIR)ocamlc -g $(COMPILEFLAGS)
- CAMLLINK = $(CAMLDIR)ocamlc -custom $(LINKFLAGS)
-endif
-
-
-ifdef UNSAFE
- CAMLC := $(CAMLC) -unsafe -noassert
-endif
-
-
-
-
- # Allow searching for .ml and .mli
-vpath %.mll $(SOURCEDIRS)
-vpath %.mly $(SOURCEDIRS)
-vpath %.ml $(SOURCEDIRS) $(OBJDIR)
-vpath %.mli $(SOURCEDIRS) $(OBJDIR)
-vpath %.c $(SOURCEDIRS)
-
-
-# Secondaries are intermediates that we don't want make to delete
-# By giving the right names to secondary files we tell make where to make
-# them if they are not already made. VERY USEFUL!!
-.SECONDARY : $(MLLS:%.mll=$(OBJDIR)/%.ml) $(MLYS:%.mly=$(OBJDIR)/%.ml) \
- $(MLYS:%.mly=$(OBJDIR)/%.mli)
-
- # Run the lexer generator
- # Move the result to the OBJDIR directory
- # If there is a .mli file in the same directory with .mll then
- # copy it to OBJDIR (where the .ml) file will live.
-$(OBJDIR)/%.ml: %.mll
- $(CAMLLEX) $<
- $(AT)mv -f $(basename $<).ml $(OBJDIR)/
- $(ECHO)if test -f $(basename $<).mli ;then \
- $(COMMAND) cp -f $(basename $<).mli $(OBJDIR)/; \
- cp -f $(basename $<).mli $(OBJDIR)/ \
- ;fi
-
- # Run the parser generator
- # Move the result to the $(OBJDIR) directory.
-$(OBJDIR)/%.ml $(OBJDIR)/%.mli: %.mly
- $(CAMLYACC) $(CAMLYACCFLAGS) $<
- $(AT)mv -f $(basename $<).ml $(basename $<).mli $(OBJDIR)/
-
- # Compile an MLI file. After compilation move the result to OBJDIR
-$(OBJDIR)/%.cmi: %.mli
- @$(NARRATIVE) Compiling interface $<
- $(AT)$(CAMLC) $(COMPILEFLAGS) -c $<
- $(ECHO)if test $(OBJDIR) != $(<D) ;then \
- $(COMMAND) mv -f $(basename $<).cmi $(OBJDIR)/; \
- mv -f $(basename $<).cmi $(OBJDIR)/ \
- ;fi
-
- # Compile an ML file. After compilation we
- # copy to $(OBJDIR) the .cmi and the result of compilation.
-$(OBJDIR)/%.$(CMO): %.ml
- @$(NARRATIVE) "Compiling $< to $(COMPILETOWHAT) $(COMPILEMSG)"
-# $(ECHO)#if test $(OBJDIR) != $(<D) -a -f $(OBJDIR)/$(basename $(<F)).cmi ;then \
-# $(COMMAND) mv -f $(OBJDIR)/$(basename $(<F)).cmi $(<D); \
-# mv -f $(OBJDIR)/$(basename $(<F)).cmi $(<D); \
-# fi
- @$(COMMAND) $(CAMLC) $(COMPILEFLAGS) -c $<
- $(ECHO)$(CAMLC) $(COMPILEFLAGS) -c $< ; res=$$?; \
- if test $(OBJDIR) != $(<D) ;then \
- for ext in $(MOVEAFTERCAMLC); do \
- if test -f $(basename $<).$$ext ;then \
- $(COMMAND) mv -f $(basename $<).$$ext $(OBJDIR)/; \
- mv -f $(basename $<).$$ext $(OBJDIR)/; \
- fi; \
- done; \
- fi; exit $$res
-
- # Compile C files
- # They appear to be left in the current directory as .o files
-$(OBJDIR)/%.$(CMC): %.c
- @$(NARRATIVE) "Compiling C file $< $(COMPILEMSG)"
- $(AT)$(CAMLC) $(COMPILEFLAGS) $(CAML_CFLAGS) -c $< -o $@
- $(AT)mv -f $(basename $(notdir $<)).$(OBJ) $@
-
- # Special rule for profile.c
-CAMLC_NOPROF=$(subst -p,,$(CAMLC))
-$(OBJDIR)/profile.$(CMC): profile.c
- @$(NARRATIVE) "Compiling C file $<"
- $(AT)$(CAMLC_NOPROF) $(COMPILEFLAGS) $(CAML_CFLAGS) -c $< -o $@
- $(AT)mv -f $(basename $(notdir $<)).$(OBJ) $@
-
-
-# Phonies should be "remade" even if someone mistakenly creates them
-.PHONY: cleancaml
-cleancaml:
- -rm -f $(OBJDIR)/*.cmi
- -rm -f $(OBJDIR)/*.cmo
- -rm -f $(OBJDIR)/*.cmx
- -rm -f $(OBJDIR)/*.cma
- -rm -f $(OBJDIR)/*.cmxa
- -rm -f $(OBJDIR)/*.exe
- -rm -f $(OBJDIR)/*.obj
- -rm -f $(OBJDIR)/*.o
- -rm -f $(OBJDIR)/*.obj
- -rm -f $(OBJDIR)/*.o
- -rm -f $(OBJDIR)/*.lib
- -rm -f $(OBJDIR)/*.a
- -rm -f $(OBJDIR)/*.mli
- -rm -f $(OBJDIR)/*.ml
- -rm -f $(DEPENDDIR)/*.d $(DEPENDDIR)/*.di
- -rm -f $(MLLS:%.mll=$(OBJDIR)/%.ml) \
- $(MLLS:%.mll=$(OBJDIR)/%.mli) \
- $(MLYS:%.mly=$(OBJDIR)/%.ml) \
- $(MLYS:%.mly=$(OBJDIR)/%.mli)
-
-
-# Automatic dependency generation (see GNU info for details)
-#
-# Each .ml file has a .d (dependency file) which is automatically
-# generated and included by the rules below. The perl script replaces
-# directory paths with $(OBJDIR)/
-#
-# Dependencies for .mli files reside in corresponding .di files.
-#
-
-# Replace the directories in the dependency rules with $(OBJDIR)/, since
-# we'll move .cmo/.cmx files there.
-# 1. Strip any text followed by / or \. The / case even strips slashes that
-# are preceded by whitespace, to account for unix absolute paths.
-# The \ case does not strip slashes that come immediately after whitespace,
-# to preserve the trailing \ at the end of Makefile rules.
-# 2. Replace these directory names by '$(OBJDIR)/'
-FIXDEPEND:=perl -e 'while(<>) { s%[^/\\ :]*/% %g; s%[^/\\ :]+\\% %g; s%([-a-zA-Z0-9+-.:/\/_]+)%\$$(OBJDIR)/$$1%g; print $$_;}'
-# FIXDEPEND:=cat
-
-DEPINCLUDES= -I $(OBJDIR) $(SOURCEDIRS:%=-I %)
-$(DEPENDDIR)/%.d: %.ml
- @$(NARRATIVE) Generating dependency information for $<
- @$(COMMAND) $(CAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) $<
- $(ECHO)$(CAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) $< | $(FIXDEPEND) > $@
-
-$(DEPENDDIR)/%.di: %.mli
- @$(NARRATIVE) Generating dependency information for $<
- @$(COMMAND) $(CAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) $<
- $(ECHO)$(CAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) $< | $(FIXDEPEND) > $@
-
-# sm: it turns out there's a variable which lists all the goals
-# specified on the command line; I'll use this to set CLEANING
-# (which is not set anywhere else, currently)
-ifeq ($(MAKECMDGOALS),clean)
- #$(warning "Skipping dependency rules because we're cleaning")
- CLEANING := 1
-endif
-
-ifndef CLEANING
--include $(MODULES:%=$(DEPENDDIR)/%.d)
--include $(MODULES:%=$(DEPENDDIR)/%.di)
-endif
-
-listmodules:
- @echo $(MODULES)
diff --git a/cil/ocamlutil/Makefile.ocaml.build b/cil/ocamlutil/Makefile.ocaml.build
deleted file mode 100644
index 5271e4617ffc693a095e3d86d444b1c6d1cf479f..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/Makefile.ocaml.build
+++ /dev/null
@@ -1,50 +0,0 @@
-# -*- Mode: makefile -*-
-# Copyright (c) 2001-2002,
-# George C. Necula <necula@cs.berkeley.edu>
-# Scott McPeak <smcpeak@cs.berkeley.edu>
-# Wes Weimer <weimer@cs.berkeley.edu>
-# All rights reserved.
-#
-# Redistribution and use in source and binary forms, with or without
-# modification, are permitted provided that the following conditions are
-# met:
-#
-# 1. Redistributions of source code must retain the above copyright
-# notice, this list of conditions and the following disclaimer.
-#
-# 2. Redistributions in binary form must reproduce the above copyright
-# notice, this list of conditions and the following disclaimer in the
-# documentation and/or other materials provided with the distribution.
-#
-# 3. The names of the contributors may not be used to endorse or promote
-# products derived from this software without specific prior written
-# permission.
-#
-# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
-# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
-# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
-# OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-# EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
- # Auxiliary Makefile for building Ocaml project. See the documentation in
- # the associated Makefile.ocaml for how to use this file.
- # Written by necula@cs.berkeley.edu
- #
-$(PROJECT_EXECUTABLE) : $(PROJECT_MODULES:%=$(OBJDIR)/%.$(CMO)) \
- $(PROJECT_CMODULES:%=$(OBJDIR)/%.$(CMC))
- @$(NARRATIVE) "Linking $(COMPILETOWHAT) $@ $(LINKMSG)"
- $(AT)$(CAMLLINK) -verbose -o $@ \
- $(PROJECT_LIBS:%=%.$(CMXA)) \
- $(PROJECT_LIBS:%=-cclib -l%) \
- $^
-
-
-
-
-
diff --git a/cil/ocamlutil/alpha.ml b/cil/ocamlutil/alpha.ml
deleted file mode 100755
index 6a1ea0172ad1a36b4ed3bd8e81ded0c2549676c8..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/alpha.ml
+++ /dev/null
@@ -1,156 +0,0 @@
-module H = Hashtbl
-module E = Errormsg
-open Pretty
-
-let debugAlpha (prefix: string) = false
-(*** Alpha conversion ***)
-let alphaSeparator = "___"
-let alphaSeparatorLen = String.length alphaSeparator
-
-(** For each prefix we remember the next integer suffix to use and the list
- * of suffixes, each with some data assciated with the newAlphaName that
- * created the suffix. *)
-type 'a alphaTableData = int * (string * 'a) list
-
-type 'a undoAlphaElement =
- AlphaChangedSuffix of 'a alphaTableData ref * 'a alphaTableData (* The
- * reference that was changed and
- * the old suffix *)
- | AlphaAddedSuffix of string (* We added this new entry to the
- * table *)
-
-(* Create a new name based on a given name. The new name is formed from a
- * prefix (obtained from the given name by stripping a suffix consisting of
- * the alphaSeparator followed by only digits), followed by alphaSeparator
- * and then by a positive integer suffix. The first argument is a table
- * mapping name prefixes to the largest suffix used so far for that
- * prefix. The largest suffix is one when only the version without suffix has
- * been used. *)
-let rec newAlphaName ~(alphaTable: (string, 'a alphaTableData ref) H.t)
- ~(undolist: 'a undoAlphaElement list ref option)
- ~(lookupname: string)
- ~(data: 'a) : string * 'a =
- alphaWorker ~alphaTable:alphaTable ~undolist:undolist
- ~lookupname:lookupname ~data:data true
-
-
-(** Just register the name so that we will not use in the future *)
-and registerAlphaName ~(alphaTable: (string, 'a alphaTableData ref) H.t)
- ~(undolist: 'a undoAlphaElement list ref option)
- ~(lookupname: string)
- ~(data: 'a) : unit =
- ignore (alphaWorker ~alphaTable:alphaTable ~undolist:undolist
- ~lookupname:lookupname ~data:data false)
-
-
-and alphaWorker ~(alphaTable: (string, 'a alphaTableData ref) H.t)
- ~(undolist: 'a undoAlphaElement list ref option)
- ~(lookupname: string) ~(data:'a)
- (make_new: bool) : string * 'a =
- let prefix, suffix, (numsuffix: int) = splitNameForAlpha ~lookupname in
- if debugAlpha prefix then
- ignore (E.log "Alpha worker: prefix=%s suffix=%s (%d) create=%b. "
- prefix suffix numsuffix make_new);
- let newname, (olddata: 'a) =
- try
- let rc = H.find alphaTable prefix in
- let max, suffixes = !rc in
- (* We have seen this prefix *)
- if debugAlpha prefix then
- ignore (E.log " Old max %d. Old suffixes: @[%a@]" max
- (docList
- (fun (s, l) -> dprintf "%s" (* d_loc l *) s)) suffixes);
- (* Save the undo info *)
- (match undolist with
- Some l -> l := AlphaChangedSuffix (rc, !rc) :: !l
- | _ -> ());
-
- let newmax, newsuffix, (olddata: 'a), newsuffixes =
- if numsuffix > max then begin
- (* Clearly we have not seen it *)
- numsuffix, suffix, data,
- (suffix, data) :: suffixes
- end else begin
- match List.filter (fun (n, _) -> n = suffix) suffixes with
- [] -> (* Not found *)
- max, suffix, data, (suffix, data) :: suffixes
- | [(_, l) ] ->
- (* We have seen this exact suffix before *)
- if make_new then
- let newsuffix = alphaSeparator ^ (string_of_int (max + 1)) in
- max + 1, newsuffix, l, (newsuffix, data) :: suffixes
- else
- max, suffix, data, suffixes
- | _ -> E.s (E.bug "Cil.alphaWorker")
- end
- in
- rc := (newmax, newsuffixes);
- prefix ^ newsuffix, olddata
- with Not_found -> begin (* First variable with this prefix *)
- (match undolist with
- Some l -> l := AlphaAddedSuffix prefix :: !l
- | _ -> ());
- H.add alphaTable prefix (ref (numsuffix, [ (suffix, data) ]));
- if debugAlpha prefix then ignore (E.log " First seen. ");
- lookupname, data (* Return the original name *)
- end
- in
- if debugAlpha prefix then
- ignore (E.log " Res=: %s \n" newname (* d_loc oldloc *));
- newname, olddata
-
-(* Strip the suffix. Return the prefix, the suffix (including the separator
- * and the numeric value, possibly empty), and the
- * numeric value of the suffix (possibly -1 if missing) *)
-and splitNameForAlpha ~(lookupname: string) : (string * string * int) =
- let len = String.length lookupname in
- (* Search backward for the numeric suffix. Return the first digit of the
- * suffix. Returns len if no numeric suffix *)
- let rec skipSuffix (i: int) =
- if i = -1 then -1 else
- let c = Char.code (String.get lookupname i) - Char.code '0' in
- if c >= 0 && c <= 9 then
- skipSuffix (i - 1)
- else (i + 1)
- in
- let startSuffix = skipSuffix (len - 1) in
-
- if startSuffix >= len (* No digits at all at the end *) ||
- startSuffix <= alphaSeparatorLen (* Not enough room for a prefix and
- * the separator before suffix *) ||
- (* Suffix starts with a 0 and has more characters after that *)
- (startSuffix < len - 1 && String.get lookupname startSuffix = '0') ||
- alphaSeparator <> String.sub lookupname
- (startSuffix - alphaSeparatorLen)
- alphaSeparatorLen
- then
- (lookupname, "", -1) (* No valid suffix in the name *)
- else
- (String.sub lookupname 0 (startSuffix - alphaSeparatorLen),
- String.sub lookupname (startSuffix - alphaSeparatorLen)
- (len - startSuffix + alphaSeparatorLen),
- int_of_string (String.sub lookupname startSuffix (len - startSuffix)))
-
-
-let getAlphaPrefix ~(lookupname:string) : string =
- let p, _, _ = splitNameForAlpha ~lookupname:lookupname in
- p
-
-(* Undoes the changes as specified by the undolist *)
-let undoAlphaChanges ~(alphaTable: (string, 'a alphaTableData ref) H.t)
- ~(undolist: 'a undoAlphaElement list) =
- List.iter
- (function
- AlphaChangedSuffix (where, old) ->
- where := old
- | AlphaAddedSuffix name ->
- if debugAlpha name then
- ignore (E.log "Removing %s from alpha table\n" name);
- H.remove alphaTable name)
- undolist
-
-let docAlphaTable () (alphaTable: (string, 'a alphaTableData ref) H.t) =
- let acc : (string * (int * (string * 'a) list)) list ref = ref [] in
- H.iter (fun k d -> acc := (k, !d) :: !acc) alphaTable;
- docList ~sep:line (fun (k, (d, _)) -> dprintf " %s -> %d" k d) () !acc
-
diff --git a/cil/ocamlutil/alpha.mli b/cil/ocamlutil/alpha.mli
deleted file mode 100755
index e1e430dcaf1507a9b7b03f25e91fe7417ce8feeb..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/alpha.mli
+++ /dev/null
@@ -1,50 +0,0 @@
-(** {b ALPHA conversion} *)
-
-(** This is the type of the elements that are recorded by the alpha
- * conversion functions in order to be able to undo changes to the tables
- * they modify. Useful for implementing
- * scoping *)
-type 'a undoAlphaElement
-
-(** This is the type of the elements of the alpha renaming table. These
- * elements can carry some data associated with each occurrence of the name. *)
-type 'a alphaTableData
-
-
-(** Create a new name based on a given name. The new name is formed from a
- * prefix (obtained from the given name by stripping a suffix consisting of _
- * followed by only digits), followed by a special separator and then by a
- * positive integer suffix. The first argument is a table mapping name
- * prefixes to some data that specifies what suffixes have been used and how
- * to create the new one. This function updates the table with the new
- * largest suffix generated. The "undolist" argument, when present, will be
- * used by the function to record information that can be used by
- * {!Alpha.undoAlphaChanges} to undo those changes. Note that the undo
- * information will be in reverse order in which the action occurred. Returns
- * the new name and, if different from the lookupname, the location of the
- * previous occurrence. This function knows about the location implicitly
- * from the {!Cil.currentLoc}. *)
-val newAlphaName: alphaTable:(string, 'a alphaTableData ref) Hashtbl.t ->
- undolist: 'a undoAlphaElement list ref option ->
- lookupname:string -> data:'a -> string * 'a
-
-
-(** Register a name with an alpha conversion table to ensure that when later
- * we call newAlphaName we do not end up generating this one *)
-val registerAlphaName: alphaTable:(string, 'a alphaTableData ref) Hashtbl.t ->
- undolist: 'a undoAlphaElement list ref option ->
- lookupname:string -> data:'a -> unit
-
-(** Split the name in preparation for newAlphaName. The prefix returned is
- used to index into the hashtable. The next result value is a separator
- (either empty or the separator chosen to separate the original name from
- the index) *)
-val docAlphaTable: unit ->
- (string, 'a alphaTableData ref) Hashtbl.t -> Pretty.doc
-
-
-val getAlphaPrefix: lookupname:string -> string
-
-(** Undo the changes to a table *)
-val undoAlphaChanges: alphaTable:(string, 'a alphaTableData ref) Hashtbl.t ->
- undolist:'a undoAlphaElement list -> unit
diff --git a/cil/ocamlutil/clist.ml b/cil/ocamlutil/clist.ml
deleted file mode 100644
index 80f0fd641b005def773c0b9f1f94198820ec33c7..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/clist.ml
+++ /dev/null
@@ -1,183 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-open Pretty
-
-
-(* We often need to concatenate sequences and using lists for this purpose is
- * expensive. So we define a kind of "concatenable lists" that are easier to
- * concatenate *)
-type 'a clist =
- | CList of 'a list (* This is the only representation for empty
- * *)
- | CConsL of 'a * 'a clist
- | CConsR of 'a clist * 'a
- | CSeq of 'a clist * 'a clist (* We concatenate only two of them at this
- * time. Neither is CEmpty. To be sure
- * always use append to make these *)
-
-let rec listifyOnto (tail: 'a list) = function
- CList l -> l @ tail
- | CConsL (x, l) -> x :: listifyOnto tail l
- | CConsR (l, x) -> listifyOnto (x :: tail) l
- | CSeq (l1, l2) -> listifyOnto (listifyOnto tail l2) l1
-
-let toList l = listifyOnto [] l
-let fromList l = CList l
-
-
-let single x = CList [x]
-let empty = CList []
-
-let checkBeforeAppend (l1: 'a clist) (l2: 'a clist) : bool =
- l1 != l2 || l1 = (CList [])
-
-let append l1 l2 =
- if l1 = CList [] then l2 else
- if l2 = CList [] then l1 else
- begin
- if l1 == l2 then
- raise (Failure "You should not use Clist.append to double a list");
- CSeq (l1, l2)
- end
-
-let rec length (acc: int) = function
- CList l -> acc + (List.length l)
- | CConsL (x, l) -> length (acc + 1) l
- | CConsR (l, _) -> length (acc + 1) l
- | CSeq (l1, l2) -> length (length acc l1) l2
-let length l = length 0 l (* The external version *)
-
-let map (f: 'a -> 'b) (l: 'a clist) : 'b clist =
- let rec loop = function
- CList l -> CList (List.map f l)
- | CConsL (x, l) -> let x' = f x in CConsL (x', loop l)
- | CConsR (l, x) -> let l' = loop l in CConsR (l', f x)
- | CSeq (l1, l2) -> let l1' = loop l1 in CSeq (l1', loop l2)
- in
- loop l
-
-
-let fold_left (f: 'acc -> 'a -> 'acc) (start: 'acc) (l: 'a clist) =
- let rec loop (start: 'acc) = function
- CList l -> List.fold_left f start l
- | CConsL (x, l) -> loop (f start x) l
- | CConsR (l, x) -> let res = loop start l in f res x
- | CSeq (l1, l2) ->
- let res1 = loop start l1 in
- loop res1 l2
- in
- loop start l
-
-let iter (f: 'a -> unit) (l: 'a clist) : unit =
- let rec loop = function
- CList l -> List.iter f l
- | CConsL (x, l) -> f x; loop l
- | CConsR (l, x) -> loop l; f x
- | CSeq (l1, l2) -> loop l1; loop l2
- in
- loop l
-
-
-let rec rev (revelem: 'a -> 'a) = function
- CList l ->
- let rec revonto (tail: 'a list) = function
- [] -> tail
- | x :: rest -> revonto (revelem x :: tail) rest
- in
- CList (revonto [] l)
-
- | CConsL (x, l) -> CConsR (rev revelem l, x)
- | CConsR (l, x) -> CConsL (x, rev revelem l)
- | CSeq (l1, l2) -> CSeq (rev revelem l2, rev revelem l1)
-
-
-let docCList (sep: doc) (doone: 'a -> doc) () (dl: 'a clist) =
- fold_left
- (fun (acc: doc) (elem: 'a) ->
- let elemd = doone elem in
- if acc == nil then elemd else acc ++ sep ++ elemd)
- nil
- dl
-
-
-(* let debugCheck (lst: 'a clist) : unit =*)
-(* (* use a hashtable to store values encountered *)*)
-(* let tbl : 'a bool H.t = (H.create 13) in*)
-
-(* letrec recurse (node: 'a clist) =*)
-(* (* have we seen*)*)
-
-(* match node with*)
-(* | CList*)
-
-
-(* --------------- testing ----------------- *)
-type boxedInt =
- | BI of int
- | SomethingElse
-
-let d_boxedInt () b =
- match b with
- | BI(i) -> (dprintf "%d" i)
- | SomethingElse -> (text "somethingElse")
-
-
-(* sm: some simple tests of CLists
-let testCList () : unit =
-begin
- (trace "sm" (dprintf "in testCList\n"));
-
- let clist1 = (fromList [BI(1); BI(2); BI(3)]) in
- (trace "sm" (dprintf "length of clist1 is %d\n"
- (length clist1) ));
-
- let flattened = (toList clist1) in
- (trace "sm" (dprintf "flattened: %a\n"
- (docList ~sep:(chr ',' ++ break) (d_boxedInt ()))
- flattened));
-
-
-end
-1) in
- (trace "sm" (dprintf "flattened: %a\n"
- (docList ~sep:(chr ',' ++ break) (d_boxedInt ()))
- flattened));
-
-
-end
-*)
diff --git a/cil/ocamlutil/clist.mli b/cil/ocamlutil/clist.mli
deleted file mode 100644
index c0378a60863a532c0819a32ee71199d54d6b36d4..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/clist.mli
+++ /dev/null
@@ -1,97 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(** Utilities for managing "concatenable lists" (clists). We often need to
- concatenate sequences, and using lists for this purpose is expensive. This
- module provides routines to manage such lists more efficiently. In this
- model, we never do cons or append explicitly. Instead we maintain
- the elements of the list in a special data structure. Routines are provided
- to convert to/from ordinary lists, and carry out common list operations.*)
-
-(** The clist datatype. A clist can be an ordinary list, or a clist preceded
- or followed by an element, or two clists implicitly appended together*)
-type 'a clist =
- | CList of 'a list (** The only representation for the empty
- list. Try to use sparingly. *)
- | CConsL of 'a * 'a clist (** Do not use this a lot because scanning
- * it is not tail recursive *)
- | CConsR of 'a clist * 'a
- | CSeq of 'a clist * 'a clist (** We concatenate only two of them at this
- time. Neither is the empty clist. To be
- sure always use append to make these *)
-
-
-(** Convert a clist to an ordinary list *)
-val toList: 'a clist -> 'a list
-
-(** Convert an ordinary list to a clist *)
-val fromList: 'a list -> 'a clist
-
-(** Create a clist containing one element *)
-val single: 'a -> 'a clist
-
-(** The empty clist *)
-val empty: 'a clist
-
-
-(** Append two clists *)
-val append: 'a clist -> 'a clist -> 'a clist
-
-(** A useful check to assert before an append. It checks that the two lists
- * are not identically the same (Except if they are both empty) *)
-val checkBeforeAppend: 'a clist -> 'a clist -> bool
-
-(** Find the length of a clist *)
-val length: 'a clist -> int
-
-(** Map a function over a clist. Returns another clist *)
-val map: ('a -> 'b) -> 'a clist -> 'b clist
-
-
-(** A version of fold_left that works on clists *)
-val fold_left: ('acc -> 'a -> 'acc) -> 'acc -> 'a clist -> 'acc
-
-(** A version of iter that works on clists *)
-val iter: ('a -> unit) -> 'a clist -> unit
-
-(** Reverse a clist. The first function reverses an element. *)
-val rev: ('a -> 'a) -> 'a clist -> 'a clist
-
-(** A document for printing a clist (similar to [docList]) *)
-val docCList:
- Pretty.doc -> ('a -> Pretty.doc) -> unit -> 'a clist -> Pretty.doc
-
diff --git a/cil/ocamlutil/errormsg.ml b/cil/ocamlutil/errormsg.ml
deleted file mode 100644
index 07e935d43a7a1b5fb7f648dee194467d0dd57558..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/errormsg.ml
+++ /dev/null
@@ -1,337 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-open Pretty
-
-
-
-let debugFlag = ref false (* If set then print debugging info *)
-let verboseFlag = ref false
-
-(**** Error reporting ****)
-exception Error
-let s (d : 'a) = raise Error
-
-let hadErrors = ref false
-
-let errorContext = ref []
-let pushContext f = errorContext := f :: (!errorContext)
-let popContext () =
- match !errorContext with
- _ :: t -> errorContext := t
- | [] -> s (eprintf "Bug: cannot pop error context")
-
-
-let withContext ctx f x =
- pushContext ctx;
- try
- let res = f x in
- popContext ();
- res
- with e -> begin
- popContext ();
- raise e
- end
-
- (* Make sure that showContext calls
- * each f with its appropriate
- * errorContext as it was when it was
- * pushed *)
-let showContext () =
- let rec loop = function
- [] -> ()
- | f :: rest -> (errorContext := rest; (* Just in case f raises an error *)
- ignore (eprintf " Context : %t@!" f);
- loop rest)
- in
- let old = !errorContext in
- try
- loop old;
- errorContext := old
- with e -> begin
- errorContext := old;
- raise e
- end
-
-let contextMessage (name: string) (d: doc) =
- ignore (eprintf "@!%s: %a@!" name insert d);
- showContext ()
-
-let warnFlag = ref false
-
-let logChannel : out_channel ref = ref stderr
-
-
-let bug (fmt : ('a,unit,doc,unit) format4) : 'a =
- let f d =
- hadErrors := true; contextMessage "Bug" d;
- flush !logChannel
- in
- Pretty.gprintf f fmt
-
-let error (fmt : ('a,unit,doc,unit) format4) : 'a =
- let f d = hadErrors := true; contextMessage "Error" d;
- flush !logChannel
- in
- Pretty.gprintf f fmt
-
-let unimp (fmt : ('a,unit,doc,unit) format4) : 'a =
- let f d = hadErrors := true; contextMessage "Unimplemented" d;
- flush !logChannel
- in
- Pretty.gprintf f fmt
-
-let warn (fmt : ('a,unit,doc,unit) format4) : 'a =
- let f d = contextMessage "Warning" d; flush !logChannel in
- Pretty.gprintf f fmt
-
-let warnOpt (fmt : ('a,unit,doc,unit) format4) : 'a =
- let f d =
- if !warnFlag then contextMessage "Warning" d;
- flush !logChannel in
- Pretty.gprintf f fmt
-
-
-let log (fmt : ('a,unit,doc,unit) format4) : 'a =
- let f d = fprint !logChannel 80 d; flush !logChannel in
- Pretty.gprintf f fmt
-
-let logg (fmt : ('a,unit,doc,unit) format4) : 'a =
- let f d = fprint !logChannel 10000000 d; flush !logChannel in
- Pretty.gprintf f fmt
-
-let null (fmt : ('a,unit,doc,unit) format4) : 'a =
- let f d = () in
- Pretty.gprintf f fmt
-
-
-let theLexbuf = ref (Lexing.from_string "")
-
-let fail format = Pretty.gprintf (fun x -> Pretty.fprint stderr 80 x;
- raise (Failure "")) format
-
-
-
-(***** Handling parsing errors ********)
-type parseinfo =
- { mutable linenum: int ; (* Current line *)
- mutable linestart: int ; (* The position in the buffer where the
- * current line starts *)
- mutable fileName : string ; (* Current file *)
- mutable hfile : string ; (* High-level file *)
- mutable hline : int; (* High-level line *)
- lexbuf : Lexing.lexbuf;
- inchan : in_channel option; (* None, if from a string *)
- mutable num_errors : int; (* Errors so far *)
- }
-
-let dummyinfo =
- { linenum = 1;
- linestart = 0;
- fileName = "" ;
- lexbuf = Lexing.from_string "";
- inchan = None;
- hfile = "";
- hline = 0;
- num_errors = 0;
- }
-
-let current = ref dummyinfo
-
-let setHLine (l: int) : unit =
- !current.hline <- l
-let setHFile (f: string) : unit =
- !current.hfile <- f
-
-let rem_quotes str = String.sub str 1 ((String.length str) - 2)
-
-(* Change \ into / in file names. To avoid complications with escapes *)
-let cleanFileName str =
- let str1 =
- if str <> "" && String.get str 0 = '"' (* '"' ( *)
- then rem_quotes str else str in
- let l = String.length str1 in
- let rec loop (copyto: int) (i: int) =
- if i >= l then
- String.sub str1 0 copyto
- else
- let c = String.get str1 i in
- if c <> '\\' then begin
- String.set str1 copyto c; loop (copyto + 1) (i + 1)
- end else begin
- String.set str1 copyto '/';
- if i < l - 2 && String.get str1 (i + 1) = '\\' then
- loop (copyto + 1) (i + 2)
- else
- loop (copyto + 1) (i + 1)
- end
- in
- loop 0 0
-
-let readingFromStdin = ref false
-
-let startParsing ?(useBasename=true) (fname: string) =
- (* We only support one open file at a time *)
- if !current != dummyinfo then begin
- s (error "Errormsg.startParsing supports only one open file: You want to open %s and %s is still open\n" fname !current.fileName);
- end;
- let inchan =
- try if fname = "-" then begin
- readingFromStdin := true;
- stdin
- end else begin
- readingFromStdin := false;
- open_in fname
- end
- with e -> s (error "Cannot find input file %s (exception %s"
- fname (Printexc.to_string e)) in
- let lexbuf = Lexing.from_channel inchan in
- let i =
- { linenum = 1; linestart = 0;
- fileName =
- cleanFileName (if useBasename then Filename.basename fname else fname);
- lexbuf = lexbuf; inchan = Some inchan;
- hfile = ""; hline = 0;
- num_errors = 0 } in
-
- current := i;
- lexbuf
-
-let startParsingFromString ?(file="<string>") ?(line=1) (str: string) =
- let lexbuf = Lexing.from_string str in
- let i =
- { linenum = line; linestart = line - 1;
- fileName = file;
- hfile = ""; hline = 0;
- lexbuf = lexbuf;
- inchan = None;
- num_errors = 0 }
- in
- current := i;
- lexbuf
-
-let finishParsing () =
- let i = !current in
- (match i.inchan with Some c -> close_in c | _ -> ());
- current := dummyinfo
-
-
-(* Call this function to announce a new line *)
-let newline () =
- let i = !current in
- i.linenum <- 1 + i.linenum;
- i.linestart <- Lexing.lexeme_start i.lexbuf
-
-let newHline () =
- let i = !current in
- i.hline <- 1 + i.hline
-
-let setCurrentLine (i: int) =
- !current.linenum <- i
-
-let setCurrentFile (n: string) =
- !current.fileName <- cleanFileName n
-
-
-let max_errors = 20 (* Stop after 20 errors *)
-
-let parse_error (msg: string) : 'a =
- (* Sometimes the Ocaml parser raises errors in symbol_start and symbol_end *)
- let token_start, token_end =
- try Parsing.symbol_start (), Parsing.symbol_end ()
- with e -> begin
- ignore (warn "Parsing raised %s\n" (Printexc.to_string e));
- 0, 0
- end
- in
- let i = !current in
- let adjStart =
- if token_start < i.linestart then 0 else token_start - i.linestart in
- let adjEnd =
- if token_end < i.linestart then 0 else token_end - i.linestart in
- output_string
- stderr
- (i.fileName ^ "[" ^ (string_of_int i.linenum) ^ ":"
- ^ (string_of_int adjStart) ^ "-"
- ^ (string_of_int adjEnd)
- ^ "]"
- ^ " : " ^ msg);
- output_string stderr "\n";
- flush stderr ;
- i.num_errors <- i.num_errors + 1;
- if i.num_errors > max_errors then begin
- output_string stderr "Too many errors. Aborting.\n" ;
- exit 1
- end;
- hadErrors := true;
- raise Parsing.Parse_error
-
-
-
-
-(* More parsing support functions: line, file, char count *)
-let getPosition () : int * string * int =
- let i = !current in
- i.linenum, i.fileName, Lexing.lexeme_start i.lexbuf
-
-
-let getHPosition () =
- !current.hline, !current.hfile
-
-(** Type for source-file locations *)
-type location =
- { file: string; (** The file name *)
- line: int; (** The line number *)
- hfile: string; (** The high-level file name, or "" if not present *)
- hline: int; (** The high-level line number, or 0 if not present *)
- }
-
-let d_loc () l =
- text (l.file ^ ":" ^ string_of_int l.line)
-
-let d_hloc () (l: location) =
- dprintf "%s:%d%a" l.file l.line
- insert (if l.hline > 0 then dprintf " (%s:%d)" l.hfile l.hline else nil)
-
-let locUnknown = { file = ""; hfile = ""; line = -1; hline = -1 }
-
-let getLocation () =
- let hl, hf = getHPosition () in
- let l, f, c = getPosition () in
- { hfile = hf; hline = hl;
- file = f; line = l }
-
diff --git a/cil/ocamlutil/errormsg.mli b/cil/ocamlutil/errormsg.mli
deleted file mode 100644
index 8d9c69799eb5a8aede8e6c5b12df9c72b51d47e6..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/errormsg.mli
+++ /dev/null
@@ -1,164 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-(** Utility functions for error-reporting *)
-
-(** A channel for printing log messages *)
-val logChannel : out_channel ref
-
-(** If set then print debugging info *)
-val debugFlag : bool ref
-
-val verboseFlag : bool ref
-
-
-(** Set to true if you want to see all warnings. *)
-val warnFlag: bool ref
-
-(** Error reporting functions raise this exception *)
-exception Error
-
-
- (* Error reporting. All of these functions take same arguments as a
- * Pretty.eprintf. They set the hadErrors flag, but do not raise an
- * exception. Their return type is unit.
- *)
-
-(** Prints an error message of the form [Error: ...].
- Use in conjunction with s, for example: [E.s (E.error ... )]. *)
-val error: ('a,unit,Pretty.doc,unit) format4 -> 'a
-
-(** Similar to [error] except that its output has the form [Bug: ...] *)
-val bug: ('a,unit,Pretty.doc,unit) format4 -> 'a
-
-(** Similar to [error] except that its output has the form [Unimplemented: ...] *)
-val unimp: ('a,unit,Pretty.doc,unit) format4 -> 'a
-
-(** Stop the execution by raising an Error. *)
-val s: 'a -> 'b
-
-(** This is set whenever one of the above error functions are called. It must
- be cleared manually *)
-val hadErrors: bool ref
-
-(** Like {!Errormsg.error} but does not raise the {!Errormsg.Error}
- * exception. Return type is unit. *)
-val warn: ('a,unit,Pretty.doc,unit) format4 -> 'a
-
-(** Like {!Errormsg.warn} but optional. Printed only if the
- * {!Errormsg.warnFlag} is set *)
-val warnOpt: ('a,unit,Pretty.doc,unit) format4 -> 'a
-
-(** Print something to [logChannel] *)
-val log: ('a,unit,Pretty.doc,unit) format4 -> 'a
-
-(** same as {!Errormsg.log} but do not wrap lines *)
-val logg: ('a,unit,Pretty.doc,unit) format4 -> 'a
-
- (* All of the error and warning reporting functions can also print a
- * context. To register a context printing function use "pushContext". To
- * remove the last registered one use "popContext". If one of the error
- * reporting functions is called it will invoke all currently registered
- * context reporting functions in the reverse order they were registered. *)
-
-(** Do not actually print (i.e. print to /dev/null) *)
-val null : ('a,unit,Pretty.doc,unit) format4 -> 'a
-
-(** Registers a context printing function *)
-val pushContext : (unit -> Pretty.doc) -> unit
-
-(** Removes the last registered context printing function *)
-val popContext : unit -> unit
-
-(** Show the context stack to stderr *)
-val showContext : unit -> unit
-
-(** To ensure that the context is registered and removed properly, use the
- function below *)
-val withContext : (unit -> Pretty.doc) -> ('a -> 'b) -> 'a -> 'b
-
-
-
-val newline: unit -> unit (* Call this function to announce a new line *)
-val newHline: unit -> unit
-
-val getPosition: unit -> int * string * int (* Line number, file name,
- current byte count in file *)
-val getHPosition: unit -> int * string (** high-level position *)
-
-val setHLine: int -> unit
-val setHFile: string -> unit
-
-val setCurrentLine: int -> unit
-val setCurrentFile: string -> unit
-
-(** Type for source-file locations *)
-type location =
- { file: string; (** The file name *)
- line: int; (** The line number *)
- hfile: string; (** The high-level file name, or "" if not present *)
- hline: int; (** The high-level line number, or 0 if not present *)
- }
-
-val d_loc: unit -> location -> Pretty.doc
-val d_hloc: unit -> location -> Pretty.doc
-
-val getLocation: unit -> location
-
-val parse_error: string -> (* A message *)
- 'a
-
-(** An unknown location for use when you need one but you don't have one *)
-val locUnknown: location
-
-
-(** Records whether the stdin is open for reading the goal **)
-val readingFromStdin: bool ref
-
-
-(* Call this function to start parsing. useBasename is by default "true",
- * meaning that the error information maintains only the basename. If the
- * file name is - then it reads from stdin. *)
-val startParsing: ?useBasename:bool -> string ->
- Lexing.lexbuf
-
-val startParsingFromString: ?file:string -> ?line:int -> string
- -> Lexing.lexbuf
-
-val finishParsing: unit -> unit (* Call this function to finish parsing and
- * close the input channel *)
-
-
diff --git a/cil/ocamlutil/growArray.ml b/cil/ocamlutil/growArray.ml
deleted file mode 100644
index ccadc76273a63fc6242344adb7fbc6ebf17cb9ec..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/growArray.ml
+++ /dev/null
@@ -1,191 +0,0 @@
-(** Growable Arrays *)
-
-type 'a fill =
- Elem of 'a
- | Susp of (int -> 'a)
-
-type 'a t = {
- gaFill: 'a fill;
- (** Stuff to use to fill in the array as it grows *)
-
- mutable gaMaxInitIndex: int;
- (** Maximum index that was written to. -1 if no writes have
- * been made. *)
-
- mutable gaData: 'a array;
- }
-
-let growTheArray (ga: 'a t) (len: int)
- (toidx: int) (why: string) : unit =
- if toidx >= len then begin
- (* Grow the array by 50% *)
- let newlen = toidx + 1 + len / 2 in
-(*
- ignore (E.log "growing an array to idx=%d (%s)\n" toidx why);
-*)
- let data' = begin match ga.gaFill with
- Elem x ->
- let data'' = Array.create newlen x in
- Array.blit ga.gaData 0 data'' 0 len;
- data''
- | Susp f -> Array.init newlen
- (fun i -> if i < len then ga.gaData.(i) else f i)
- end
- in
- ga.gaData <- data'
- end
-
-let max_init_index (ga: 'a t) : int =
- ga.gaMaxInitIndex
-
-let num_alloc_index (ga: 'a t) : int =
- Array.length ga.gaData
-
-let reset_max_init_index (ga: 'a t) : unit =
- ga.gaMaxInitIndex <- -1
-
-let getg (ga: 'a t) (r: int) : 'a =
- let len = Array.length ga.gaData in
- if r >= len then
- growTheArray ga len r "getg";
-
- ga.gaData.(r)
-
-let setg (ga: 'a t) (r: int) (what: 'a) : unit =
- let len = Array.length ga.gaData in
- if r >= len then
- growTheArray ga len r "setg";
- if r > max_init_index ga then ga.gaMaxInitIndex <- r;
- ga.gaData.(r) <- what
-
-let get (ga: 'a t) (r: int) : 'a = Array.get ga.gaData r
-
-let set (ga: 'a t) (r: int) (what: 'a) : unit =
- if r > max_init_index ga then ga.gaMaxInitIndex <- r;
- Array.set ga.gaData r what
-
-let make (initsz: int) (fill: 'a fill) : 'a t =
- { gaFill = fill;
- gaMaxInitIndex = -1;
- gaData = begin match fill with
- Elem x -> Array.create initsz x
- | Susp f -> Array.init initsz f
- end; }
-
-let clear (ga: 'a t) : unit =
- (* This assumes the user hasn't used the raw "set" on any value past
- max_init_index. Maybe we shouldn't trust max_init_index here?? *)
- if ga.gaMaxInitIndex >= 0 then begin
- begin match ga.gaFill with
- Elem x -> Array.fill ga.gaData 0 (ga.gaMaxInitIndex+1) x
- | Susp f ->
- for i = 0 to ga.gaMaxInitIndex do
- Array.set ga.gaData i (f i)
- done
- end;
- ga.gaMaxInitIndex <- -1
- end
-
-let copy (ga: 'a t) : 'a t =
- { ga with gaData = Array.copy ga.gaData }
-
-let deep_copy (ga: 'a t) (copy: 'a -> 'a): 'a t =
- { ga with gaData = Array.map copy ga.gaData }
-
-(* An accumulating for loop. Used internally. *)
-let fold_for ~(init: 'a) ~(lo: int) ~(hi: int) (f: int -> 'a -> 'a) =
- let rec forloop i acc =
- if i > hi then acc
- else forloop (i+1) (f i acc)
- in
- forloop lo init
-
-(** Iterate over the initialized elements of the array *)
-let iter (f: 'a -> unit) (ga: 'a t) =
- for i = 0 to max_init_index ga do
- f ga.gaData.(i)
- done
-
-(** Iterate over the initialized elements of the array *)
-let iteri (f: int -> 'a -> unit) (ga: 'a t) =
- for i = 0 to max_init_index ga do
- f i ga.gaData.(i)
- done
-
-(** Iterate over the elements of 2 arrays *)
-let iter2 (f: int -> 'a -> 'b -> unit) (ga1: 'a t) (ga2: 'b t) =
- let len1 = max_init_index ga1 in
- let len2 = max_init_index ga2 in
- if len1 > -1 || len2 > -1 then begin
- let max = if len1 > len2 then begin
- ignore(getg ga2 len1); (*grow ga2 to match ga1*)
- len1
- end else begin
- ignore(getg ga1 len2); (*grow ga1 to match ga2*)
- len2
- end in
- for i = 0 to max do
- f i ga1.gaData.(i) ga2.gaData.(i)
- done
- end
-
-(** Fold left over the initialized elements of the array *)
-let fold_left (f: 'acc -> 'a -> 'acc) (acc: 'acc) (ga: 'a t) : 'acc =
- let rec loop (acc: 'acc) (idx: int) : 'acc =
- if idx > max_init_index ga then
- acc
- else
- loop (f acc ga.gaData.(idx)) (idx + 1)
- in
- loop acc 0
-
-
-(** Fold left over the initialized elements of the array *)
-let fold_lefti (f: 'acc -> int -> 'a -> 'acc) (acc: 'acc) (ga: 'a t) : 'acc =
- let rec loop (acc: 'acc) (idx: int) : 'acc =
- if idx > max_init_index ga then
- acc
- else
- loop (f acc idx ga.gaData.(idx)) (idx + 1)
- in
- loop acc 0
-
-(** Fold right over the initialized elements of the array *)
-let fold_right (f: 'a -> 'acc -> 'acc) (ga: 'a t) (acc: 'acc) : 'acc =
- let rec loop (acc: 'acc) (idx: int) : 'acc =
- if idx < 0 then
- acc
- else
- loop (f ga.gaData.(idx) acc) (idx - 1)
- in
- loop acc (max_init_index ga)
-
-(** Document generator *)
-let d_growarray (sep: Pretty.doc)
- (doit:int -> 'a -> Pretty.doc)
- ()
- (elements: 'a t) =
- Pretty.docArray ~sep:sep doit () elements.gaData
-
-let restoreGA ?deepCopy (ga: 'a t) : (unit -> unit) =
- let old =
- (match deepCopy with
- None -> copy ga
- | Some f -> deep_copy ga f)
- in
- (fun () ->
- if ga.gaFill != old.gaFill then
- Errormsg.s
- (Errormsg.bug "restoreGA to an array with a different fill.");
- ga.gaMaxInitIndex <- old.gaMaxInitIndex;
- for i = 0 to max_init_index ga do
- set ga i (getg old i)
- done)
-
-let find (ga: 'a t) (fn: 'a -> bool) : int option =
- let rec loop (i:int) : int option =
- if i > ga.gaMaxInitIndex then None
- else if fn (get ga i) then Some i
- else loop (i + 1)
- in
- loop 0
diff --git a/cil/ocamlutil/growArray.mli b/cil/ocamlutil/growArray.mli
deleted file mode 100644
index 4cb5f48f5b75de4fd3b5d2c8a6e1ce3dc89f4916..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/growArray.mli
+++ /dev/null
@@ -1,131 +0,0 @@
-(***********************************************************************)
-(* Growable Arrays *)
-(* *)
-(* This a wrapper around the standard OCaml array, but will grow *)
-(* automatically on get or set outside the current size of the *)
-(* array. *)
-(* *)
-(* The interface is the same as the standard OCaml array where *)
-(* applicable (and implemented). *)
-(***********************************************************************)
-
-(* $Id: growArray.mli,v 1.8 2005-01-06 15:37:36 necula Exp $ *)
-
-(** Array operations. *)
-
-(** The type of growable arrays *)
-type 'a t
-
-(** The default value to a new element of the growable array *)
-type 'a fill =
- Elem of 'a
- (* A default value *)
- | Susp of (int -> 'a)
- (* A function given an index to generate a default value *)
-
-val make : int -> 'a fill -> 'a t
-(** [GrowArray.make n x] returns a fresh growable array of size
- at least [n] with default value specified by [x].
-
- Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. *)
-
-val num_alloc_index: 'a t -> int
-(** [GrowArray.num_alloc_index a] returns the number of allocated entries in
- * the array **)
-
-val max_init_index : 'a t -> int
-(** [GrowArray.max_init_index a] returns the maximum index to
- which has been written.
-
- Returns -1 if no writes have been made. *)
-
-val reset_max_init_index : 'a t -> unit
-(** [GrowArray.reset_init a] resets the max_init_index. You should probably
- use [GrowArray.clear a] instead if you also want to delete the contents. *)
-
-val getg : 'a t -> int -> 'a
-(** [GrowArray.getg a n] returns the element number [n] of array [a].
- The first element has number 0.
- The last element has number [GrowArray.length a - 1].
-
- If [n] is outside the range 0 to [(GrowArray.max_init_index a)],
- then the array grows to at least [n] and yields the default value. *)
-
-val setg : 'a t -> int -> 'a -> unit
-(** [GrowArray.setg a n x] modifies array [a] in place, replacing
- element number [n] with [x].
-
- If [n] is outside the range 0 to [(GrowArray.max_init_index a)],
- then the array grows to at least [n] and yields the default value. *)
-
-val get : 'a t -> int -> 'a
-(** [GrowArray.get a n] returns the element number [n] of grow array [a].
-
- Raise [Invalid_argument "Array.get"] if [n] is outside the range
- of the underlying array. *)
-
-val set : 'a t -> int -> 'a -> unit
-(** [GrowArray.set a n x] modifies grow array [a] in place, replacing
- element number [n] with [x].
-
- Raise [Invalid_argument "Array.set"] if [n] is outside the range
- of the underlying array. *)
-
-val clear: 'a t -> unit
-(** [GrowArray.clear a] clears the contents of the array and sets
- max_init_index to -1. Suspension thunks will be rerun to regenerate the
- initial values of the array. *)
-
-val copy : 'a t -> 'a t
-(** [GrowArray.copy a] returns a copy of [a], that is, a fresh array
- containing the same elements as [a]. *)
-
-val deep_copy : 'a t -> ('a -> 'a) -> 'a t
-(** [GrowArray.copy a f] returns a deep copy of [a] using f to
- copy elements of [a]. *)
-
-val iter : ('a -> unit) -> 'a t -> unit
-(** [GrowArray.iter f a] applies function [f] in turn to all
- the elements of [a]. It is equivalent to
- [f a.(0); f a.(1); ...; f a.(GrowArray.length a - 1); ()]. *)
-
-val iteri : (int -> 'a -> unit) -> 'a t -> unit
-(** Same as {!GrowArray.iter}, but the
- function is applied to the index of the element as first argument,
- and the element itself as second argument. *)
-
-val iter2 : (int -> 'a -> 'b -> unit) -> 'a t -> 'b t -> unit
-(** Same as {!GrowArray.iteri}, but the function is applied to two arrays.
- [iter2 f a b] is equivalent to
- [f 0 a.(0) b.(0); f 1 a.(1) b.(1); ...; f n a.(n) b.(n); ()]
- where n is the larger of (max_init_index a) or (max_init_index b).
- The shorter array will grow to match the longer.*)
-
-val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
-(** [GrowArray.fold_left f x a] computes
- [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)],
- where [n] is the length of the array [a]. *)
-
-val fold_lefti : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a
-(** [GrowArray.fold_lefti f x a] computes
- [f (... (f (f x 0 a.(0)) 1 a.(1)) ...) (n-1) a.(n-1)],
- where [n] is the length of the array [a]. *)
-
-val fold_right : ('b -> 'a -> 'a) -> 'b t -> 'a -> 'a
-(** [GrowArray.fold_right f a x] computes
- [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))],
- where [n] is the length of the array [a]. *)
-
-val d_growarray : Pretty.doc -> (int -> 'a -> Pretty.doc) -> unit -> 'a t
- -> Pretty.doc
-(** [GrowArray.d_growarray sep f () a] creates a {!Pretty.doc} for growable
- array a using separator sep and element printer f. *)
-
-
-val restoreGA: ?deepCopy:('a -> 'a) -> 'a t -> unit -> unit
-(** Given a growable array, produce a thunk that later restores it to its
- current value *)
-
-val find: 'a t -> ('a -> bool) -> int option
-(** Returns the index of the first element in the array that satisfies the
- predicate, or None if there is no such element *)
diff --git a/cil/ocamlutil/inthash.ml b/cil/ocamlutil/inthash.ml
deleted file mode 100755
index b1ad0c07c211a876f1730686f1c60ac5f4066ae4..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/inthash.ml
+++ /dev/null
@@ -1,188 +0,0 @@
-(** A hash table specialized on integer keys *)
-type 'a t =
- { mutable size: int; (* number of elements *)
- mutable data: 'a bucketlist array } (* the buckets *)
-
-and 'a bucketlist =
- Empty
- | Cons of int * 'a * 'a bucketlist
-
-let hash key = key land 0x3fffffff
-
-let create initial_size =
- let s = min (max 1 initial_size) Sys.max_array_length in
- { size = 0; data = Array.make s Empty }
-
-let clear h =
- for i = 0 to Array.length h.data - 1 do
- h.data.(i) <- Empty
- done;
- h.size <- 0
-
-let copy h =
- { size = h.size;
- data = Array.copy h.data }
-
-let copy_into src dest =
- dest.size <- src.size;
- dest.data <- Array.copy src.data
-
-let length h = h.size
-
-let resize tbl =
- let odata = tbl.data in
- let osize = Array.length odata in
- let nsize = min (2 * osize + 1) Sys.max_array_length in
- if nsize <> osize then begin
- let ndata = Array.create nsize Empty in
- let rec insert_bucket = function
- Empty -> ()
- | Cons(key, data, rest) ->
- insert_bucket rest; (* preserve original order of elements *)
- let nidx = (hash key) mod nsize in
- ndata.(nidx) <- Cons(key, data, ndata.(nidx)) in
- for i = 0 to osize - 1 do
- insert_bucket odata.(i)
- done;
- tbl.data <- ndata;
- end
-
-let add h key info =
- let i = (hash key) mod (Array.length h.data) in
- let bucket = Cons(key, info, h.data.(i)) in
- h.data.(i) <- bucket;
- h.size <- succ h.size;
- if h.size > Array.length h.data lsl 1 then resize h
-
-let remove h key =
- let rec remove_bucket = function
- Empty ->
- Empty
- | Cons(k, i, next) ->
- if k = key
- then begin h.size <- pred h.size; next end
- else Cons(k, i, remove_bucket next) in
- let i = (hash key) mod (Array.length h.data) in
- h.data.(i) <- remove_bucket h.data.(i)
-
-let remove_all h key =
- let rec remove_bucket = function
- Empty ->
- Empty
- | Cons(k, i, next) ->
- if k = key
- then begin h.size <- pred h.size;
- remove_bucket next end
- else Cons(k, i, remove_bucket next) in
- let i = (hash key) mod (Array.length h.data) in
- h.data.(i) <- remove_bucket h.data.(i)
-
-let rec find_rec key = function
- Empty ->
- raise Not_found
- | Cons(k, d, rest) ->
- if key = k then d else find_rec key rest
-
-let find h key =
- match h.data.((hash key) mod (Array.length h.data)) with
- Empty -> raise Not_found
- | Cons(k1, d1, rest1) ->
- if key = k1 then d1 else
- match rest1 with
- Empty -> raise Not_found
- | Cons(k2, d2, rest2) ->
- if key = k2 then d2 else
- match rest2 with
- Empty -> raise Not_found
- | Cons(k3, d3, rest3) ->
- if key = k3 then d3 else find_rec key rest3
-
-let find_all h key =
- let rec find_in_bucket = function
- Empty ->
- []
- | Cons(k, d, rest) ->
- if k = key then d :: find_in_bucket rest else find_in_bucket rest in
- find_in_bucket h.data.((hash key) mod (Array.length h.data))
-
-let replace h key info =
- let rec replace_bucket = function
- Empty ->
- raise Not_found
- | Cons(k, i, next) ->
- if k = key
- then Cons(k, info, next)
- else Cons(k, i, replace_bucket next) in
- let i = (hash key) mod (Array.length h.data) in
- let l = h.data.(i) in
- try
- h.data.(i) <- replace_bucket l
- with Not_found ->
- h.data.(i) <- Cons(key, info, l);
- h.size <- succ h.size;
- if h.size > Array.length h.data lsl 1 then resize h
-
-let mem h key =
- let rec mem_in_bucket = function
- | Empty ->
- false
- | Cons(k, d, rest) ->
- k = key || mem_in_bucket rest in
- mem_in_bucket h.data.((hash key) mod (Array.length h.data))
-
-let iter (f: int -> 'a -> unit) (h: 'a t) : unit =
- let rec do_bucket = function
- Empty ->
- ()
- | Cons(k, d, rest) ->
- f k d; do_bucket rest in
- let d = h.data in
- for i = 0 to Array.length d - 1 do
- do_bucket d.(i)
- done
-
-let fold (f: int -> 'a -> 'b -> 'b) (h: 'a t) (init: 'b) =
- let rec do_bucket b accu =
- match b with
- Empty ->
- accu
- | Cons(k, d, rest) ->
- do_bucket rest (f k d accu) in
- let d = h.data in
- let accu = ref init in
- for i = 0 to Array.length d - 1 do
- accu := do_bucket d.(i) !accu
- done;
- !accu
-
-
-let memoize (h: 'a t) (key: int) (f: int -> 'a) : 'a =
- let i = (hash key) mod (Array.length h.data) in
- let rec find_rec key = function
- Empty -> addit ()
- | Cons(k, d, rest) ->
- if key = k then d else find_rec key rest
- and find_in_bucket key = function
- Empty -> addit ()
- | Cons(k1, d1, rest1) ->
- if key = k1 then d1 else
- match rest1 with
- Empty -> addit ()
- | Cons(k2, d2, rest2) ->
- if key = k2 then d2 else
- match rest2 with
- Empty -> addit ()
- | Cons(k3, d3, rest3) ->
- if key = k3 then d3 else find_rec key rest3
- and addit () =
- let it = f key in
- h.data.(i) <- Cons(key, it, h.data.(i));
- h.size <- succ h.size;
- if h.size > Array.length h.data lsl 1 then resize h;
- it
- in
- find_in_bucket key h.data.(i)
-
-
-let tolist (h: 'a t) : (int * 'a) list =
- fold (fun k d acc -> (k, d) :: acc) h []
diff --git a/cil/ocamlutil/inthash.mli b/cil/ocamlutil/inthash.mli
deleted file mode 100755
index f62fcd2be818c0bf57e278c0d99fc86bb2fe8797..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/inthash.mli
+++ /dev/null
@@ -1,27 +0,0 @@
-type 'a t
-
-(* These functions behave the same as Hashtbl, but the key type is
- always int. (Specializing on int improves the performance) *)
-
-val create: int -> 'a t
-val clear: 'a t -> unit
-val length : 'a t -> int
-
-val copy: 'a t -> 'a t
-val copy_into: 'a t -> 'a t -> unit
-
-val add: 'a t -> int -> 'a -> unit
-val replace: 'a t -> int -> 'a -> unit
-val remove: 'a t -> int -> unit
-val remove_all: 'a t -> int -> unit
-
-val mem: 'a t -> int -> bool
-val find: 'a t -> int -> 'a
-val find_all: 'a t -> int -> 'a list
-
-val iter: (int -> 'a -> unit) -> 'a t -> unit
-val fold: (int -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
-
-val memoize: 'a t -> int -> (int -> 'a) -> 'a
-
-val tolist: 'a t -> (int * 'a) list
diff --git a/cil/ocamlutil/intmap.ml b/cil/ocamlutil/intmap.ml
deleted file mode 100755
index 00242bc134d6d70f6c38486d26985a2093f3c2e1..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/intmap.ml
+++ /dev/null
@@ -1,171 +0,0 @@
-(***********************************************************************)
-(* *)
-(* Objective Caml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. All rights reserved. This file is distributed *)
-(* under the terms of the GNU Library General Public License, with *)
-(* the special exception on linking described in file ../LICENSE. *)
-(* *)
-(***********************************************************************)
-
-(* $Id: intmap.ml,v 1.2 2005-10-04 21:30:25 necula Exp $ *)
-
-(* specialized to integer keys by George Necula *)
-
-type 'a t =
- Empty
- | Node of 'a t * int * 'a * 'a t * int
-
-let height = function
- Empty -> 0
- | Node(_,_,_,_,h) -> h
-
-let create l x d r =
- let hl = height l and hr = height r in
- Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
-
-let bal l x d r =
- let hl = match l with Empty -> 0 | Node(_,_,_,_,h) -> h in
- let hr = match r with Empty -> 0 | Node(_,_,_,_,h) -> h in
- if hl > hr + 2 then begin
- match l with
- Empty -> invalid_arg "Map.bal"
- | Node(ll, lv, ld, lr, _) ->
- if height ll >= height lr then
- create ll lv ld (create lr x d r)
- else begin
- match lr with
- Empty -> invalid_arg "Map.bal"
- | Node(lrl, lrv, lrd, lrr, _)->
- create (create ll lv ld lrl) lrv lrd (create lrr x d r)
- end
- end else if hr > hl + 2 then begin
- match r with
- Empty -> invalid_arg "Map.bal"
- | Node(rl, rv, rd, rr, _) ->
- if height rr >= height rl then
- create (create l x d rl) rv rd rr
- else begin
- match rl with
- Empty -> invalid_arg "Map.bal"
- | Node(rll, rlv, rld, rlr, _) ->
- create (create l x d rll) rlv rld (create rlr rv rd rr)
- end
- end else
- Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
-
-let empty = Empty
-
-let is_empty = function Empty -> true | _ -> false
-
-let rec add x data = function
- Empty ->
- Node(Empty, x, data, Empty, 1)
- | Node(l, v, d, r, h) as t ->
- if x = v then
- Node(l, x, data, r, h)
- else if x < v then
- bal (add x data l) v d r
- else
- bal l v d (add x data r)
-
-let rec find x = function
- Empty ->
- raise Not_found
- | Node(l, v, d, r, _) ->
- if x = v then d
- else find x (if x < v then l else r)
-
-let rec mem x = function
- Empty ->
- false
- | Node(l, v, d, r, _) ->
- x = v || mem x (if x < v then l else r)
-
-let rec min_binding = function
- Empty -> raise Not_found
- | Node(Empty, x, d, r, _) -> (x, d)
- | Node(l, x, d, r, _) -> min_binding l
-
-let rec remove_min_binding = function
- Empty -> invalid_arg "Map.remove_min_elt"
- | Node(Empty, x, d, r, _) -> r
- | Node(l, x, d, r, _) -> bal (remove_min_binding l) x d r
-
-let merge t1 t2 =
- match (t1, t2) with
- (Empty, t) -> t
- | (t, Empty) -> t
- | (_, _) ->
- let (x, d) = min_binding t2 in
- bal t1 x d (remove_min_binding t2)
-
-let rec remove x = function
- Empty ->
- Empty
- | Node(l, v, d, r, h) as t ->
- if x = v then
- merge l r
- else if x < v then
- bal (remove x l) v d r
- else
- bal l v d (remove x r)
-
-let rec iter f = function
- Empty -> ()
- | Node(l, v, d, r, _) ->
- iter f l; f v d; iter f r
-
-let rec map f = function
- Empty -> Empty
- | Node(l, v, d, r, h) -> Node(map f l, v, f d, map f r, h)
-
-let rec mapi f = function
- Empty -> Empty
- | Node(l, v, d, r, h) -> Node(mapi f l, v, f v d, mapi f r, h)
-
-let rec fold f m accu =
- match m with
- Empty -> accu
- | Node(l, v, d, r, _) ->
- fold f l (f v d (fold f r accu))
-
-type 'a enumeration = End | More of int * 'a * 'a t * 'a enumeration
-
-let rec cons_enum m e =
- match m with
- Empty -> e
- | Node(l, v, d, r, _) -> cons_enum l (More(v, d, r, e))
-
-let compare cmp m1 m2 =
- let rec compare_aux e1 e2 =
- match (e1, e2) with
- (End, End) -> 0
- | (End, _) -> -1
- | (_, End) -> 1
- | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
- if v1 <> v2 then if v1 < v2 then -1 else 1 else
- let c = cmp d1 d2 in
- if c <> 0 then c else
- compare_aux (cons_enum r1 e1) (cons_enum r2 e2)
-in compare_aux (cons_enum m1 End) (cons_enum m2 End)
-
-let equal cmp m1 m2 =
- let rec equal_aux e1 e2 =
- match (e1, e2) with
- (End, End) -> true
- | (End, _) -> false
- | (_, End) -> false
- | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
- v1 = v2 && cmp d1 d2 &&
- equal_aux (cons_enum r1 e1) (cons_enum r2 e2)
-in equal_aux (cons_enum m1 End) (cons_enum m2 End)
-
-(** Some definitions for ML2Coq *)
-let _ = ignore "coq:
-(* Some definitions for ML2Coq *)
-
-"
diff --git a/cil/ocamlutil/intmap.mli b/cil/ocamlutil/intmap.mli
deleted file mode 100755
index eef89b559a06d52ed93fc7e506771475d4ed9d39..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/intmap.mli
+++ /dev/null
@@ -1,87 +0,0 @@
-(***********************************************************************)
-(* *)
-(* Objective Caml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. All rights reserved. This file is distributed *)
-(* under the terms of the GNU Library General Public License, with *)
-(* the special exception on linking described in file ../LICENSE. *)
-(* *)
-(***********************************************************************)
-
-(* $Id: intmap.mli,v 1.1 2005-02-28 16:24:00 necula Exp $ *)
-
-(** Specialized to integer keys by George Necula *)
-
-(** Association tables over ordered types.
-
- This module implements applicative association tables, also known as
- finite maps or dictionaries, given a total ordering function
- over the keys.
- All operations over maps are purely applicative (no side-effects).
- The implementation uses balanced binary trees, and therefore searching
- and insertion take time logarithmic in the size of the map.
-*)
-
-type (+'a) t
- (** The type of maps from type [key] to type ['a]. *)
-
-val empty: 'a t
- (** The empty map. *)
-
-val is_empty: 'a t -> bool
- (** Test whether a map is empty or not. *)
-
-val add: int -> 'a -> 'a t -> 'a t
- (** [add x y m] returns a map containing the same bindings as
- [m], plus a binding of [x] to [y]. If [x] was already bound
- in [m], its previous binding disappears. *)
-
-val find: int -> 'a t -> 'a
- (** [find x m] returns the current binding of [x] in [m],
- or raises [Not_found] if no such binding exists. *)
-
-val remove: int -> 'a t -> 'a t
- (** [remove x m] returns a map containing the same bindings as
- [m], except for [x] which is unbound in the returned map. *)
-
-val mem: int -> 'a t -> bool
- (** [mem x m] returns [true] if [m] contains a binding for [x],
- and [false] otherwise. *)
-
-val iter: (int -> 'a -> unit) -> 'a t -> unit
- (** [iter f m] applies [f] to all bindings in map [m].
- [f] receives the key as first argument, and the associated value
- as second argument. The bindings are passed to [f] in increasing
- order with respect to the ordering over the type of the keys.
- Only current bindings are presented to [f]:
- bindings hidden by more recent bindings are not passed to [f]. *)
-
-val map: ('a -> 'b) -> 'a t -> 'b t
- (** [map f m] returns a map with same domain as [m], where the
- associated value [a] of all bindings of [m] has been
- replaced by the result of the application of [f] to [a].
- The bindings are passed to [f] in increasing order
- with respect to the ordering over the type of the keys. *)
-
-val mapi: (int -> 'a -> 'b) -> 'a t -> 'b t
- (** Same as {!Map.S.map}, but the function receives as arguments both the
- key and the associated value for each binding of the map. *)
-
-val fold: (int -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
- (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)],
- where [k1 ... kN] are the keys of all bindings in [m]
- (in increasing order), and [d1 ... dN] are the associated data. *)
-
-val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
- (** Total ordering between maps. The first argument is a total ordering
- used to compare data associated with equal keys in the two maps. *)
-
-val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
- (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are
- equal, that is, contain equal keys and associate them with
- equal data. [cmp] is the equality predicate used to compare
- the data associated with the keys. *)
-
diff --git a/cil/ocamlutil/perfcount.c.in b/cil/ocamlutil/perfcount.c.in
deleted file mode 100755
index ae532f697165c2c986436cbe56f9ac9a479b32ce..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/perfcount.c.in
+++ /dev/null
@@ -1,184 +0,0 @@
-// -*- Mode: c -*-
-//
-/*
- * A module that allows the reading of performance counters on Pentium.
- *
- * This file contains both code that uses the performance counters to
- * compute the number of cycles per second (to be used during ./configure)
- * and also code to read the performance counters from Ocaml.
- *
- * Author: George Necula (necula@cs.berkeley.edu)
- */
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-
-#if defined(__GNUC__)
- #define longlong long long
- // RDTSC puts the result in EAX and EDX. We tell gcc to use those registers
- // for "low" and "high"
- #if defined(__i386__)
- #define GETCOUNTER(low,high) \
- __asm__ volatile ("rdtsc" : "=a" (low), "=d" (high));
- #else
- #define GETCOUNTER(low,high) \
- printf ("Reading of performance counters is supported only on Intel x86\n"); \
- exit(1);
- #endif
-#else
- // Microsoft Visual Studio
- #define longlong __int64
- #define inline __inline
- #define GETCOUNTER(low,high) __asm { \
- __asm rdtsc \
- __asm mov low, eax \
- __asm mov high, edx };
-#endif
-
-/* Store here the first value read from the performance counter */
-unsigned static longlong first_value;
-
-
-/* This is the function that actually reads the performance counter. */
-inline unsigned longlong read_ppc(void) {
- unsigned long pclow, pchigh;
- unsigned longlong lowhigh;
-
- GETCOUNTER(pclow, pchigh);
-
- // printf ("Read low=0x%08lx high=0x%08lx\n", low, high);
-
- // Put the 64-bit value together
- lowhigh = ((unsigned longlong)pclow) | ((unsigned longlong)pchigh << 32);
-
- if(first_value == 0) {
- first_value = lowhigh;
- }
- return lowhigh - first_value;
-}
-
-
-/* sm: I want a version that is as fast as possible, dropping
- * bits that aren't very important to achieve it. *
- *
- * This version drops the low 20 bits and the high 14 bits so the
- * result is 30 bits (always a positive Ocaml int); this yields
- * megacycles, which for GHz machines will be something like
- * milliseconds. */
-static unsigned long sample_ppc_20(void)
-{
- unsigned long pclow, pchigh;
-
- GETCOUNTER(pclow, pchigh);
-
- return ((pclow >> 20) | (pchigh << 12)) & 0x3FFFFFFF;
-}
-
-/* This version drops the low 10 bits, yielding something like
- * microseconds. */
-inline static unsigned long sample_ppc_10()
-{
- unsigned long pclow, pchigh;
-
- GETCOUNTER(pclow,pchigh);
-
- return ((pclow >> 10) | (pchigh << 22)) & 0x3FFFFFFF;
-}
-
-
-
-#ifndef CONFIGURATION_ONLY
-/*** This is the OCAML stub for the read_ppc ***/
-#include <caml/mlvalues.h>
-#include <caml/alloc.h>
-#include <caml/memory.h>
-
-#define CYCLES_PER_USEC @CYCLES_PER_USEC@
-value read_pentium_perfcount()
-{
- double counter = (double)read_ppc() / (1000000.0 * CYCLES_PER_USEC);
- return copy_double(counter);
-}
-
-/* The Ocaml system can use this function to figure out if there are
- * performance counters available */
-value has_performance_counters() {
- // HAS_PERFCOUNT is set by the configuration code at the end of
- // this file, during ./configure
-#if @HAS_PERFCOUNT@ != 0
- return Val_true;
-#else
- return Val_false;
-#endif
-}
-
-/* sm: interface to above from Ocaml */
-value sample_pentium_perfcount_20()
-{
- return Val_long(sample_ppc_20());
-}
-
-value sample_pentium_perfcount_10()
-{
- return Val_long(sample_ppc_10());
-}
-
-#endif
-
-
-/* Now we have a function that tries to compute the number of cycles per
- * second (to be used during ./configure) */
-#ifdef CONFIGURATION_ONLY
-#include <sys/times.h>
-#include <unistd.h>
-#include <math.h>
-
-int main() {
- struct tms t;
- clock_t start, finish, diff;
- unsigned longlong start_pc, finish_pc, diff_pc;
- long clk_per_sec = sysconf(_SC_CLK_TCK);
- double cycles_per_usec;
-
- if(clk_per_sec <= 0) {
- printf("Cannot find clk_per_sec (got %ld)\n", clk_per_sec);
- exit(1);
- }
-
- times(&t); start = t.tms_utime;
- start_pc = read_ppc();
- // Do something for a while
- {
- int i;
- double a = 5.678;
- for(i=0;i<10000000;i++) {
- a = (i & 1) ? (a * a) : (sqrt(a));
- }
- }
- times(&t); finish = t.tms_utime;
- finish_pc = read_ppc();
- diff = finish - start;
- diff_pc = finish_pc - start_pc;
- if(diff == 0) {
- printf("Cannot use Unix.times\n");
- exit(1);
- }
- if(diff_pc == 0) {
- printf("Invalid result from the peformance counters\n");
- exit(1);
- }
- diff_pc /= 1000000; // We care about cycles per microsecond
-// printf("diff = %ld, diff_pc = %ld, clk = %ld\n",
-// (long)diff,
-// (long)diff_pc, (long)clk_per_sec);
-
- cycles_per_usec = (((double)diff_pc / (double)diff)
- * (double)clk_per_sec);
-
- /* Whatever value we print here will be used as the CYCLES_PER_USEC
- * below */
- printf("%.3lf\n", cycles_per_usec);
- exit(0);
-}
-#endif //defined CONFIGURATION_ONLY
-
diff --git a/cil/ocamlutil/pretty.ml b/cil/ocamlutil/pretty.ml
deleted file mode 100644
index 47d07ac409af68fd040ae92758183de4cc7ab8bb..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/pretty.ml
+++ /dev/null
@@ -1,859 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(******************************************************************************)
-(* Pretty printer
- This module contains several fast, but sub-optimal heuristics to pretty-print
- structured text.
-*)
-
-let debug = false
-
-(* Choose an algorithm *)
-type algo = George | Aman | Gap
-let algo = George
-let fastMode = ref false
-
-
-(** Whether to print identation or not (for faster printing and smaller
- * output) *)
-let printIndent = ref true
-
-(******************************************************************************)
-(* The doc type and constructors *)
-
-type doc =
- Nil
- | Text of string
- | Concat of doc * doc
- | CText of doc * string
- | Break
- | Line
- | LeftFlush
- | Align
- | Unalign
- | Mark
- | Unmark
-
-(* Break a string at \n *)
-let rec breakString (acc: doc) (str: string) : doc =
- try
- (* Printf.printf "breaking string %s\n" str; *)
- let r = String.index str '\n' in
- (* Printf.printf "r=%d\n" r; *)
- let len = String.length str in
- if r > 0 then begin
- (* Printf.printf "Taking %s\n" (String.sub str 0 r); *)
- let acc' = Concat(CText (acc, String.sub str 0 r), Line) in
- if r = len - 1 then (* The last one *)
- acc'
- else begin
- (* Printf.printf "Continuing with %s\n" (String.sub str (r + 1) (len - r - 1)); *)
- breakString acc'
- (String.sub str (r + 1) (len - r - 1))
- end
- end else (* The first is a newline *)
- breakString (Concat(acc, Line))
- (String.sub str (r + 1) (len - r - 1))
- with Not_found ->
- if acc = Nil then Text str else CText (acc, str)
-
-let nil = Nil
-let text s = breakString nil s
-let num i = text (string_of_int i)
-let real f = text (string_of_float f)
-let chr c = text (String.make 1 c)
-let align = Align
-let unalign = Unalign
-let line = Line
-let leftflush = LeftFlush
-let break = Break
-let mark = Mark
-let unmark = Unmark
-
-let d_int32 (i: int32) = text (Int32.to_string i)
-let f_int32 () i = d_int32 i
-
-let d_int64 (i: int64) = text (Int64.to_string i)
-let f_int64 () i = d_int64 i
-
-
-(* Note that the ++ operator in Ocaml are left-associative. This means
- * that if you have a long list of ++ then the whole thing is very unbalanced
- * towards the left side. This is the worst possible case since scanning the
- * left side of a Concat is the non-tail recursive case. *)
-
-let (++) d1 d2 = Concat (d1, d2)
-let concat d1 d2 = Concat (d1, d2)
-
-(* Ben Liblit fix *)
-let indent n d = text (String.make n ' ') ++ (align ++ (d ++ unalign))
-
-let markup d = mark ++ d ++ unmark
-
-(* Format a sequence. The first argument is a separator *)
-let seq ~(sep:doc) ~(doit:'a -> doc) ~(elements: 'a list) =
- let rec loop (acc: doc) = function
- [] -> acc
- | h :: t ->
- let fh = doit h in (* Make sure this is done first *)
- loop (acc ++ sep ++ fh) t
- in
- (match elements with
- [] -> nil
- | h :: t ->
- let fh = doit h in loop fh t)
-
-
-let docArray ?(sep=chr ',') (doit:int -> 'a -> doc) () (elements:'a array) =
- let len = Array.length elements in
- if len = 0 then
- nil
- else
- let rec loop (acc: doc) i =
- if i >= len then acc else
- let fi = doit i elements.(i) in (* Make sure this is done first *)
- loop (acc ++ sep ++ fi) (i + 1)
- in
- let f0 = doit 0 elements.(0) in
- loop f0 1
-
-let docOpt delem () = function
- None -> text "None"
- | Some e -> text "Some(" ++ (delem e) ++ chr ')'
-
-
-
-let docList ?(sep=chr ',') (doit:'a -> doc) () (elements:'a list) =
- seq sep doit elements
-
-let insert () d = d
-
-
-let d_list (sep:string) (doit:unit -> 'a -> doc) () (elts:'a list) : doc =
- (* thunk 'doit' to match docList's interface *)
- let internalDoit (elt:'a) =
- (doit () elt) in
- (docList ~sep:(text sep) internalDoit () elts)
-
-(** Format maps *)
-module MakeMapPrinter =
- functor (Map: sig
- type key
- type 'a t
- val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
- end) ->
-struct
- let docMap ?(sep=chr ',')
- (doit: Map.key -> 'a -> doc) () (maplets: 'a Map.t) : doc =
- Map.fold
- (fun k d acc ->
- (if acc==nil then acc else acc ++ sep)
- ++ (doit k d))
- maplets
- nil
-
- let dmaplet d0 d1 = d0 ++ (text " |-> ") ++ d1
-
- let d_map ?(dmaplet=dmaplet) (sep:string) dkey dval =
- let doit = fun k d -> dmaplet (dkey () k) (dval () d) in
- docMap ~sep:(text sep) doit
-end
-
-(** Format sets *)
-module MakeSetPrinter =
- functor (Set: sig
- type elt
- type t
- val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
- end) ->
-struct
- let docSet ?(sep=chr ',') (doit: Set.elt -> doc) () (set: Set.t) : doc =
- Set.fold
- (fun elt acc ->
- (if acc==nil then acc else acc ++ sep)
- ++ (doit elt))
- set
- nil
-
- let d_set (sep:string) delt =
- docSet ~sep:(text sep) (delt ())
-end
-
-
-(******************************************************************************)
-(* Some debugging stuff *)
-
-let dbgprintf x = Printf.fprintf stderr x
-
-let rec dbgPrintDoc = function
- Nil -> dbgprintf "(Nil)"
- | Text s -> dbgprintf "(Text %s)" s
- | Concat (d1,d2) -> dbgprintf ""; dbgPrintDoc d1; dbgprintf " ++\n ";
- dbgPrintDoc d2; dbgprintf ""
- | CText (d,s) -> dbgPrintDoc d; dbgprintf " ++ \"%s\"" s;
- | Break -> dbgprintf "(Break)"
- | Line -> dbgprintf "(Line)"
- | LeftFlush -> dbgprintf "(LeftFlush)"
- | Align -> dbgprintf "(Align)"
- | Unalign -> dbgprintf "(Unalign)"
- | Mark -> dbgprintf "(Mark)"
- | Unmark -> dbgprintf "(Unmark)"
-
-(******************************************************************************)
-(* The "george" algorithm *)
-
-(* When we construct documents, most of the time they are heavily unbalanced
- * towards the left. This is due to the left-associativity of ++ and also to
- * the fact that constructors such as docList construct from the let of a
- * sequence. We would prefer to shift the imbalance to the right to avoid
- * consuming a lot of stack when we traverse the document *)
-let rec flatten (acc: doc) = function
- | Concat (d1, d2) -> flatten (flatten acc d2) d1
- | CText (d, s) -> flatten (Concat(Text s, acc)) d
- | Nil -> acc (* Get rid of Nil *)
- | d -> Concat(d, acc)
-
-(* We keep a stack of active aligns. *)
-type align =
- { mutable gainBreak: int; (* This is the gain that is associated with
- * taking the break associated with this
- * alignment mark. If this is 0, then there
- * is no break associated with the mark *)
- mutable isTaken: bool ref; (* If breakGain is > 0 then this is a ref
- * cell that must be set to true when the
- * break is taken. These ref cells are also
- * int the "breaks" list *)
- deltaFromPrev: int ref; (* The column of this alignment mark -
- * the column of the previous mark.
- * Shared with the deltaToNext of the
- * previous active align *)
- deltaToNext: int ref (* The column of the next alignment mark -
- * the columns of this one. Shared with
- * deltaFromPrev of the next active align *)
- }
-
-(* We use references to avoid the need to pass data around all the time *)
-let aligns: align list ref = (* The current stack of active alignment marks,
- * with the top at the head. Never empty. *)
- ref [{ gainBreak = 0; isTaken = ref false;
- deltaFromPrev = ref 0; deltaToNext = ref 0; }]
-
-let topAlignAbsCol = ref 0 (* The absolute column of the top alignment *)
-
-let pushAlign (abscol: int) =
- let topalign = List.hd !aligns in
- let res =
- { gainBreak = 0; isTaken = ref false;
- deltaFromPrev = topalign.deltaToNext; (* Share with the previous *)
- deltaToNext = ref 0; (* Allocate a new ref *)} in
- aligns := res :: !aligns;
- res.deltaFromPrev := abscol - !topAlignAbsCol;
- topAlignAbsCol := abscol
-
-let popAlign () =
- match !aligns with
- top :: t when t != [] ->
- aligns := t;
- topAlignAbsCol := !topAlignAbsCol - !(top.deltaFromPrev)
- | _ -> failwith "Unmatched unalign\n"
-
-(** We keep a list of active markup sections. For each one we keep the column
- * we are in *)
-let activeMarkups: int list ref = ref []
-
-
-(* Keep a list of ref cells for the breaks, in the same order that we see
- * them in the document *)
-let breaks: bool ref list ref = ref []
-
-(* The maximum column that we should use *)
-let maxCol = ref 0
-
-(* Sometimes we take all the optional breaks *)
-let breakAllMode = ref false
-
-(* We are taking a newline and moving left *)
-let newline () =
- let topalign = List.hd !aligns in (* aligns is never empty *)
- if debug then
- dbgprintf "Taking a newline: reseting gain of %d\n" topalign.gainBreak;
- topalign.gainBreak <- 0; (* Erase the current break info *)
- if !breakAllMode && !topAlignAbsCol < !maxCol then
- breakAllMode := false;
- !topAlignAbsCol (* This is the new column *)
-
-
-
-(* Choose the align with the best gain. We outght to find a better way to
- * keep the aligns sorted, especially since they gain never changes (when the
- * align is the top align) *)
-let chooseBestGain () : align option =
- let bestGain = ref 0 in
- let rec loop (breakingAlign: align option) = function
- [] -> breakingAlign
- | a :: resta ->
- if debug then dbgprintf "Looking at align with gain %d\n" a.gainBreak;
- if a.gainBreak > !bestGain then begin
- bestGain := a.gainBreak;
- loop (Some a) resta
- end else
- loop breakingAlign resta
- in
- loop None !aligns
-
-
-(* Another one that chooses the break associated with the current align only *)
-let chooseLastGain () : align option =
- let topalign = List.hd !aligns in
- if topalign.gainBreak > 0 then Some topalign else None
-
-(* We have just advanced to a new column. See if we must take a line break *)
-let movingRight (abscol: int) : int =
- (* Keep taking the best break until we get back to the left of maxCol or no
- * more are left *)
- let rec tryAgain abscol =
- if abscol <= !maxCol then abscol else
- begin
- if debug then
- dbgprintf "Looking for a break to take in column %d\n" abscol;
- (* Find the best gain there is out there *)
- match if !fastMode then None else chooseBestGain () with
- None -> begin
- (* No breaks are available. Take all breaks from now on *)
- breakAllMode := true;
- if debug then
- dbgprintf "Can't find any breaks\n";
- abscol
- end
- | Some breakingAlign -> begin
- let topalign = List.hd !aligns in
- let theGain = breakingAlign.gainBreak in
- assert (theGain > 0);
- if debug then dbgprintf "Taking break at %d. gain=%d\n" abscol theGain;
- breakingAlign.isTaken := true;
- breakingAlign.gainBreak <- 0;
- if breakingAlign != topalign then begin
- breakingAlign.deltaToNext :=
- !(breakingAlign.deltaToNext) - theGain;
- topAlignAbsCol := !topAlignAbsCol - theGain
- end;
- tryAgain (abscol - theGain)
- end
- end
- in
- tryAgain abscol
-
-
-(* Keep track of nested align in gprintf. Each gprintf format string must
- * have properly nested align/unalign pairs. When the nesting depth surpasses
- * !printDepth then we print ... and we skip until the matching unalign *)
-let printDepth = ref 10000000 (* WRW: must see whole thing *)
-let alignDepth = ref 0
-
-let useAlignDepth = true
-
-(** Start an align. Return true if we ahve just passed the threshhold *)
-let enterAlign () =
- incr alignDepth;
- useAlignDepth && !alignDepth = !printDepth + 1
-
-(** Exit an align *)
-let exitAlign () =
- decr alignDepth
-
-(** See if we are at a low-enough align level (and we should be printing
- * normally) *)
-let shallowAlign () =
- not useAlignDepth || !alignDepth <= !printDepth
-
-
-(* Pass the current absolute column and compute the new column *)
-let rec scan (abscol: int) (d: doc) : int =
- match d with
- Nil -> abscol
- | Concat (d1, d2) -> scan (scan abscol d1) d2
- | Text s when shallowAlign () ->
- let sl = String.length s in
- if debug then
- dbgprintf "Done string: %s from %d to %d\n" s abscol (abscol + sl);
- movingRight (abscol + sl)
- | CText (d, s) ->
- let abscol' = scan abscol d in
- if shallowAlign () then begin
- let sl = String.length s in
- if debug then
- dbgprintf "Done string: %s from %d to %d\n" s abscol' (abscol' + sl);
- movingRight (abscol' + sl)
- end else
- abscol'
-
- | Align ->
- pushAlign abscol;
- if enterAlign () then
- movingRight (abscol + 3) (* "..." *)
- else
- abscol
-
- | Unalign -> exitAlign (); popAlign (); abscol
-
- | Line when shallowAlign () -> (* A forced line break *)
- if !activeMarkups != [] then
- failwith "Line breaks inside markup sections";
- newline ()
-
- | LeftFlush when shallowAlign () -> (* Keep cursor left-flushed *) 0
-
- | Break when shallowAlign () -> (* An optional line break. Always a space
- * followed by an optional line break *)
- if !activeMarkups != [] then
- failwith "Line breaks inside markup sections";
- let takenref = ref false in
- breaks := takenref :: !breaks;
- let topalign = List.hd !aligns in (* aligns is never empty *)
- if !breakAllMode then begin
- takenref := true;
- newline ()
- end else begin
- (* If there was a previous break there it stays not taken, forever.
- * So we overwrite it. *)
- topalign.isTaken <- takenref;
- topalign.gainBreak <- 1 + abscol - !topAlignAbsCol;
- if debug then
- dbgprintf "Registering a break at %d with gain %d\n"
- (1 + abscol) topalign.gainBreak;
- movingRight (1 + abscol)
- end
-
- | Mark -> activeMarkups := abscol :: !activeMarkups;
- abscol
-
- | Unmark -> begin
- match !activeMarkups with
- old :: rest -> activeMarkups := rest;
- old
- | [] -> failwith "Too many unmark"
- end
-
- | _ -> (* Align level is too deep *) abscol
-
-
-(** Keep a running counter of the newlines we are taking. You can read and
- * reset this from user code, if you want *)
-let countNewLines = ref 0
-
-(* The actual function that takes a document and prints it *)
-let emitDoc
- (emitString: string -> int -> unit) (* emit a number of copies of a
- * string *)
- (d: doc) =
- let aligns: int list ref = ref [0] in (* A stack of alignment columns *)
-
- let wantIndent = ref false in
- (* Use this function to take a newline *)
- (* AB: modified it to flag wantIndent. The actual indentation is done only
- if leftflush is not encountered *)
- let newline () =
- match !aligns with
- [] -> failwith "Ran out of aligns"
- | x :: _ ->
- emitString "\n" 1;
- incr countNewLines;
- wantIndent := true;
- x
- in
- (* Print indentation if wantIndent was previously flagged ; reset this flag *)
- let indentIfNeeded () =
- if !printIndent && !wantIndent then ignore (
- match !aligns with
- [] -> failwith "Ran out of aligns"
- | x :: _ ->
- if x > 0 then emitString " " x;
- x);
- wantIndent := false
- in
- (* A continuation passing style loop *)
- let rec loopCont (abscol: int) (d: doc) (cont: int -> unit) : unit
- (* the new column *) =
- match d with
- Nil -> cont abscol
- | Concat (d1, d2) ->
- loopCont abscol d1 (fun abscol' -> loopCont abscol' d2 cont)
-
- | Text s when shallowAlign () ->
- let sl = String.length s in
- indentIfNeeded ();
- emitString s 1;
- cont (abscol + sl)
-
- | CText (d, s) ->
- loopCont abscol d
- (fun abscol' ->
- if shallowAlign () then
- let sl = String.length s in
- indentIfNeeded ();
- emitString s 1;
- cont (abscol' + sl)
- else
- cont abscol')
-
- | Align ->
- aligns := abscol :: !aligns;
- if enterAlign () then begin
- indentIfNeeded ();
- emitString "..." 1;
- cont (abscol + 3)
- end else
- cont abscol
-
- | Unalign -> begin
- match !aligns with
- [] -> failwith "Unmatched unalign"
- | _ :: rest ->
- exitAlign ();
- aligns := rest; cont abscol
- end
- | Line when shallowAlign () -> cont (newline ())
- | LeftFlush when shallowAlign () -> wantIndent := false; cont (0)
- | Break when shallowAlign () -> begin
- match !breaks with
- [] -> failwith "Break without a takenref"
- | istaken :: rest ->
- breaks := rest; (* Consume the break *)
- if !istaken then cont (newline ())
- else begin
- indentIfNeeded ();
- emitString " " 1;
- cont (abscol + 1)
- end
- end
-
- | Mark ->
- activeMarkups := abscol :: !activeMarkups;
- cont abscol
-
- | Unmark -> begin
- match !activeMarkups with
- old :: rest -> activeMarkups := rest;
- cont old
- | [] -> failwith "Unmark without a mark"
- end
-
- | _ -> (* Align is too deep *)
- cont abscol
- in
-
- loopCont 0 d (fun x -> ())
-
-
-(* Print a document on a channel *)
-let fprint (chn: out_channel) ~(width: int) doc =
- (* Save some parameters, to allow for nested calls of these routines. *)
- maxCol := width;
- let old_breaks = !breaks in
- breaks := [];
- let old_alignDepth = !alignDepth in
- alignDepth := 0;
- let old_activeMarkups = !activeMarkups in
- activeMarkups := [];
- ignore (scan 0 doc);
- breaks := List.rev !breaks;
- ignore (emitDoc
- (fun s nrcopies ->
- for i = 1 to nrcopies do
- output_string chn s
- done) doc);
- activeMarkups := old_activeMarkups;
- alignDepth := old_alignDepth;
- breaks := old_breaks (* We must do this especially if we don't do emit
- * (which consumes breaks) because otherwise we waste
- * memory *)
-
-(* Print the document to a string *)
-let sprint ~(width : int) doc : string =
- maxCol := width;
- let old_breaks = !breaks in
- breaks := [];
- let old_activeMarkups = !activeMarkups in
- activeMarkups := [];
- let old_alignDepth = !alignDepth in
- alignDepth := 0;
- ignore (scan 0 doc);
- breaks := List.rev !breaks;
- let buf = Buffer.create 1024 in
- let rec add_n_strings str num =
- if num <= 0 then ()
- else begin Buffer.add_string buf str; add_n_strings str (num - 1) end
- in
- emitDoc add_n_strings doc;
- breaks := old_breaks;
- activeMarkups := old_activeMarkups;
- alignDepth := old_alignDepth;
- Buffer.contents buf
-
-
- (* The rest is based on printf.ml *)
-external format_int: string -> int -> string = "caml_format_int"
-external format_float: string -> float -> string = "caml_format_float"
-
-
-
-let gprintf (finish : doc -> 'b)
- (format : ('a, unit, doc, 'b) format4) : 'a =
- let format = (Obj.magic format : string) in
-
- (* Record the starting align depth *)
- let startAlignDepth = !alignDepth in
- (* Special concatenation functions *)
- let dconcat (acc: doc) (another: doc) =
- if !alignDepth > !printDepth then acc else acc ++ another in
- let dctext1 (acc: doc) (str: string) =
- if !alignDepth > !printDepth then acc else
- CText(acc, str)
- in
- (* Special finish function *)
- let dfinish (dc: doc) : 'b =
- if !alignDepth <> startAlignDepth then
- prerr_string ("Unmatched align/unalign in " ^ format ^ "\n");
- finish dc
- in
- let flen = String.length format in
- (* Reading a format character *)
- let fget = String.unsafe_get format in
- (* Output a literal sequence of
- * characters, starting at i. The
- * character at i does not need to be
- * checked. *)
- let rec literal acc i =
- let rec skipChars j =
- if j >= flen ||
- (match fget j with
- '%' -> true
- | '@' -> true
- | '\n' -> true
- | _ -> false) then
- collect (dctext1 acc (String.sub format i (j-i))) j
- else
- skipChars (succ j)
- in
- skipChars (succ i)
- (* the main collection function *)
- and collect (acc: doc) (i: int) =
- if i >= flen then begin
- Obj.magic (dfinish acc)
- end else begin
- let c = fget i in
- if c = '%' then begin
- let j = skip_args (succ i) in
- match fget j with
- '%' -> literal acc j
- | 's' ->
- Obj.magic(fun s ->
- let str =
- if j <= i+1 then
- s
- else
- let sl = String.length s in
- let p =
- try
- int_of_string (String.sub format (i+1) (j-i-1))
- with _ ->
- invalid_arg "fprintf: bad %s format" in
- if p > 0 && sl < p then
- (String.make (p - sl) ' ') ^ s
- else if p < 0 && sl < -p then
- s ^ (String.make (-p - sl) ' ')
- else
- s
- in
- collect (breakString acc str) (succ j))
- | 'c' ->
- Obj.magic(fun c ->
- collect (dctext1 acc (String.make 1 c)) (succ j))
- | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
- Obj.magic(fun n ->
- collect (dctext1 acc
- (format_int (String.sub format i
- (j-i+1)) n))
- (succ j))
- (* L, l, and n are the Int64, Int32, and Nativeint modifiers to the integer
- formats d,i,o,x,X,u. For example, %Lo means print an Int64 in octal.*)
- | 'L' ->
- if j != i + 1 then (*Int64.format handles simple formats like %d.
- * Any special flags eaten by skip_args will confuse it. *)
- invalid_arg ("dprintf: unimplemented format "
- ^ (String.sub format i (j-i+1)));
- let j' = succ j in (* eat the d,i,x etc. *)
- let format_spec = "% " in
- String.set format_spec 1 (fget j'); (* format_spec = "%x", etc. *)
- Obj.magic(fun n ->
- collect (dctext1 acc
- (Int64.format format_spec n))
- (succ j'))
- | 'l' ->
- if j != i + 1 then invalid_arg ("dprintf: unimplemented format "
- ^ (String.sub format i (j-i+1)));
- let j' = succ j in (* eat the d,i,x etc. *)
- let format_spec = "% " in
- String.set format_spec 1 (fget j'); (* format_spec = "%x", etc. *)
- Obj.magic(fun n ->
- collect (dctext1 acc
- (Int32.format format_spec n))
- (succ j'))
- | 'n' ->
- if j != i + 1 then invalid_arg ("dprintf: unimplemented format "
- ^ (String.sub format i (j-i+1)));
- let j' = succ j in (* eat the d,i,x etc. *)
- let format_spec = "% " in
- String.set format_spec 1 (fget j'); (* format_spec = "%x", etc. *)
- Obj.magic(fun n ->
- collect (dctext1 acc
- (Nativeint.format format_spec n))
- (succ j'))
- | 'f' | 'e' | 'E' | 'g' | 'G' ->
- Obj.magic(fun f ->
- collect (dctext1 acc
- (format_float (String.sub format i (j-i+1)) f))
- (succ j))
- | 'b' | 'B' ->
- Obj.magic(fun b ->
- collect (dctext1 acc (string_of_bool b)) (succ j))
- | 'a' ->
- Obj.magic(fun pprinter arg ->
- collect (dconcat acc (pprinter () arg)) (succ j))
- | 't' ->
- Obj.magic(fun pprinter ->
- collect (dconcat acc (pprinter ())) (succ j))
- | c ->
- invalid_arg ("dprintf: unknown format %s" ^ String.make 1 c)
-
- end else if c = '@' then begin
- if i + 1 < flen then begin
- match fget (succ i) with
-
- (* Now the special format characters *)
- '[' -> (* align *)
- let newacc =
- if !alignDepth > !printDepth then
- acc
- else if !alignDepth = !printDepth then
- CText(acc, "...")
- else
- acc ++ align
- in
- incr alignDepth;
- collect newacc (i + 2)
-
- | ']' -> (* unalign *)
- decr alignDepth;
- let newacc =
- if !alignDepth >= !printDepth then
- acc
- else
- acc ++ unalign
- in
- collect newacc (i + 2)
- | '!' -> (* hard-line break *)
- collect (dconcat acc line) (i + 2)
- | '?' -> (* soft line break *)
- collect (dconcat acc (break)) (i + 2)
- | '<' ->
- collect (dconcat acc mark) (i +1)
- | '>' ->
- collect (dconcat acc unmark) (i +1)
- | '^' -> (* left-flushed *)
- collect (dconcat acc (leftflush)) (i + 2)
- | '@' ->
- collect (dctext1 acc "@") (i + 2)
- | c ->
- invalid_arg ("dprintf: unknown format @" ^ String.make 1 c)
- end else
- invalid_arg "dprintf: incomplete format @"
- end else if c = '\n' then begin
- collect (dconcat acc line) (i + 1)
- end else
- literal acc i
- end
-
- and skip_args j =
- match String.unsafe_get format j with
- '0' .. '9' | ' ' | '.' | '-' -> skip_args (succ j)
- | c -> j
-
- in
- collect Nil 0
-
-let withPrintDepth dp thunk =
- let opd = !printDepth in
- printDepth := dp;
- thunk ();
- printDepth := opd
-
-
-
-let flushOften = ref false
-
-let dprintf format = gprintf (fun x -> x) format
-let fprintf chn format =
- let f d = fprint chn 80 d; d in
- (* weimeric hack begins -- flush output to streams *)
- let res = gprintf f format in
- (* save the value we would have returned, flush the channel and then
- * return it -- this allows us to see debug input near infinite loops
- * *)
- if !flushOften then flush chn;
- res
- (* weimeric hack ends *)
-
-let printf format = fprintf stdout format
-let eprintf format = fprintf stderr format
-
-
-
-(******************************************************************************)
-let getAlgoName = function
- George -> "George"
- | Aman -> "Aman"
- | Gap -> "Gap"
-
-let getAboutString () : string =
- "(Pretty: ALGO=" ^ (getAlgoName algo) ^ ")"
-
-
-(************************************************)
-let auto_printer (typ: string) =
- failwith ("Pretty.auto_printer \"" ^ typ ^ "\" only works with you use -pp \"camlp4o pa_prtype.cmo\" when you compile")
diff --git a/cil/ocamlutil/pretty.mli b/cil/ocamlutil/pretty.mli
deleted file mode 100644
index 5422432d1ebfb6e33ed6b39bd38cf7fb54dc74eb..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/pretty.mli
+++ /dev/null
@@ -1,316 +0,0 @@
-(*
- *
- * Copyright (c) 2001 by
- * George C. Necula necula@cs.berkeley.edu
- * Scott McPeak smcpeak@cs.berkeley.edu
- * Wes Weimer weimer@cs.berkeley.edu
- *
- * All rights reserved. Permission to use, copy, modify and distribute
- * this software for research purposes only is hereby granted,
- * provided that the following conditions are met:
- * 1. Redistributions of source code must retain the above copyright notice,
- * this list of conditions and the following disclaimer.
- * 2. Redistributions in binary form must reproduce the above copyright notice,
- * this list of conditions and the following disclaimer in the documentation
- * and/or other materials provided with the distribution.
- * 3. The name of the authors may not be used to endorse or promote products
- * derived from this software without specific prior written permission.
- *
- * DISCLAIMER:
- * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
- * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
- * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
- * IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
- * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
- * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
- * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
- * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
- * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
- * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(** Utility functions for pretty-printing. The major features provided by
- this module are
-- An [fprintf]-style interface with support for user-defined printers
-- The printout is fit to a width by selecting some of the optional newlines
-- Constructs for alignment and indentation
-- Print ellipsis starting at a certain nesting depth
-- Constructs for printing lists and arrays
-
- Pretty-printing occurs in two stages:
-- Construct a {!Pretty.doc} object that encodes all of the elements to be
- printed
- along with alignment specifiers and optional and mandatory newlines
-- Format the {!Pretty.doc} to a certain width and emit it as a string, to an
- output stream or pass it to a user-defined function
-
- The formatting algorithm is not optimal but it does a pretty good job while
- still operating in linear time. The original version was based on a pretty
- printer by Philip Wadler which turned out to not scale to large jobs.
-*)
-
-(** API *)
-
-(** The type of unformated documents. Elements of this type can be
- * constructed in two ways. Either with a number of constructor shown below,
- * or using the {!Pretty.dprintf} function with a [printf]-like interface.
- * The {!Pretty.dprintf} method is slightly slower so we do not use it for
- * large jobs such as the output routines for a compiler. But we use it for
- * small jobs such as logging and error messages. *)
-type doc
-
-
-
-(** Constructors for the doc type. *)
-
-
-
-
-(** Constructs an empty document *)
-val nil : doc
-
-
-(** Concatenates two documents. This is an infix operator that associates to
- the left. *)
-val (++) : doc -> doc -> doc
-val concat : doc -> doc -> doc
-
-(** A document that prints the given string *)
-val text : string -> doc
-
-
-(** A document that prints an integer in decimal form *)
-val num : int -> doc
-
-
-(** A document that prints a real number *)
-val real : float -> doc
-
-(** A document that prints a character. This is just like {!Pretty.text}
- with a one-character string. *)
-val chr : char -> doc
-
-
-(** A document that consists of a mandatory newline. This is just like [(text
- "\n")]. The new line will be indented to the current indentation level,
- unless you use {!Pretty.leftflush} right after this. *)
-val line : doc
-
-(** Use after a {!Pretty.line} to prevent the indentation. Whatever follows
- * next will be flushed left. Indentation resumes on the next line. *)
-val leftflush : doc
-
-
-(** A document that consists of either a space or a line break. Also called
- an optional line break. Such a break will be
- taken only if necessary to fit the document in a given width. If the break
- is not taken a space is printed instead. *)
-val break: doc
-
-(** Mark the current column as the current indentation level. Does not print
- anything. All taken line breaks will align to this column. The previous
- alignment level is saved on a stack. *)
-val align: doc
-
-(** Reverts to the last saved indentation level. *)
-val unalign: doc
-
-
-(** Mark the beginning of a markup section. The width of a markup section is
- * considered 0 for the purpose of computing identation *)
-val mark: doc
-
-(** The end of a markup section *)
-val unmark: doc
-
-(************* Now some syntactic sugar *****************)
-(** Syntactic sugar *)
-
-(** Indents the document. Same as [((text " ") ++ align ++ doc ++ unalign)],
- with the specified number of spaces. *)
-val indent: int -> doc -> doc
-
-(** Prints a document as markup. The marked document cannot contain line
- * breaks or alignment constructs. *)
-val markup: doc -> doc
-
-(** Formats a sequence. [sep] is a separator, [doit] is a function that
- * converts an element to a document. *)
-val seq: sep:doc -> doit:('a ->doc) -> elements:'a list -> doc
-
-
-(** An alternative function for printing a list. The [unit] argument is there
- * to make this function more easily usable with the {!Pretty.dprintf}
- * interface. The first argument is a separator, by default a comma. *)
-val docList: ?sep:doc -> ('a -> doc) -> unit -> 'a list -> doc
-
-(** sm: Yet another list printer. This one accepts the same kind of
- * printing function that {!Pretty.dprintf} does, and itself works
- * in the dprintf context. Also accepts
- * a string as the separator since that's by far the most common. *)
-val d_list: string -> (unit -> 'a -> doc) -> unit -> 'a list -> doc
-
-(** Formats an array. A separator and a function that prints an array
- element. The default separator is a comma. *)
-val docArray: ?sep:doc -> (int -> 'a -> doc) -> unit -> 'a array -> doc
-
-(** Prints an ['a option] with [None] or [Some] *)
-val docOpt: ('a -> doc) -> unit -> 'a option -> doc
-
-
-(** Print an int32 *)
-val d_int32: int32 -> doc
-val f_int32: unit -> int32 -> doc
-
-val d_int64: int64 -> doc
-val f_int64: unit -> int64 -> doc
-
-(** Format maps. *)
-module MakeMapPrinter :
- functor (Map: sig
- type key
- type 'a t
- val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
- end) ->
-sig
- (** Format a map, analogous to docList. *)
- val docMap: ?sep:doc -> (Map.key -> 'a -> doc) -> unit -> 'a Map.t -> doc
-
- (** Format a map, analogous to d_list. *)
- val d_map: ?dmaplet:(doc -> doc -> doc)
- -> string
- -> (unit -> Map.key -> doc)
- -> (unit -> 'a -> doc)
- -> unit
- -> 'a Map.t
- -> doc
- end
-
-(** Format sets. *)
-module MakeSetPrinter :
- functor (Set: sig
- type elt
- type t
- val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
- end) ->
-sig
- (** Format a set, analogous to docList. *)
- val docSet: ?sep:doc -> (Set.elt -> doc) -> unit -> Set.t -> doc
-
- (** Format a set, analogous to d_list. *)
- val d_set: string
- -> (unit -> Set.elt -> doc)
- -> unit
- -> Set.t
- -> doc
-end
-
-(** A function that is useful with the [printf]-like interface *)
-val insert: unit -> doc -> doc
-
-val dprintf: ('a, unit, doc, doc) format4 -> 'a
-(** This function provides an alternative method for constructing
- [doc] objects. The first argument for this function is a format string
- argument (of type [('a, unit, doc) format]; if you insist on
- understanding what that means see the module [Printf]). The format string
- is like that for the [printf] function in C, except that it understands a
- few more formatting controls, all starting with the @ character.
-
- See the gprintf function if you want to pipe the result of dprintf into
- some other functions.
-
- The following special formatting characters are understood (these do not
- correspond to arguments of the function):
-- @\[ Inserts an {!Pretty.align}. Every format string must have matching
- {!Pretty.align} and {!Pretty.unalign}.
-- @\] Inserts an {!Pretty.unalign}.
-- @! Inserts a {!Pretty.line}. Just like "\n"
-- @? Inserts a {!Pretty.break}.
-- @< Inserts a {!Pretty.mark}.
-- @> Inserts a {!Pretty.unmark}.
-- @^ Inserts a {!Pretty.leftflush}
- Should be used immediately after @! or "\n".
-- @@ : inserts a @ character
-
- In addition to the usual [printf] % formatting characters the following two
- new characters are supported:
-- %t Corresponds to an argument of type [unit -> doc]. This argument is
- invoked to produce a document
-- %a Corresponds to {b two} arguments. The first of type [unit -> 'a -> doc]
- and the second of type ['a]. (The extra [unit] is do to the
- peculiarities of the built-in support for format strings in Ocaml. It
- turns out that it is not a major problem.) Here is an example of how
- you use this:
-
-{v dprintf "Name=%s, SSN=%7d, Children=\@\[%a\@\]\n"
- pers.name pers.ssn (docList (chr ',' ++ break) text)
- pers.children v}
-
- The result of [dprintf] is a {!Pretty.doc}. You can format the document and
- emit it using the functions {!Pretty.fprint} and {!Pretty.sprint}.
-
-*)
-
-(** Like {!Pretty.dprintf} but more general. It also takes a function that is
- * invoked on the constructed document but before any formatting is done. The
- * type of the format argument means that 'a is the type of the parameters of
- * this function, unit is the type of the first argument to %a and %t
- * formats, doc is the type of the intermediate result, and 'b is the type of
- * the result of gprintf. *)
-val gprintf: (doc -> 'b) -> ('a, unit, doc, 'b) format4 -> 'a
-
-(** Format the document to the given width and emit it to the given channel *)
-val fprint: out_channel -> width:int -> doc -> unit
-
-(** Format the document to the given width and emit it as a string *)
-val sprint: width:int -> doc -> string
-
-(** Like {!Pretty.dprintf} followed by {!Pretty.fprint} *)
-val fprintf: out_channel -> ('a, unit, doc) format -> 'a
-
-(** Like {!Pretty.fprintf} applied to [stdout] *)
-val printf: ('a, unit, doc) format -> 'a
-
-(** Like {!Pretty.fprintf} applied to [stderr] *)
-val eprintf: ('a, unit, doc) format -> 'a
-
-
-(* sm: arg! why can't I write this function?! *)
-(* * Like {!Pretty.dprintf} but yielding a string with no newlines *)
-(*val sprintf: (doc, unit, doc) format -> string*)
-
-(* sm: different tack.. *)
-(* doesn't work either. well f it anyway *)
-(*val failwithf: ('a, unit, doc) format -> 'a*)
-
-
-(** Invokes a thunk, with printDepth temporarily set to the specified value *)
-val withPrintDepth : int -> (unit -> unit) -> unit
-
-(** The following variables can be used to control the operation of the printer *)
-
-(** Specifies the nesting depth of the [align]/[unalign] pairs at which
- everything is replaced with ellipsis *)
-val printDepth : int ref
-
-val printIndent : bool ref (** If false then does not indent *)
-
-
-(** If set to [true] then optional breaks are taken only when the document
- has exceeded the given width. This means that the printout will looked
- more ragged but it will be faster *)
-val fastMode : bool ref
-
-val flushOften : bool ref (** If true the it flushes after every print *)
-
-
-(** Keep a running count of the taken newlines. You can read and write this
- * from the client code if you want *)
-val countNewLines : int ref
-
-
-(** A function that when used at top-level in a module will direct
- * the pa_prtype module generate automatically the printing functions for a
- * type *)
-val auto_printer: string -> 'b
diff --git a/cil/ocamlutil/stats.ml b/cil/ocamlutil/stats.ml
deleted file mode 100644
index 8bbb7d05d61677958eadefde5156d614cf20d4d8..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/stats.ml
+++ /dev/null
@@ -1,146 +0,0 @@
-(* The following functions are implemented in perfcount.c *)
-
-(* Returns true is we have the performance counters *)
-external has_performance_counters: unit -> bool = "has_performance_counters"
-
-(* Returns number of seconds since the first read *)
-external read_pentium_perfcount : unit -> float = "read_pentium_perfcount"
-
-(* Returns current cycle counter, divided by 1^20, and truncated to 30 bits *)
-external sample_pentium_perfcount_20 : unit -> int = "sample_pentium_perfcount_20"
-
-(* Returns current cycle counter, divided by 1^10, and truncated to 30 bits *)
-external sample_pentium_perfcount_10 : unit -> int = "sample_pentium_perfcount_10"
-
-
-(* Whether to use the performance counters (on Pentium only) *)
-
-(* The performance counters are disabled by default. *)
-let do_use_performance_counters = ref false
-
- (* A hierarchy of timings *)
-
-type t = { name : string;
- mutable time : float; (* In seconds *)
- mutable sub : t list}
-
- (* Create the top level *)
-let top = { name = "TOTAL";
- time = 0.0;
- sub = []; }
-
- (* The stack of current path through
- * the hierarchy. The first is the
- * leaf. *)
-let current : t list ref = ref [top]
-
-exception NoPerfCount
-let reset (perfcount: bool) =
- top.sub <- [];
- if perfcount then begin
- if not (has_performance_counters ()) then begin
- raise NoPerfCount
- end
- end;
- do_use_performance_counters := perfcount
-
-
-
-let print chn msg =
- (* Total up *)
- top.time <- List.fold_left (fun sum f -> sum +. f.time) 0.0 top.sub;
- let rec prTree ind node =
- if !do_use_performance_counters then
- (Printf.fprintf chn "%s%-20s %8.5f s\n"
- (String.make ind ' ') node.name node.time)
- else
- (Printf.fprintf chn "%s%-20s %6.3f s\n"
- (String.make ind ' ') node.name node.time);
-
- List.iter (prTree (ind + 2)) (List.rev node.sub)
- in
- Printf.fprintf chn "%s" msg;
- List.iter (prTree 0) [ top ];
- Printf.fprintf chn "Timing used %s\n"
- (if !do_use_performance_counters then "Pentium performance counters"
- else "Unix.time");
- let gc = Gc.quick_stat () in
- let printM (w: float) : string =
- Printf.sprintf "%.2fMb" (w *. 4.0 /. 1000000.0)
- in
- Printf.fprintf chn
- "Memory statistics: total=%s, max=%s, minor=%s, major=%s, promoted=%s\n minor collections=%d major collections=%d compactions=%d\n"
- (printM (gc.Gc.minor_words +. gc.Gc.major_words
- -. gc.Gc.promoted_words))
- (printM (float_of_int gc.Gc.top_heap_words))
- (printM gc.Gc.minor_words)
- (printM gc.Gc.major_words)
- (printM gc.Gc.promoted_words)
- gc.Gc.minor_collections
- gc.Gc.major_collections
- gc.Gc.compactions;
-
- ()
-
-
-
-(* Get the current time, in seconds *)
-let get_current_time () : float =
- if !do_use_performance_counters then
- read_pentium_perfcount ()
- else
- (Unix.times ()).Unix.tms_utime
-
-let repeattime limit str f arg =
- (* Find the right stat *)
- let stat : t =
- let curr = match !current with h :: _ -> h | _ -> assert false in
- let rec loop = function
- h :: _ when h.name = str -> h
- | _ :: rest -> loop rest
- | [] ->
- let nw = {name = str; time = 0.0; sub = []} in
- curr.sub <- nw :: curr.sub;
- nw
- in
- loop curr.sub
- in
- let oldcurrent = !current in
- current := stat :: oldcurrent;
- let start = get_current_time () in
- let rec repeatf count =
- let res = f arg in
- let diff = get_current_time () -. start in
- if diff < limit then
- repeatf (count + 1)
- else begin
- stat.time <- stat.time +. (diff /. float(count));
- current := oldcurrent; (* Pop the current stat *)
- res (* Return the function result *)
- end
- in
- repeatf 1
-
-
-let time str f arg = repeattime 0.0 str f arg
-
-
-let lastTime = ref 0.0
-let timethis (f: 'a -> 'b) (arg: 'a) : 'b =
- let start = get_current_time () in
- let res = f arg in
- lastTime := get_current_time () -. start;
- res
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/cil/ocamlutil/stats.mli b/cil/ocamlutil/stats.mli
deleted file mode 100644
index 9ed98e56ad3c78614035a3ef6ffc93543e56c879..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/stats.mli
+++ /dev/null
@@ -1,72 +0,0 @@
-(*
- *
- * Copyright (c) 2001 by
- * George C. Necula necula@cs.berkeley.edu
- * Scott McPeak smcpeak@cs.berkeley.edu
- * Wes Weimer weimer@cs.berkeley.edu
- *
- * All rights reserved. Permission to use, copy, modify and distribute
- * this software for research purposes only is hereby granted,
- * provided that the following conditions are met:
- * 1. Redistributions of source code must retain the above copyright notice,
- * this list of conditions and the following disclaimer.
- * 2. Redistributions in binary form must reproduce the above copyright notice,
- * this list of conditions and the following disclaimer in the documentation
- * and/or other materials provided with the distribution.
- * 3. The name of the authors may not be used to endorse or promote products
- * derived from this software without specific prior written permission.
- *
- * DISCLAIMER:
- * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
- * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
- * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
- * IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
- * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
- * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
- * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
- * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
- * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
- * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(** Utilities for maintaining timing statistics *)
-
-(** Resets all the timings. Invoke with "true" if you want to switch to using
- * the hardware performance counters from now on. You get an exception if
- * there are not performance counters available *)
-val reset: bool -> unit
-exception NoPerfCount
-
-(** Check if we have performance counters *)
-val has_performance_counters: unit -> bool
-
-(** Sample the current cycle count, in megacycles. *)
-val sample_pentium_perfcount_20: unit -> int
-
-(** Sample the current cycle count, in kilocycles. *)
-val sample_pentium_perfcount_10: unit -> int
-
-(** Time a function and associate the time with the given string. If some
- timing information is already associated with that string, then accumulate
- the times. If this function is invoked within another timed function then
- you can have a hierarchy of timings *)
-val time : string -> ('a -> 'b) -> 'a -> 'b
-
-(** repeattime is like time but runs the function several times until the total
- running time is greater or equal to the first argument. The total time is
- then divided by the number of times the function was run. *)
-val repeattime : float -> string -> ('a -> 'b) -> 'a -> 'b
-
-(** Print the current stats preceeded by a message *)
-val print : out_channel -> string -> unit
-
-
-
-(** Time a function and set lastTime to the time it took *)
-val lastTime: float ref
-val timethis: ('a -> 'b) -> 'a -> 'b
-
-
-
-
diff --git a/cil/ocamlutil/trace.ml b/cil/ocamlutil/trace.ml
deleted file mode 100644
index b42928657f56b103140f7de12bcdbf01987f2836..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/trace.ml
+++ /dev/null
@@ -1,169 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* Trace module implementation
- * see trace.mli
- *)
-
-open Pretty;;
-
-
-(* --------- traceSubsystems --------- *)
-(* this is the list of tags (usually subsystem names) for which
- * trace output will appear *)
-let traceSubsystems : string list ref = ref [];;
-
-
-let traceAddSys (subsys : string) : unit =
- (* (ignore (printf "traceAddSys %s\n" subsys)); *)
- traceSubsystems := subsys :: !traceSubsystems
-;;
-
-
-let traceActive (subsys : string) : bool =
- (* (List.mem elt list) returns true if something in list equals ('=') elt *)
- (List.mem subsys !traceSubsystems)
-;;
-
-
-let rec parseString (str : string) (delim : char) : string list =
-begin
- if (not (String.contains str delim)) then
- if ((String.length str) = 0) then
- []
- else
- [str]
-
- else
- let d = ((String.index str delim) + 1) in
- if (d = 1) then
- (* leading delims are eaten *)
- (parseString (String.sub str d ((String.length str) - d)) delim)
- else
- (String.sub str 0 (d-1)) ::
- (parseString (String.sub str d ((String.length str) - d)) delim)
-end;;
-
-let traceAddMulti (systems : string) : unit =
-begin
- let syslist = (parseString systems ',') in
- (List.iter traceAddSys syslist)
-end;;
-
-
-
-(* --------- traceIndent --------- *)
-let traceIndentLevel : int ref = ref 0;;
-
-
-let traceIndent (sys : string) : unit =
- if (traceActive sys) then
- traceIndentLevel := !traceIndentLevel + 2
-;;
-
-let traceOutdent (sys : string) : unit =
- if ((traceActive sys) &&
- (!traceIndentLevel >= 2)) then
- traceIndentLevel := !traceIndentLevel - 2
-;;
-
-
-(* --------- trace --------- *)
-(* return a tag to prepend to a trace output
- * e.g. " %%% mysys: "
- *)
-let traceTag (sys : string) : Pretty.doc =
- (* return string of 'i' spaces *)
- let rec ind (i : int) : string =
- if (i <= 0) then
- ""
- else
- " " ^ (ind (i-1))
-
- in
- (text ((ind !traceIndentLevel) ^ "%%% " ^ sys ^ ": "))
-;;
-
-
-(* this is the trace function; its first argument is a string
- * tag, and subsequent arguments are like printf formatting
- * strings ("%a" and whatnot) *)
-let trace
- (subsys : string) (* subsystem identifier for enabling tracing *)
- (d : Pretty.doc) (* something made by 'dprintf' *)
- : unit = (* no return value *)
- (* (ignore (printf "trace %s\n" subsys)); *)
-
- (* see if the subsystem's tracing is turned on *)
- if (traceActive subsys) then
- begin
- (fprint stderr 80 (* print it *)
- ((traceTag subsys) ++ d)); (* with prepended subsys tag *)
- (* mb: flush after every message; useful if the program hangs in an
- infinite loop... *)
- (flush stderr)
- end
- else
- () (* eat it *)
-;;
-
-
-let tracei (sys : string) (d : Pretty.doc) : unit =
- (* trace before indent *)
- (trace sys d);
- (traceIndent sys)
-;;
-
-let traceu (sys : string) (d : Pretty.doc) : unit =
- (* trace after outdent *)
- (* no -- I changed my mind -- I want trace *then* outdent *)
- (trace sys d);
- (traceOutdent sys)
-;;
-
-
-
-
-(* -------------------------- trash --------------------- *)
-(* TRASH START
-
-(* sm: more experimenting *)
-(trace "no" (dprintf "no %d\n" 5));
-(trace "yes" (dprintf "yes %d\n" 6));
-(trace "maybe" (dprintf "maybe %d\n" 7));
-
-TRASH END *)
diff --git a/cil/ocamlutil/trace.mli b/cil/ocamlutil/trace.mli
deleted file mode 100644
index 46ca6523bc91f82dbcde14ed5574e030ff432304..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/trace.mli
+++ /dev/null
@@ -1,106 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* Trace module
- * Scott McPeak, 5/4/00
- *
- * The idea is to pepper the source with debugging printfs,
- * and be able to select which ones to actually display at
- * runtime.
- *
- * It is built on top of the Pretty module for printing data
- * structures.
- *
- * To a first approximation, this is needed to compensate for
- * the lack of a debugger that does what I want...
- *)
-
-
-(* this is the list of tags (usually subsystem names) for which
- * trace output will appear *)
-val traceSubsystems : string list ref
-
-(* interface to add a new subsystem to trace (slightly more
- * convenient than direclty changing 'tracingSubsystems') *)
-val traceAddSys : string -> unit
-
-(* query whether a particular subsystem is being traced *)
-val traceActive : string -> bool
-
-(* add several systems, separated by commas *)
-val traceAddMulti : string -> unit
-
-
-(* current indentation level for tracing *)
-val traceIndentLevel : int ref
-
-(* bump up or down the indentation level, if the given subsys
- * is being traced *)
-val traceIndent : string -> unit
-val traceOutdent : string -> unit
-
-
-(* this is the trace function; its first argument is a string
- * tag, and second argument is a 'doc' (which is what 'dprintf'
- * returns).
- *
- * so a sample usage might be
- * (trace "mysubsys" (dprintf "something neat happened %d times\n" counter))
- *)
-val trace : string -> Pretty.doc -> unit
-
-
-(* special flavors that indent/outdent as well. the indent version
- * indents *after* printing, while the outdent version outdents
- * *before* printing. thus, a sequence like
- *
- * (tracei "foo" (dprintf "beginning razzle-dazzle\n"))
- * ..razzle..
- * ..dazzle..
- * (traceu "foo" (dprintf "done with razzle-dazzle\n"))
- *
- * will do the right thing
- *
- * update -- I changed my mind! I decided I prefer it like this
- * %%% sys: (myfunc args)
- * %%% ...inner stuff...
- * %%% sys: myfunc returning 56
- *
- * so now they both print before in/outdenting
- *)
-val tracei : string -> Pretty.doc -> unit
-val traceu : string -> Pretty.doc -> unit
diff --git a/cil/ocamlutil/util.ml b/cil/ocamlutil/util.ml
deleted file mode 100755
index e6c2c679122c0cbe50e0e3c9d70d6fbd0886f89b..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/util.ml
+++ /dev/null
@@ -1,815 +0,0 @@
-(** Utility functions for Coolaid *)
-module E = Errormsg
-module H = Hashtbl
-module IH = Inthash
-
-open Pretty
-
-exception GotSignal of int
-
-let withTimeout (secs: float) (* Seconds for timeout *)
- (handler: int -> 'b) (* What to do if we have a timeout. The
- * argument passed is the signal number
- * received. *)
- (f: 'a -> 'b) (* The function to run *)
- (arg: 'a) (* And its argument *)
- : 'b =
- let oldHandler =
- Sys.signal Sys.sigalrm
- (Sys.Signal_handle
- (fun i ->
- ignore (E.log "Got signal %d\n" i);
- raise (GotSignal i)))
- in
- let reset_sigalrm () =
- ignore (Unix.setitimer Unix.ITIMER_REAL { Unix.it_value = 0.0;
- Unix.it_interval = 0.0;});
- Sys.set_signal Sys.sigalrm oldHandler;
- in
- ignore (Unix.setitimer Unix.ITIMER_REAL
- { Unix.it_value = secs;
- Unix.it_interval = 0.0;});
- (* ignore (Unix.alarm 2); *)
- try
- let res = f arg in
- reset_sigalrm ();
- res
- with exc -> begin
- reset_sigalrm ();
- ignore (E.log "Got an exception\n");
- match exc with
- GotSignal i ->
- handler i
- | _ -> raise exc
- end
-
-(** Print a hash table *)
-let docHash ?(sep=chr ',') (one: 'a -> 'b -> doc) () (h: ('a, 'b) H.t) =
- (H.fold
- (fun key data acc ->
- if acc == align then acc ++ one key data
- else acc ++ sep ++ one key data)
- h
- align) ++ unalign
-
-
-
-let hash_to_list (h: ('a, 'b) H.t) : ('a * 'b) list =
- H.fold
- (fun key data acc -> (key, data) :: acc)
- h
- []
-
-let keys (h: ('a, 'b) H.t) : 'a list =
- H.fold
- (fun key data acc -> key :: acc)
- h
- []
-
-let hash_copy_into (hfrom: ('a, 'b) H.t) (hto: ('a, 'b) H.t) : unit =
- H.clear hto;
- H.iter (H.add hto) hfrom
-
-let anticompare a b = compare b a
-;;
-
-
-let rec list_drop (n : int) (xs : 'a list) : 'a list =
- if n < 0 then invalid_arg "Util.list_drop";
- if n = 0 then
- xs
- else begin
- match xs with
- | [] -> invalid_arg "Util.list_drop"
- | y::ys -> list_drop (n-1) ys
- end
-
-let list_droptail (n : int) (xs : 'a list) : 'a list =
- if n < 0 then invalid_arg "Util.list_droptail";
- let (ndrop,r) =
- List.fold_right
- (fun x (ndrop,acc) ->
- if ndrop = 0 then (ndrop, x :: acc)
- else (ndrop-1, acc))
- xs
- (n,[])
- in
- if ndrop > 0 then invalid_arg "Util.listdroptail"
- else r
-
-let rec list_span (p : 'a -> bool) (xs : 'a list) : 'a list * 'a list =
- begin match xs with
- | [] -> ([],[])
- | x::xs' ->
- if p x then
- let (ys,zs) = list_span p xs' in (x::ys,zs)
- else ([],xs)
- end
-;;
-
-let rec list_rev_append revxs ys =
- begin match revxs with
- | [] -> ys
- | x::xs -> list_rev_append xs (x::ys)
- end
-;;
-let list_insert_by (cmp : 'a -> 'a -> int)
- (x : 'a) (xs : 'a list) : 'a list =
- let rec helper revhs ts =
- begin match ts with
- | [] -> List.rev (x::revhs)
- | t::ts' ->
- if cmp x t >= 0 then helper (t::revhs) ts'
- else list_rev_append (x::revhs) ts
- end
- in
- helper [] xs
-;;
-
-let list_head_default (d : 'a) (xs : 'a list) : 'a =
- begin match xs with
- | [] -> d
- | x::_ -> x
- end
-;;
-
-let rec list_iter3 f xs ys zs =
- begin match xs, ys, zs with
- | [], [], [] -> ()
- | x::xs, y::ys, z::zs -> f x y z; list_iter3 f xs ys zs
- | _ -> invalid_arg "Util.list_iter3"
- end
-;;
-
-let rec get_some_option_list (xs : 'a option list) : 'a list =
- begin match xs with
- | [] -> []
- | None::xs -> get_some_option_list xs
- | Some x::xs -> x :: get_some_option_list xs
- end
-;;
-
-(* tail-recursive append: reverses xs twice *)
-let list_append (xs: 'a list) (ys: 'a list): 'a list =
- match xs with (* optimize some common cases *)
- [] -> ys
- | [x] -> x::ys
- | _ -> list_rev_append (List.rev xs) ys
-
-let list_iteri (f: int -> 'a -> unit) (l: 'a list) : unit =
- let rec loop (i: int) (l: 'a list) : unit =
- match l with
- [] -> ()
- | h :: t -> f i h; loop (i + 1) t
- in
- loop 0 l
-
-let list_mapi (f: int -> 'a -> 'b) (l: 'a list) : 'b list =
- let rec loop (i: int) (l: 'a list) : 'b list =
- match l with
- [] -> []
- | h :: t ->
- let headres = f i h in
- headres :: loop (i + 1) t
- in
- loop 0 l
-
-let list_fold_lefti (f: 'acc -> int -> 'a -> 'acc) (start: 'acc)
- (l: 'a list) : 'acc =
- let rec loop (i, acc) l =
- match l with
- [] -> acc
- | h :: t -> loop (i + 1, f acc i h) t
- in
- loop (0, start) l
-
-
-let list_init (len : int) (init_fun : int -> 'a) : 'a list =
- let rec loop n acc =
- if n < 0 then acc
- else loop (n-1) ((init_fun n)::acc)
- in
- loop (len - 1) []
-;;
-
-
-let rec list_find_first (l: 'a list) (f: 'a -> 'b option) : 'b option =
- match l with
- [] -> None
- | h :: t -> begin
- match f h with
- None -> list_find_first t f
- | r -> r
- end
-
-(** Generates the range of integers starting with a and ending with b *)
-let int_range_list (a: int) (b: int) =
- list_init (b - a + 1) (fun i -> a + i)
-
-
-(** Some handling of registers *)
-type 'a growArrayFill =
- Elem of 'a
- | Susp of (int -> 'a)
-
-type 'a growArray = {
- gaFill: 'a growArrayFill;
- (** Stuff to use to fill in the array as it grows *)
-
- mutable gaMaxInitIndex: int;
- (** Maximum index that was written to. -1 if no writes have
- * been made. *)
-
- mutable gaData: 'a array;
- }
-
-let growTheArray (ga: 'a growArray) (len: int)
- (toidx: int) (why: string) : unit =
- if toidx >= len then begin
- (* Grow the array by 50% *)
- let newlen = toidx + 1 + len / 2 in
-(*
- ignore (E.log "growing an array to idx=%d (%s)\n" toidx why);
-*)
- let data' = begin match ga.gaFill with
- Elem x ->
-
- let data'' = Array.create newlen x in
- Array.blit ga.gaData 0 data'' 0 len;
- data''
- | Susp f -> Array.init newlen
- (fun i -> if i < len then ga.gaData.(i) else f i)
- end
- in
- ga.gaData <- data'
- end
-
-let getReg (ga: 'a growArray) (r: int) : 'a =
- let len = Array.length ga.gaData in
- if r >= len then
- growTheArray ga len r "get";
-
- ga.gaData.(r)
-
-let setReg (ga: 'a growArray) (r: int) (what: 'a) : unit =
- let len = Array.length ga.gaData in
- if r >= len then
- growTheArray ga len r "set";
- if r > ga.gaMaxInitIndex then ga.gaMaxInitIndex <- r;
- ga.gaData.(r) <- what
-
-let newGrowArray (initsz: int) (fill: 'a growArrayFill) : 'a growArray =
- { gaFill = fill;
- gaMaxInitIndex = -1;
- gaData = begin match fill with
- Elem x -> Array.create initsz x
- | Susp f -> Array.init initsz f
- end; }
-
-let copyGrowArray (ga: 'a growArray) : 'a growArray =
- { ga with gaData = Array.copy ga.gaData }
-
-let deepCopyGrowArray (ga: 'a growArray) (copy: 'a -> 'a): 'a growArray =
- { ga with gaData = Array.map copy ga.gaData }
-
-
-
-(** Iterate over the initialized elements of the array *)
-let growArray_iteri (f: int -> 'a -> unit) (ga: 'a growArray) =
- for i = 0 to ga.gaMaxInitIndex do
- f i ga.gaData.(i)
- done
-
-
-(** Fold left over the initialized elements of the array *)
-let growArray_foldl (f: 'acc -> 'a -> 'acc)
- (acc: 'acc) (ga: 'a growArray) : 'acc =
- let rec loop (acc: 'acc) (idx: int) : 'acc =
- if idx > ga.gaMaxInitIndex then
- acc
- else
- loop (f acc ga.gaData.(idx)) (idx + 1)
- in
- loop acc 0
-
-
-
-
-let hasPrefix (prefix: string) (what: string) : bool =
- let pl = String.length prefix in
- try String.sub what 0 pl = prefix
- with Invalid_argument _ -> false
-
-
-
-let restoreRef ?(deepCopy=(fun x -> x)) (r: 'a ref) : (unit -> unit) =
- let old = deepCopy !r in
- (fun () -> r := old)
-
-let restoreHash ?deepCopy (h: ('a, 'b) H.t) : (unit -> unit) =
- let old =
- match deepCopy with
- None -> H.copy h
- | Some f ->
- let old = H.create (H.length h) in
- H.iter (fun k d -> H.add old k (f d)) h;
- old
- in
- (fun () -> hash_copy_into old h)
-
-let restoreIntHash ?deepCopy (h: 'a IH.t) : (unit -> unit) =
- let old =
- match deepCopy with
- None -> IH.copy h
- | Some f ->
- let old = IH.create 13 in
- IH.iter (fun k d -> IH.add old k (f d)) h;
- old
- in
- (fun () ->
- IH.clear old;
- IH.iter (fun i k -> IH.add old i k) h)
-
-let restoreArray ?deepCopy (a: 'a array) : (unit -> unit) =
- let old = Array.copy a in
- (match deepCopy with
- None -> ()
- | Some f -> Array.iteri (fun i v -> old.(i) <- f v) old);
- (fun () -> Array.blit old 0 a 0 (Array.length a))
-
-let runThunks (l: (unit -> unit) list) : (unit -> unit) =
- fun () -> List.iter (fun f -> f ()) l
-
-
-
-(* Memoize *)
-let memoize (h: ('a, 'b) Hashtbl.t)
- (arg: 'a)
- (f: 'a -> 'b) : 'b =
- try
- Hashtbl.find h arg
- with Not_found -> begin
- let res = f arg in
- Hashtbl.add h arg res;
- res
- end
-
-(* Just another name for memoize *)
-let findOrAdd h arg f = memoize h arg f
-
-(* A tryFinally function *)
-let tryFinally
- (main: 'a -> 'b) (* The function to run *)
- (final: 'b option -> unit) (* Something to run at the end *)
- (arg: 'a) : 'b =
- try
- let res: 'b = main arg in
- final (Some res);
- res
- with e -> begin
- final None;
- raise e
- end
-
-
-
-
-let valOf : 'a option -> 'a = function
- None -> raise (Failure "Util.valOf")
- | Some x -> x
-
-(**
- * An accumulating for loop.
- *
- * Initialize the accumulator with init. The current index and accumulator
- * from the previous iteration is passed to f.
- *)
-let fold_for ~(init: 'a) ~(lo: int) ~(hi: int) (f: int -> 'a -> 'a) =
- let rec forloop i acc =
- if i > hi then acc
- else forloop (i+1) (f i acc)
- in
- forloop lo init
-
-(************************************************************************)
-
-module type STACK = sig
- type 'a t
- (** The type of stacks containing elements of type ['a]. *)
-
- exception Empty
- (** Raised when {!Stack.pop} or {!Stack.top} is applied to an empty stack. *)
-
- val create : unit -> 'a t
- (** Return a new stack, initially empty. *)
-
- val push : 'a -> 'a t -> unit
- (** [push x s] adds the element [x] at the top of stack [s]. *)
-
- val pop : 'a t -> 'a
- (** [pop s] removes and returns the topmost element in stack [s],
- or raises [Empty] if the stack is empty. *)
-
- val top : 'a t -> 'a
- (** [top s] returns the topmost element in stack [s],
- or raises [Empty] if the stack is empty. *)
-
- val clear : 'a t -> unit
- (** Discard all elements from a stack. *)
-
- val copy : 'a t -> 'a t
- (** Return a copy of the given stack. *)
-
- val is_empty : 'a t -> bool
- (** Return [true] if the given stack is empty, [false] otherwise. *)
-
- val length : 'a t -> int
- (** Return the number of elements in a stack. *)
-
- val iter : ('a -> unit) -> 'a t -> unit
- (** [iter f s] applies [f] in turn to all elements of [s],
- from the element at the top of the stack to the element at the
- bottom of the stack. The stack itself is unchanged. *)
-end
-
-module Stack = struct
-
- type 'a t = { mutable length : int;
- stack : 'a Stack.t; }
-
- exception Empty
-
- let create () = { length = 0;
- stack = Stack.create(); }
-
- let push x s =
- s.length <- s.length + 1;
- Stack.push x s.stack
-
- let pop s =
- s.length <- s.length - 1;
- Stack.pop s.stack
-
- let top s =
- Stack.top s.stack
-
- let clear s =
- s.length <- 0;
- Stack.clear s.stack
-
- let copy s = { length = s.length;
- stack = Stack.copy s.stack; }
-
- let is_empty s =
- Stack.is_empty s.stack
-
- let length s = s.length
-
- let iter f s =
- Stack.iter f s.stack
-
-end
-
-(************************************************************************)
-
-let absoluteFilename (fname: string) =
- if Filename.is_relative fname then
- Filename.concat (Sys.getcwd ()) fname
- else
- fname
-
-
-(* mapNoCopy is like map but avoid copying the list if the function does not
- * change the elements. *)
-let rec mapNoCopy (f: 'a -> 'a) = function
- [] -> []
- | (i :: resti) as li ->
- let i' = f i in
- let resti' = mapNoCopy f resti in
- if i' != i || resti' != resti then i' :: resti' else li
-
-let rec mapNoCopyList (f: 'a -> 'a list) = function
- [] -> []
- | (i :: resti) as li ->
- let il' = f i in
- let resti' = mapNoCopyList f resti in
- match il' with
- [i'] when i' == i && resti' == resti -> li
- | _ -> il' @ resti'
-
-
-(* Use a filter function that does not rewrite the list unless necessary *)
-let rec filterNoCopy (f: 'a -> bool) (l: 'a list) : 'a list =
- match l with
- [] -> []
- | h :: rest when not (f h) -> filterNoCopy f rest
- | h :: rest ->
- let rest' = filterNoCopy f rest in
- if rest == rest' then l else h :: rest'
-
-(** Join a list of strings *)
-let rec joinStrings (sep: string) (sl: string list) =
- match sl with
- [] -> ""
- | [s1] -> s1
- | s1 :: ((_ :: _) as rest) -> s1 ^ sep ^ joinStrings sep rest
-
-
-(************************************************************************
-
- Configuration
-
- ************************************************************************)
-(** The configuration data can be of several types **)
-type configData =
- ConfInt of int
- | ConfBool of bool
- | ConfFloat of float
- | ConfString of string
- | ConfList of configData list
-
-
-(* Store here window configuration file *)
-let configurationData: (string, configData) H.t = H.create 13
-
-let clearConfiguration () = H.clear configurationData
-
-let setConfiguration (key: string) (c: configData) =
- H.replace configurationData key c
-
-let findConfiguration (key: string) : configData =
- H.find configurationData key
-
-let findConfigurationInt (key: string) : int =
- match findConfiguration key with
- ConfInt i -> i
- | _ ->
- ignore (E.warn "Configuration %s is not an integer" key);
- raise Not_found
-
-let useConfigurationInt (key: string) (f: int -> unit) =
- try f (findConfigurationInt key)
- with Not_found -> ()
-
-let findConfigurationString (key: string) : string =
- match findConfiguration key with
- ConfString s -> s
- | _ ->
- ignore (E.warn "Configuration %s is not a string" key);
- raise Not_found
-
-let useConfigurationString (key: string) (f: string -> unit) =
- try f (findConfigurationString key)
- with Not_found -> ()
-
-
-let findConfigurationBool (key: string) : bool =
- match findConfiguration key with
- ConfBool b -> b
- | _ ->
- ignore (E.warn "Configuration %s is not a boolean" key);
- raise Not_found
-
-let useConfigurationBool (key: string) (f: bool -> unit) =
- try f (findConfigurationBool key)
- with Not_found -> ()
-
-let findConfigurationList (key: string) : configData list =
- match findConfiguration key with
- ConfList l -> l
- | _ ->
- ignore (E.warn "Configuration %s is not a list" key);
- raise Not_found
-
-let useConfigurationList (key: string) (f: configData list -> unit) =
- try f (findConfigurationList key)
- with Not_found -> ()
-
-
-let saveConfiguration (fname: string) =
- (** Convert configuration data to a string, for saving externally *)
- let configToString (c: configData) : string =
- let buff = Buffer.create 80 in
- let rec loop (c: configData) : unit =
- match c with
- ConfInt i ->
- Buffer.add_char buff 'i';
- Buffer.add_string buff (string_of_int i);
- Buffer.add_char buff ';'
-
- | ConfBool b ->
- Buffer.add_char buff 'b';
- Buffer.add_string buff (string_of_bool b);
- Buffer.add_char buff ';'
-
- | ConfFloat f ->
- Buffer.add_char buff 'f';
- Buffer.add_string buff (string_of_float f);
- Buffer.add_char buff ';'
-
- | ConfString s ->
- if String.contains s '"' then
- E.s (E.unimp "Guilib: configuration string contains quotes");
- Buffer.add_char buff '"';
- Buffer.add_string buff s;
- Buffer.add_char buff '"'; (* '"' *)
-
- | ConfList l ->
- Buffer.add_char buff '[';
- List.iter loop l;
- Buffer.add_char buff ']'
- in
- loop c;
- Buffer.contents buff
- in
- try
- let oc = open_out fname in
- ignore (E.log "Saving configuration to %s\n" (absoluteFilename fname));
- H.iter (fun k c ->
- output_string oc (k ^ "\n");
- output_string oc ((configToString c) ^ "\n"))
- configurationData;
- close_out oc
- with _ ->
- ignore (E.warn "Cannot open configuration file %s\n" fname)
-
-
-(** Make some regular expressions early *)
-let intRegexp = Str.regexp "i\\([0-9]+\\);"
-let floatRegexp = Str.regexp "f\\([0-9]+\\.[0-9]+\\);"
-let boolRegexp = Str.regexp "b\\(\\(true\\)\\|\\(false\\)\\);"
-let stringRegexp = Str.regexp "\"\\([^\"]*\\)\""
-
-let loadConfiguration (fname: string) : unit =
- H.clear configurationData;
-
- let stringToConfig (s: string) : configData =
- let idx = ref 0 in (** the current index *)
- let l = String.length s in
-
- let rec getOne () : configData =
- if !idx >= l then raise Not_found;
-
- if Str.string_match intRegexp s !idx then begin
- idx := Str.match_end ();
- ConfInt (int_of_string (Str.matched_group 1 s))
- end else if Str.string_match floatRegexp s !idx then begin
- idx := Str.match_end ();
- ConfFloat (float_of_string (Str.matched_group 1 s))
- end else if Str.string_match boolRegexp s !idx then begin
- idx := Str.match_end ();
- ConfBool (bool_of_string (Str.matched_group 1 s))
- end else if Str.string_match stringRegexp s !idx then begin
- idx := Str.match_end ();
- ConfString (Str.matched_group 1 s)
- end else if String.get s !idx = '[' then begin
- (* We are starting a list *)
- incr idx;
- let rec loop (acc: configData list) : configData list =
- if !idx >= l then begin
- ignore (E.warn "Non-terminated list in configuration %s" s);
- raise Not_found
- end;
- if String.get s !idx = ']' then begin
- incr idx;
- List.rev acc
- end else
- loop (getOne () :: acc)
- in
- ConfList (loop [])
- end else begin
- ignore (E.warn "Bad configuration element in a list: %s\n"
- (String.sub s !idx (l - !idx)));
- raise Not_found
- end
- in
- getOne ()
- in
- (try
- let ic = open_in fname in
- ignore (E.log "Loading configuration from %s\n" (absoluteFilename fname));
- (try
- while true do
- let k = input_line ic in
- let s = input_line ic in
- try
- let c = stringToConfig s in
- setConfiguration k c
- with Not_found -> ()
- done
- with End_of_file -> ());
- close_in ic;
- with _ -> () (* no file, ignore *));
-
- ()
-
-
-
-(*********************************************************************)
-type symbol = int
-
-(**{ Registering symbol names} *)
-let registeredSymbolNames: (string, symbol) H.t = H.create 113
-let symbolNames: string IH.t = IH.create 113
-let nextSymbolId = ref 0
-
-(* When we register symbol ranges, we store a naming function for use later
- * when we print the symbol *)
-let symbolRangeNaming: (int * int * (int -> string)) list ref = ref []
-
-(* Reset the symbols. We want to allow the registration of symbols at the
- * top-level. This means that we cannot simply clear the hash tables. The
- * first time we call "reset" we actually remember the state. *)
-let resetThunk: (unit -> unit) option ref = ref None
-
-let snapshotSymbols () : unit -> unit =
- runThunks [ restoreIntHash symbolNames;
- restoreRef nextSymbolId;
- restoreHash registeredSymbolNames;
- restoreRef symbolRangeNaming ]
-
-let resetSymbols () =
- match !resetThunk with
- None -> resetThunk := Some (snapshotSymbols ())
- | Some t -> t ()
-
-
-let dumpSymbols () =
- ignore (E.log "Current symbols\n");
- IH.iter (fun i k -> ignore (E.log " %s -> %d\n" k i)) symbolNames;
- ()
-
-let newSymbol (n: string) : symbol =
- assert(not (H.mem registeredSymbolNames n));
- let id = !nextSymbolId in
- incr nextSymbolId;
- H.add registeredSymbolNames n id;
- IH.add symbolNames id n;
- id
-
-let registerSymbolName (n: string) : symbol =
- try H.find registeredSymbolNames n
- with Not_found -> begin
- newSymbol n
- end
-
-(** Register a range of symbols. The mkname function will be invoked for
- * indices starting at 0 *)
-let registerSymbolRange (count: int) (mkname: int -> string) : symbol =
- if count < 0 then E.s (E.bug "registerSymbolRange: invalid counter");
- let first = !nextSymbolId in
- nextSymbolId := !nextSymbolId + count;
- symbolRangeNaming :=
- (first, !nextSymbolId - 1, mkname) :: !symbolRangeNaming;
- first
-
-let symbolName (id: symbol) : string =
- try IH.find symbolNames id
- with Not_found ->
- (* Perhaps it is one of the lazily named symbols *)
- try
- let (fst, _, mkname) =
- List.find
- (fun (fst,lst,_) -> fst <= id && id <= lst)
- !symbolRangeNaming in
- let n = mkname (id - fst) in
- IH.add symbolNames id n;
- n
- with Not_found ->
- ignore (E.warn "Cannot find the name of symbol %d" id);
- "symbol" ^ string_of_int id
-
-(************************************************************************)
-
-(** {1 Int32 Operators} *)
-
-module Int32Op = struct
- exception IntegerTooLarge
- let to_int (i: int32) =
- let i' = Int32.to_int i in (* Silently drop the 32nd bit *)
- if i = Int32.of_int i' then i'
- else raise IntegerTooLarge
-
- let (<%) = (fun x y -> (Int32.compare x y) < 0)
- let (<=%) = (fun x y -> (Int32.compare x y) <= 0)
- let (>%) = (fun x y -> (Int32.compare x y) > 0)
- let (>=%) = (fun x y -> (Int32.compare x y) >= 0)
- let (<>%) = (fun x y -> (Int32.compare x y) <> 0)
-
- let (+%) = Int32.add
- let (-%) = Int32.sub
- let ( *% ) = Int32.mul
- let (/%) = Int32.div
- let (~-%) = Int32.neg
-
- (* We cannot use the <<% because it trips camlp4 *)
- let sll = fun i j -> Int32.shift_left i (to_int j)
- let (>>%) = fun i j -> Int32.shift_right i (to_int j)
- let (>>>%) = fun i j -> Int32.shift_right_logical i (to_int j)
-end
-
-
-(*********************************************************************)
-
-let equals x1 x2 : bool =
- (compare x1 x2) = 0
diff --git a/cil/ocamlutil/util.mli b/cil/ocamlutil/util.mli
deleted file mode 100644
index d701c65f431f9f489cf029e8eaeb6d542b527365..0000000000000000000000000000000000000000
--- a/cil/ocamlutil/util.mli
+++ /dev/null
@@ -1,311 +0,0 @@
-(** A bunch of generally useful functions *)
-
-exception GotSignal of int
-
-val withTimeout : float -> (* Seconds for timeout *)
- (int -> 'b) -> (* What to do if we have a timeout. The
- * argument passed is the signal number
- * received. *)
- ('a -> 'b) -> (* The function to run *)
- 'a -> (* And its argument *)
- 'b
-
-val docHash : ?sep:Pretty.doc -> ('a -> 'b -> Pretty.doc) -> unit ->
- (('a, 'b) Hashtbl.t) -> Pretty.doc
-
-
-val hash_to_list: ('a, 'b) Hashtbl.t -> ('a * 'b) list
-
-val keys: ('a, 'b) Hashtbl.t -> 'a list
-
-
-(** Copy a hash table into another *)
-val hash_copy_into: ('a, 'b) Hashtbl.t -> ('a, 'b) Hashtbl.t -> unit
-
-(** First, a few utility functions I wish were in the standard prelude *)
-
-val anticompare: 'a -> 'a -> int
-
-val list_drop : int -> 'a list -> 'a list
-val list_droptail : int -> 'a list -> 'a list
-val list_span: ('a -> bool) -> ('a list) -> 'a list * 'a list
-val list_insert_by: ('a -> 'a -> int) -> 'a -> 'a list -> 'a list
-val list_head_default: 'a -> 'a list -> 'a
-val list_iter3 : ('a -> 'b -> 'c -> unit) ->
- 'a list -> 'b list -> 'c list -> unit
-val get_some_option_list : 'a option list -> 'a list
-val list_append: ('a list) -> ('a list) -> ('a list) (* tail-recursive append*)
-
-(** Iterate over a list passing the index as you go *)
-val list_iteri: (int -> 'a -> unit) -> 'a list -> unit
-val list_mapi: (int -> 'a -> 'b) -> 'a list -> 'b list
-
-(** Like fold_left but pass the index into the list as well *)
-val list_fold_lefti: ('acc -> int -> 'a -> 'acc) -> 'acc -> 'a list -> 'acc
-
-(** Generates the range of integers starting with a and ending with b *)
-val int_range_list : int -> int -> int list
-
-(* Create a list of length l *)
-val list_init : int -> (int -> 'a) -> 'a list
-
-(** Find the first element in a list that returns Some *)
-val list_find_first: 'a list -> ('a -> 'b option) -> 'b option
-
-(** mapNoCopy is like map but avoid copying the list if the function does not
- * change the elements *)
-
-val mapNoCopy: ('a -> 'a) -> 'a list -> 'a list
-
-val mapNoCopyList: ('a -> 'a list) -> 'a list -> 'a list
-
-val filterNoCopy: ('a -> bool) -> 'a list -> 'a list
-
-
-(** Join a list of strings *)
-val joinStrings: string -> string list -> string
-
-
-(**** Now in growArray.mli
-
-(** Growable arrays *)
-type 'a growArrayFill =
- Elem of 'a
- | Susp of (int -> 'a)
-
-type 'a growArray = {
- gaFill: 'a growArrayFill;
- (** Stuff to use to fill in the array as it grows *)
-
- mutable gaMaxInitIndex: int;
- (** Maximum index that was written to. -1 if no writes have
- * been made. *)
-
- mutable gaData: 'a array;
- }
-
-val newGrowArray: int -> 'a growArrayFill -> 'a growArray
-(** [newGrowArray initsz fillhow] *)
-
-val getReg: 'a growArray -> int -> 'a
-val setReg: 'a growArray -> int -> 'a -> unit
-val copyGrowArray: 'a growArray -> 'a growArray
-val deepCopyGrowArray: 'a growArray -> ('a -> 'a) -> 'a growArray
-
-
-val growArray_iteri: (int -> 'a -> unit) -> 'a growArray -> unit
-(** Iterate over the initialized elements of the array *)
-
-val growArray_foldl: ('acc -> 'a -> 'acc) -> 'acc ->'a growArray -> 'acc
-(** Fold left over the initialized elements of the array *)
-
-****)
-
-(** hasPrefix prefix str returns true with str starts with prefix *)
-val hasPrefix: string -> string -> bool
-
-
-(** Given a ref cell, produce a thunk that later restores it to its current value *)
-val restoreRef: ?deepCopy:('a -> 'a) -> 'a ref -> unit -> unit
-
-(** Given a hash table, produce a thunk that later restores it to its current value *)
-val restoreHash: ?deepCopy:('b -> 'b) -> ('a, 'b) Hashtbl.t -> unit -> unit
-
-(** Given an integer hash table, produce a thunk that later restores it to
- * its current value *)
-val restoreIntHash: ?deepCopy:('b -> 'b) -> 'b Inthash.t -> unit -> unit
-
-(** Given an array, produce a thunk that later restores it to its current value *)
-val restoreArray: ?deepCopy:('a -> 'a) -> 'a array -> unit -> unit
-
-
-(** Given a list of thunks, produce a thunk that runs them all *)
-val runThunks: (unit -> unit) list -> unit -> unit
-
-
-val memoize: ('a, 'b) Hashtbl.t ->
- 'a ->
- ('a -> 'b) -> 'b
-
-(** Just another name for memoize *)
-val findOrAdd: ('a, 'b) Hashtbl.t ->
- 'a ->
- ('a -> 'b) -> 'b
-
-val tryFinally:
- ('a -> 'b) -> (* The function to run *)
- ('b option -> unit) -> (* Something to run at the end. The None case is
- * used when an exception is thrown *)
- 'a -> 'b
-
-
-
-
-(** Get the value of an option. Raises Failure if None *)
-val valOf : 'a option -> 'a
-
-(**
- * An accumulating for loop.
- *
- * Initialize the accumulator with init. The current index and accumulator
- * from the previous iteration is passed to f.
- *)
-val fold_for : init:'a -> lo:int -> hi:int -> (int -> 'a -> 'a) -> 'a
-
-(************************************************************************)
-
-module type STACK = sig
- type 'a t
- (** The type of stacks containing elements of type ['a]. *)
-
- exception Empty
- (** Raised when {!Util.Stack.pop} or {!Util.Stack.top} is applied to an
- * empty stack. *)
-
- val create : unit -> 'a t
-
-
- val push : 'a -> 'a t -> unit
- (** [push x s] adds the element [x] at the top of stack [s]. *)
-
- val pop : 'a t -> 'a
- (** [pop s] removes and returns the topmost element in stack [s],
- or raises [Empty] if the stack is empty. *)
-
- val top : 'a t -> 'a
- (** [top s] returns the topmost element in stack [s],
- or raises [Empty] if the stack is empty. *)
-
- val clear : 'a t -> unit
- (** Discard all elements from a stack. *)
-
- val copy : 'a t -> 'a t
- (** Return a copy of the given stack. *)
-
- val is_empty : 'a t -> bool
- (** Return [true] if the given stack is empty, [false] otherwise. *)
-
- val length : 'a t -> int
- (** Return the number of elements in a stack. *)
-
- val iter : ('a -> unit) -> 'a t -> unit
- (** [iter f s] applies [f] in turn to all elements of [s],
- from the element at the top of the stack to the element at the
- bottom of the stack. The stack itself is unchanged. *)
-end
-
-module Stack : STACK
-
-(************************************************************************
- Configuration
-************************************************************************)
-(** The configuration data can be of several types **)
-type configData =
- ConfInt of int
- | ConfBool of bool
- | ConfFloat of float
- | ConfString of string
- | ConfList of configData list
-
-
-(** Load the configuration from a file *)
-val loadConfiguration: string -> unit
-
-(** Save the configuration in a file. Overwrites the previous values *)
-val saveConfiguration: string -> unit
-
-
-(** Clear all configuration data *)
-val clearConfiguration: unit -> unit
-
-(** Set a configuration element, with a key. Overwrites the previous values *)
-val setConfiguration: string -> configData -> unit
-
-(** Find a configuration elements, given a key. Raises Not_found if it canont
- * find it *)
-val findConfiguration: string -> configData
-
-(** Like findConfiguration but extracts the integer *)
-val findConfigurationInt: string -> int
-
-(** Looks for an integer configuration element, and if it is found, it uses
- * the given function. Otherwise, does nothing *)
-val useConfigurationInt: string -> (int -> unit) -> unit
-
-
-val findConfigurationBool: string -> bool
-val useConfigurationBool: string -> (bool -> unit) -> unit
-
-val findConfigurationString: string -> string
-val useConfigurationString: string -> (string -> unit) -> unit
-
-val findConfigurationList: string -> configData list
-val useConfigurationList: string -> (configData list -> unit) -> unit
-
-
-(************************************************************************)
-
-(** Symbols are integers that are uniquely associated with names *)
-type symbol = int
-
-(** Get the name of a symbol *)
-val symbolName: symbol -> string
-
-(** Register a symbol name and get the symbol for it *)
-val registerSymbolName: string -> symbol
-
-(** Register a number of consecutive symbol ids. The naming function will be
- * invoked with indices from 0 to the counter - 1. Returns the id of the
- * first symbol created. The naming function is invoked lazily, only when the
- * name of the symbol is required. *)
-val registerSymbolRange: int -> (int -> string) -> symbol
-
-
-(** Make a fresh symbol. Give the name also, which ought to be distinct from
- * existing symbols. This is different from registerSymbolName in that it
- * always creates a new symbol. *)
-val newSymbol: string -> symbol
-
-(** Reset the state of the symbols to the program startup state *)
-val resetSymbols: unit -> unit
-
-(** Take a snapshot of the symbol state. Returns a thunk that restores the
- * state. *)
-val snapshotSymbols: unit -> unit -> unit
-
-
-(** Dump the list of registered symbols *)
-val dumpSymbols: unit -> unit
-
-(************************************************************************)
-
-(** {1 Int32 Operators} *)
-
-module Int32Op : sig
- val (<%) : int32 -> int32 -> bool
- val (<=%) : int32 -> int32 -> bool
- val (>%) : int32 -> int32 -> bool
- val (>=%) : int32 -> int32 -> bool
- val (<>%) : int32 -> int32 -> bool
-
- val (+%) : int32 -> int32 -> int32
- val (-%) : int32 -> int32 -> int32
- val ( *% ) : int32 -> int32 -> int32
- val (/%) : int32 -> int32 -> int32
- val (~-%) : int32 -> int32
-
- val sll : int32 -> int32 -> int32
- val (>>%) : int32 -> int32 -> int32
- val (>>>%) : int32 -> int32 -> int32
-
- exception IntegerTooLarge
- val to_int : int32 -> int
-end
-
-(************************************************************************)
-
-(** This has the semantics of (=) on OCaml 3.07 and earlier. It can
- handle cyclic values as long as a structure in the cycle has a unique
- name or id in some field that occurs before any fields that have cyclic
- pointers. *)
-val equals: 'a -> 'a -> bool
diff --git a/cil/src/check.ml b/cil/src/check.ml
deleted file mode 100644
index 4dc8850a3fd009a89bef43c8827c1e3801140147..0000000000000000000000000000000000000000
--- a/cil/src/check.ml
+++ /dev/null
@@ -1,1017 +0,0 @@
-(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* A consistency checker for CIL *)
-open Cil
-module E = Errormsg
-module H = Hashtbl
-open Pretty
-
-
-(* A few parameters to customize the checking *)
-type checkFlags =
- NoCheckGlobalIds (* Do not check that the global ids have the proper
- * hash value *)
-
-let checkGlobalIds = ref true
-
- (* Attributes must be sorted *)
-type ctxAttr =
- CALocal (* Attribute of a local variable *)
- | CAGlobal (* Attribute of a global variable *)
- | CAType (* Attribute of a type *)
-
-let valid = ref true
-
-let warn fmt =
- valid := false;
- Cil.warn fmt
-
-let warnContext fmt =
- valid := false;
- Cil.warnContext fmt
-
-let checkAttributes (attrs: attribute list) : unit =
- let rec loop lastname = function
- [] -> ()
- | Attr(an, _) :: resta ->
- if an < lastname then
- ignore (warn "Attributes not sorted");
- loop an resta
- in
- loop "" attrs
-
-
- (* Keep track of defined types *)
-let typeDefs : (string, typ) H.t = H.create 117
-
-
- (* Keep track of all variables names, enum tags and type names *)
-let varNamesEnv : (string, unit) H.t = H.create 117
-
- (* We also keep a map of variables indexed by id, to ensure that only one
- * varinfo has a given id *)
-let varIdsEnv: (int, varinfo) H.t = H.create 117
-
- (* And keep track of all varinfo's to check the uniqueness of the
- * identifiers *)
-let allVarIds: (int, varinfo) H.t = H.create 117
-
- (* Also keep a list of environments. We place an empty string in the list to
- * mark the start of a local environment (i.e. a function) *)
-let varNamesList : (string * int) list ref = ref []
-let defineName s =
- if s = "" then
- E.s (bug "Empty name\n");
- if H.mem varNamesEnv s then
- ignore (warn "Multiple definitions for %s\n" s);
- H.add varNamesEnv s ()
-
-let defineVariable vi =
- defineName vi.vname;
- varNamesList := (vi.vname, vi.vid) :: !varNamesList;
- (* Check the id *)
- if H.mem allVarIds vi.vid then
- ignore (warn "Id %d is already defined (%s)\n" vi.vid vi.vname);
- H.add allVarIds vi.vid vi;
- (* And register it in the current scope also *)
- H.add varIdsEnv vi.vid vi
-
-(* Check that a varinfo has already been registered *)
-let checkVariable vi =
- try
- (* Check in the current scope only *)
- if vi != H.find varIdsEnv vi.vid then
- ignore (warnContext "varinfos for %s not shared\n" vi.vname);
- with Not_found ->
- ignore (warn "Unknown id (%d) for %s\n" vi.vid vi.vname)
-
-
-let startEnv () =
- varNamesList := ("", -1) :: !varNamesList
-
-let endEnv () =
- let rec loop = function
- [] -> E.s (bug "Cannot find start of env")
- | ("", _) :: rest -> varNamesList := rest
- | (s, id) :: rest -> begin
- H.remove varNamesEnv s;
- H.remove varIdsEnv id;
- loop rest
- end
- in
- loop !varNamesList
-
-
-
-(* The current function being checked *)
-let currentReturnType : typ ref = ref voidType
-
-(* A map of labels in the current function *)
-let labels: (string, unit) H.t = H.create 17
-
-(* A list of statements seen in the current function *)
-let statements: stmt list ref = ref []
-
-(* A list of the targets of Gotos *)
-let gotoTargets: (string * stmt) list ref = ref []
-
-(*** TYPES ***)
-(* Cetain types can only occur in some contexts, so keep a list of context *)
-type ctxType =
- CTStruct (* In a composite type *)
- | CTUnion
- | CTFArg (* In a function argument type *)
- | CTFRes (* In a function result type *)
- | CTArray (* In an array type *)
- | CTPtr (* In a pointer type *)
- | CTExp (* In an expression, as the type of
- * the result of binary operators, or
- * in a cast *)
- | CTSizeof (* In a sizeof *)
- | CTDecl (* In a typedef, or a declaration *)
-
-let d_context () = function
- CTStruct -> text "CTStruct"
- | CTUnion -> text "CTUnion"
- | CTFArg -> text "CTFArg"
- | CTFRes -> text "CTFRes"
- | CTArray -> text "CTArray"
- | CTPtr -> text "CTPtr"
- | CTExp -> text "CTExp"
- | CTSizeof -> text "CTSizeof"
- | CTDecl -> text "CTDecl"
-
-
-(* Keep track of all tags that we use. For each tag remember also the info
- * structure and a flag whether it was actually defined or just used. A
- * forward declaration acts as a definition. *)
-type defuse =
- Defined (* We actually have seen a definition of this tag *)
- | Forward (* We have seen a forward declaration for it. This is done using
- * a GType with an empty type name *)
- | Used (* Only uses *)
-let compUsed : (int, compinfo * defuse ref) H.t = H.create 117
-let enumUsed : (string, enuminfo * defuse ref) H.t = H.create 117
-let typUsed : (string, typeinfo * defuse ref) H.t = H.create 117
-
-(* For composite types we also check that the names are unique *)
-let compNames : (string, unit) H.t = H.create 17
-
-
- (* Check a type *)
-let rec checkType (t: typ) (ctx: ctxType) =
- (* Check that it appears in the right context *)
- let rec checkContext = function
- TVoid _ -> ctx = CTPtr || ctx = CTFRes || ctx = CTDecl
- | TNamed (ti, a) -> checkContext ti.ttype
- | TArray _ ->
- (ctx = CTStruct || ctx = CTUnion
- || ctx = CTSizeof || ctx = CTDecl || ctx = CTArray || ctx = CTPtr)
- | TComp _ -> ctx <> CTExp
- | _ -> true
- in
- if not (checkContext t) then
- ignore (warn "Type (%a) used in wrong context. Expected context: %a"
- d_plaintype t d_context ctx);
- match t with
- (TVoid a | TBuiltin_va_list a) -> checkAttributes a
- | TInt (ik, a) -> checkAttributes a
- | TFloat (_, a) -> checkAttributes a
- | TPtr (t, a) -> checkAttributes a; checkType t CTPtr
-
- | TNamed (ti, a) ->
- checkAttributes a;
- if ti.tname = "" then
- ignore (warnContext "Using a typeinfo for an empty-named type\n");
- checkTypeInfo Used ti
-
- | TComp (comp, a) ->
- checkAttributes a;
- (* Mark it as a forward. We'll check it later. If we try to check it
- * now we might encounter undefined types *)
- checkCompInfo Used comp
-
-
- | TEnum (enum, a) -> begin
- checkAttributes a;
- checkEnumInfo Used enum
- end
-
- | TArray(bt, len, a) ->
- checkAttributes a;
- checkType bt CTArray;
- (match len with
- None -> ()
- | Some l -> begin
- let t = checkExp true l in
- match t with
- TInt((IInt|IUInt), _) -> ()
- | _ -> E.s (bug "Type of array length is not integer")
- end)
-
- | TFun (rt, targs, isva, a) ->
- checkAttributes a;
- checkType rt CTFRes;
- List.iter
- (fun (an, at, aa) ->
- checkType at CTFArg;
- checkAttributes aa) (argsToList targs)
-
-(* Check that a type is a promoted integral type *)
-and checkIntegralType (t: typ) =
- checkType t CTExp;
- match unrollType t with
- TInt _ -> ()
- | _ -> ignore (warn "Non-integral type")
-
-(* Check that a type is a promoted arithmetic type *)
-and checkArithmeticType (t: typ) =
- checkType t CTExp;
- match unrollType t with
- TInt _ | TFloat _ -> ()
- | _ -> ignore (warn "Non-arithmetic type")
-
-(* Check that a type is a promoted boolean type *)
-and checkBooleanType (t: typ) =
- checkType t CTExp;
- match unrollType t with
- TInt _ | TFloat _ | TPtr _ -> ()
- | _ -> ignore (warn "Non-boolean type")
-
-
-(* Check that a type is a pointer type *)
-and checkPointerType (t: typ) =
- checkType t CTExp;
- match unrollType t with
- TPtr _ -> ()
- | _ -> ignore (warn "Non-pointer type")
-
-
-and typeMatch (t1: typ) (t2: typ) =
- if typeSig t1 <> typeSig t2 then
- match unrollType t1, unrollType t2 with
- (* Allow free interchange of TInt and TEnum *)
- TInt (IInt, _), TEnum _ -> ()
- | TEnum _, TInt (IInt, _) -> ()
-
- | _, _ -> ignore (warn "Type mismatch:@! %a@!and %a@!"
- d_type t1 d_type t2)
-
-and checkCompInfo (isadef: defuse) comp =
- let fullname = compFullName comp in
- try
- let oldci, olddef = H.find compUsed comp.ckey in
- (* Check that it is the same *)
- if oldci != comp then
- ignore (warnContext "compinfo for %s not shared\n" fullname);
- (match !olddef, isadef with
- | Defined, Defined ->
- ignore (warnContext "Multiple definition of %s\n" fullname)
- | _, Defined -> olddef := Defined
- | Defined, _ -> ()
- | _, Forward -> olddef := Forward
- | _, _ -> ())
- with Not_found -> begin (* This is the first time we see it *)
- (* Check that the name is not empty *)
- if comp.cname = "" then
- E.s (bug "Compinfo with empty name");
- (* Check that the name is unique *)
- if H.mem compNames fullname then
- ignore (warn "Duplicate name %s" fullname);
- (* Add it to the map before we go on *)
- H.add compUsed comp.ckey (comp, ref isadef);
- H.add compNames fullname ();
- (* Do not check the compinfo unless this is a definition. Otherwise you
- * might run into undefined types. *)
- if isadef = Defined then begin
- checkAttributes comp.cattr;
- let fctx = if comp.cstruct then CTStruct else CTUnion in
- let rec checkField f =
- if not
- (f.fcomp == comp && (* Each field must share the self cell of
- * the host *)
- f.fname <> "") then
- ignore (warn "Self pointer not set in field %s of %s"
- f.fname fullname);
- checkType f.ftype fctx;
- (* Check the bitfields *)
- (match unrollType f.ftype, f.fbitfield with
- | TInt (ik, a), Some w ->
- checkAttributes a;
- if w < 0 || w >= bitsSizeOf (TInt(ik, a)) then
- ignore (warn "Wrong width (%d) in bitfield" w)
- | _, Some w ->
- ignore (E.error "Bitfield on a non integer type\n")
- | _ -> ());
- checkAttributes f.fattr
- in
- List.iter checkField comp.cfields
- end
- end
-
-
-and checkEnumInfo (isadef: defuse) enum =
- if enum.ename = "" then
- E.s (bug "Enuminfo with empty name");
- try
- let oldei, olddef = H.find enumUsed enum.ename in
- (* Check that it is the same *)
- if oldei != enum then
- ignore (warnContext "enuminfo for %s not shared\n" enum.ename);
- (match !olddef, isadef with
- Defined, Defined ->
- ignore (warnContext "Multiple definition of enum %s\n" enum.ename)
- | _, Defined -> olddef := Defined
- | Defined, _ -> ()
- | _, Forward -> olddef := Forward
- | _, _ -> ())
- with Not_found -> begin (* This is the first time we see it *)
- (* Add it to the map before we go on *)
- H.add enumUsed enum.ename (enum, ref isadef);
- checkAttributes enum.eattr;
- List.iter (fun (tn, _, _) -> defineName tn) enum.eitems;
- end
-
-and checkTypeInfo (isadef: defuse) ti =
- try
- let oldti, olddef = H.find typUsed ti.tname in
- (* Check that it is the same *)
- if oldti != ti then
- ignore (warnContext "typeinfo for %s not shared\n" ti.tname);
- (match !olddef, isadef with
- Defined, Defined ->
- ignore (warnContext "Multiple definition of type %s\n" ti.tname)
- | Defined, Used -> ()
- | Used, Defined ->
- ignore (warnContext "Use of type %s before its definition\n" ti.tname)
- | _, _ ->
- ignore (warnContext "Bug in checkTypeInfo for %s\n" ti.tname))
- with Not_found -> begin (* This is the first time we see it *)
- if ti.tname = "" then
- ignore (warnContext "typeinfo with empty name");
- checkType ti.ttype CTDecl;
- (* Add it to the map before we go on *)
- H.add typUsed ti.tname (ti, ref isadef);
- end
-
-(* Check an lvalue. If isconst then the lvalue appears in a context where
- * only a compile-time constant can appear. Return the type of the lvalue.
- * See the typing rule from cil.mli *)
-and checkLval (isconst: bool) (lv: lval) : typ =
- match lv with
- Var vi, off ->
- checkVariable vi;
- checkOffset vi.vtype off
-
- | Mem addr, off -> begin
- if isconst then
- ignore (warn "Memory operation in constant");
- let ta = checkExp false addr in
- match unrollType ta with
- TPtr (t, _) -> checkOffset t off
- | _ -> E.s (bug "Mem on a non-pointer")
- end
-
-(* Check an offset. The basetype is the type of the object referenced by the
- * base. Return the type of the lvalue constructed from a base value of right
- * type and the offset. See the typing rules from cil.mli *)
-and checkOffset basetyp : offset -> typ = function
- NoOffset -> basetyp
- | Index (ei, o) ->
- checkExpType false ei intType;
- begin
- match unrollType basetyp with
- TArray (t, _, _) -> checkOffset t o
- | t -> E.s (bug "typeOffset: Index on a non-array: %a" d_plaintype t)
- end
-
- | Field (fi, o) ->
- (* Now check that the host is shared propertly *)
- checkCompInfo Used fi.fcomp;
- (* Check that this exact field is part of the host *)
- if not (List.exists (fun f -> f == fi) fi.fcomp.cfields) then
- ignore (warn "Field %s not part of %s"
- fi.fname (compFullName fi.fcomp));
- checkOffset fi.ftype o
-
-and checkExpType (isconst: bool) (e: exp) (t: typ) =
- let t' = checkExp isconst e in (* compute the type *)
- if isconst then begin (* For initializers allow a string to initialize an
- * array of characters *)
- if typeSig t' <> typeSig t then
- match e, t with
- | _ -> typeMatch t' t
- end else
- typeMatch t' t
-
-(* Check an expression. isconst specifies if the expression occurs in a
- * context where only a compile-time constant can occur. Return the computed
- * type of the expression *)
-and checkExp (isconst: bool) (e: exp) : typ =
- E.withContext
- (fun _ -> dprintf "check%s: %a"
- (if isconst then "Const" else "Exp") d_exp e)
- (fun _ ->
- match e with
- | Const(CInt64 (_, ik, _)) -> TInt(ik, [])
- | Const(CChr _) -> charType
- | Const(CStr s) -> charPtrType
- | Const(CWStr s) -> TPtr(!wcharType,[])
- | Const(CReal (_, fk, _)) -> TFloat(fk, [])
- | Const(CEnum (_, _, ei)) -> TEnum(ei, [])
- | Lval(lv) ->
- if isconst then
- ignore (warn "Lval in constant");
- checkLval isconst lv
-
- | SizeOf(t) -> begin
- (* Sizeof cannot be applied to certain types *)
- checkType t CTSizeof;
- (match unrollType t with
- (TFun _ | TVoid _) ->
- ignore (warn "Invalid operand for sizeof")
- | _ ->());
- uintType
- end
- | SizeOfE(e) ->
- (* The expression in a sizeof can be anything *)
- let te = checkExp false e in
- checkExp isconst (SizeOf(te))
-
- | SizeOfStr s -> uintType
-
- | AlignOf(t) -> begin
- (* Sizeof cannot be applied to certain types *)
- checkType t CTSizeof;
- (match unrollType t with
- (TFun _ | TVoid _) ->
- ignore (warn "Invalid operand for sizeof")
- | _ ->());
- uintType
- end
- | AlignOfE(e) ->
- (* The expression in an AlignOfE can be anything *)
- let te = checkExp false e in
- checkExp isconst (AlignOf(te))
-
- | UnOp (Neg, e, tres) ->
- checkArithmeticType tres; checkExpType isconst e tres; tres
-
- | UnOp (BNot, e, tres) ->
- checkIntegralType tres; checkExpType isconst e tres; tres
-
- | UnOp (LNot, e, tres) ->
- let te = checkExp isconst e in
- checkBooleanType te;
- checkIntegralType tres; (* Must check that t is well-formed *)
- typeMatch tres intType;
- tres
-
- | BinOp (bop, e1, e2, tres) -> begin
- let t1 = checkExp isconst e1 in
- let t2 = checkExp isconst e2 in
- match bop with
- (Mult | Div) ->
- typeMatch t1 t2; checkArithmeticType tres;
- typeMatch t1 tres; tres
- | (Eq|Ne|Lt|Le|Ge|Gt) ->
- typeMatch t1 t2; checkArithmeticType t1;
- typeMatch tres intType; tres
- | Mod|BAnd|BOr|BXor ->
- typeMatch t1 t2; checkIntegralType tres;
- typeMatch t1 tres; tres
- | LAnd | LOr ->
- typeMatch t1 t2; checkBooleanType tres;
- typeMatch t1 tres; tres
- | Shiftlt | Shiftrt ->
- typeMatch t1 tres; checkIntegralType t1;
- checkIntegralType t2; tres
- | (PlusA | MinusA) ->
- typeMatch t1 t2; typeMatch t1 tres;
- checkArithmeticType tres; tres
- | (PlusPI | MinusPI | IndexPI) ->
- checkPointerType tres;
- typeMatch t1 tres;
- checkIntegralType t2;
- tres
- | MinusPP ->
- checkPointerType t1; checkPointerType t2;
- typeMatch t1 t2;
- typeMatch tres intType;
- tres
- end
- | AddrOf (lv) -> begin
- let tlv = checkLval isconst lv in
- (* Only certain types can be in AddrOf *)
- match unrollType tlv with
- | TVoid _ ->
- E.s (bug "AddrOf on improper type");
-
- | (TInt _ | TFloat _ | TPtr _ | TComp _ | TFun _ | TArray _ ) ->
- TPtr(tlv, [])
-
- | TEnum _ -> intPtrType
- | _ -> E.s (bug "AddrOf on unknown type")
- end
-
- | StartOf lv -> begin
- let tlv = checkLval isconst lv in
- match unrollType tlv with
- TArray (t,_, _) -> TPtr(t, [])
- | _ -> E.s (bug "StartOf on a non-array")
- end
-
- | CastE (tres, e) -> begin
- let et = checkExp isconst e in
- checkType tres CTExp;
- (* Not all types can be cast *)
- match unrollType et with
- TArray _ -> E.s (bug "Cast of an array type")
- | TFun _ -> E.s (bug "Cast of a function type")
- | TComp _ -> E.s (bug "Cast of a composite type")
- | TVoid _ -> E.s (bug "Cast of a void type")
- | _ -> tres
- end)
- () (* The argument of withContext *)
-
-and checkInit (i: init) : typ =
- E.withContext
- (fun _ -> dprintf "checkInit: %a" d_init i)
- (fun _ ->
- match i with
- SingleInit e -> checkExp true e
-(*
- | ArrayInit (bt, len, initl) -> begin
- checkType bt CTSizeof;
- if List.length initl > len then
- ignore (warn "Too many initializers in array");
- List.iter (fun i -> checkInitType i bt) initl;
- TArray(bt, Some (integer len), [])
- end
-*)
- | CompoundInit (ct, initl) -> begin
- checkType ct CTSizeof;
- (match unrollType ct with
- TArray(bt, Some (Const(CInt64(len, _, _))), _) ->
- let rec loopIndex i = function
- [] ->
- if i <> len then
- ignore (warn "Wrong number of initializers in array")
-
- | (Index(Const(CInt64(i', _, _)), NoOffset), ei) :: rest ->
- if i' <> i then
- ignore (warn "Initializer for index %s when %s was expected\n"
- (Int64.format "%d" i') (Int64.format "%d" i));
- checkInitType ei bt;
- loopIndex (Int64.succ i) rest
- | _ :: rest ->
- ignore (warn "Malformed initializer for array element")
- in
- loopIndex Int64.zero initl
- | TArray(_, _, _) ->
- ignore (warn "Malformed initializer for array")
- | TComp (comp, _) ->
- if comp.cstruct then
- let rec loopFields
- (nextflds: fieldinfo list)
- (initl: (offset * init) list) : unit =
- match nextflds, initl with
- [], [] -> () (* We are done *)
- | f :: restf, (Field(f', NoOffset), i) :: resti ->
- if f.fname <> f'.fname then
- ignore (warn "Expected initializer for field %s and found one for %s\n" f.fname f'.fname);
- checkInitType i f.ftype;
- loopFields restf resti
- | [], _ :: _ ->
- ignore (warn "Too many initializers for struct")
- | _ :: _, [] ->
- ignore (warn "Too few initializers for struct")
- | _, _ ->
- ignore (warn "Malformed initializer for struct")
- in
- loopFields
- (List.filter (fun f -> f.fname <> missingFieldName)
- comp.cfields)
- initl
-
- else (* UNION *)
- if comp.cfields == [] then begin
- if initl != [] then
- ignore (warn "Initializer for empty union not empty");
- end else begin
- match initl with
- [(Field(f, NoOffset), ei)] ->
- if f.fcomp != comp then
- ignore (bug "Wrong designator for union initializer");
- if !msvcMode && f != List.hd comp.cfields then
- ignore (warn "On MSVC you can only initialize the first field of a union");
- checkInitType ei f.ftype
-
- | _ ->
- ignore (warn "Malformed initializer for union")
- end
- | _ ->
- E.s (warn "Type of Compound is not array or struct or union"));
- ct
- end)
- () (* The arguments of withContext *)
-
-
-and checkInitType (i: init) (t: typ) : unit =
- let it = checkInit i in
- typeMatch it t
-
-and checkStmt (s: stmt) =
- E.withContext
- (fun _ ->
- (* Print context only for certain small statements *)
- match s.skind with
- (*Loop _*) While _ | DoWhile _ | For _ | If _ | Switch _ -> nil
- | _ -> dprintf "checkStmt: %a" d_stmt s)
- (fun _ ->
- (* Check the labels *)
- let checkLabel = function
- Label (ln, l, _) ->
- if H.mem labels ln then
- ignore (warn "Multiply defined label %s" ln);
- H.add labels ln ()
- | Case (e, _) -> checkExpType true e intType
- | _ -> () (* Not yet implemented *)
- in
- List.iter checkLabel s.labels;
- (* See if we have seen this statement before *)
- if List.memq s !statements then
- ignore (warn "Statement is shared");
- (* Remember that we have seen this one *)
- statements := s :: !statements;
- match s.skind with
- Break _ | Continue _ -> ()
- | Goto (gref, l) ->
- currentLoc := l;
- (* Find a label *)
- let lab =
- match List.filter (function Label _ -> true | _ -> false)
- !gref.labels with
- Label (lab, _, _) :: _ -> lab
- | _ ->
- ignore (warn "Goto to block without a label\n");
- "<missing label>"
- in
- (* Remember it as a target *)
- gotoTargets := (lab, !gref) :: !gotoTargets
-
-
- | Return (re,l) -> begin
- currentLoc := l;
- match re, !currentReturnType with
- None, TVoid _ -> ()
- | _, TVoid _ -> ignore (warn "Invalid return value")
- | None, _ -> ignore (warn "Invalid return value")
- | Some re', rt' -> checkExpType false re' rt'
- end
-(*
- | Loop (b, l, _, _) -> checkBlock b
-*)
- | While (e, b, l) ->
- currentLoc := l;
- let te = checkExp false e in
- checkBooleanType te;
- checkBlock b;
- | DoWhile (e, b, l) ->
- currentLoc := l;
- let te = checkExp false e in
- checkBooleanType te;
- checkBlock b;
- | For (bInit, e, bIter, b, l) ->
- currentLoc := l;
- checkBlock bInit;
- let te = checkExp false e in
- checkBooleanType te;
- checkBlock bIter;
- checkBlock b;
- | Block b -> checkBlock b
- | If (e, bt, bf, l) ->
- currentLoc := l;
- let te = checkExp false e in
- checkBooleanType te;
- checkBlock bt;
- checkBlock bf
- | Switch (e, b, cases, l) ->
- currentLoc := l;
- checkExpType false e intType;
- (* Remember the statements so far *)
- let prevStatements = !statements in
- checkBlock b;
- (* Now make sure that all the cases do occur in that block *)
- List.iter
- (fun c ->
- if not (List.exists (function Case _ -> true | _ -> false)
- c.labels) then
- ignore (warn "Case in switch statment without a \"case\"\n");
- (* Make sure it is in there *)
- let rec findCase = function
- | l when l == prevStatements -> (* Not found *)
- ignore (warnContext
- "Cannot find target of switch statement")
- | [] -> E.s (E.bug "Check: findCase")
- | c' :: rest when c == c' -> () (* Found *)
- | _ :: rest -> findCase rest
- in
- findCase !statements)
- cases;
- | TryFinally (b, h, l) ->
- currentLoc := l;
- checkBlock b;
- checkBlock h
-
- | TryExcept (b, (il, e), h, l) ->
- currentLoc := l;
- checkBlock b;
- List.iter checkInstr il;
- checkExpType false e intType;
- checkBlock h
-
- | Instr il -> List.iter checkInstr il)
- () (* argument of withContext *)
-
-and checkBlock (b: block) : unit =
- List.iter checkStmt b.bstmts
-
-
-and checkInstr (i: instr) =
- match i with
- | Set (dest, e, l) ->
- currentLoc := l;
- let t = checkLval false dest in
- (* Not all types can be assigned to *)
- (match unrollType t with
- TFun _ -> ignore (warn "Assignment to a function type")
- | TArray _ -> ignore (warn "Assignment to an array type")
- | TVoid _ -> ignore (warn "Assignment to a void type")
- | _ -> ());
- checkExpType false e t
-
- | Call(dest, what, args, l) ->
- currentLoc := l;
- let (rt, formals, isva) =
- match checkExp false what with
- TFun(rt, formals, isva, _) -> rt, formals, isva
- | _ -> E.s (bug "Call to a non-function")
- in
- (* Now check the return value*)
- (match dest, unrollType rt with
- None, TVoid _ -> ()
- | Some _, TVoid _ -> ignore (warn "void value is assigned")
- | None, _ -> () (* "Call of function is not assigned" *)
- | Some destlv, rt' ->
- let desttyp = checkLval false destlv in
- if typeSig desttyp <> typeSig rt then begin
- (* Not all types can be assigned to *)
- (match unrollType desttyp with
- TFun _ -> ignore (warn "Assignment to a function type")
- | TArray _ -> ignore (warn "Assignment to an array type")
- | TVoid _ -> ignore (warn "Assignment to a void type")
- | _ -> ());
- (* Not all types can be cast *)
- (match rt' with
- TArray _ -> ignore (warn "Cast of an array type")
- | TFun _ -> ignore (warn "Cast of a function type")
- | TComp _ -> ignore (warn "Cast of a composite type")
- | TVoid _ -> ignore (warn "Cast of a void type")
-
- | _ -> ())
- end);
- (* Now check the arguments *)
- let rec loopArgs formals args =
- match formals, args with
- [], _ when (isva || args = []) -> ()
- | (fn,ft,_) :: formals, a :: args ->
- checkExpType false a ft;
- loopArgs formals args
- | _, _ -> ignore (warn "Not enough arguments")
- in
- if formals = None then
- ignore (warn "Call to function without prototype\n")
- else
- loopArgs (argsToList formals) args
-
- | Asm _ -> () (* Not yet implemented *)
-
-let rec checkGlobal = function
- GAsm _ -> ()
- | GPragma _ -> ()
- | GText _ -> ()
- | GType (ti, l) ->
- currentLoc := l;
- E.withContext (fun _ -> dprintf "GType(%s)" ti.tname)
- (fun _ ->
- checkTypeInfo Defined ti;
- if ti.tname <> "" then defineName ti.tname)
- ()
-
- | GCompTag (comp, l) ->
- currentLoc := l;
- checkCompInfo Defined comp;
-
- | GCompTagDecl (comp, l) ->
- currentLoc := l;
- checkCompInfo Forward comp;
-
- | GEnumTag (enum, l) ->
- currentLoc := l;
- checkEnumInfo Defined enum
-
- | GEnumTagDecl (enum, l) ->
- currentLoc := l;
- checkEnumInfo Forward enum
-
- | GVarDecl (vi, l) ->
- currentLoc := l;
- (* We might have seen it already *)
- E.withContext (fun _ -> dprintf "GVarDecl(%s)" vi.vname)
- (fun _ ->
- (* If we have seen this vid already then it must be for the exact
- * same varinfo *)
- if H.mem varIdsEnv vi.vid then
- checkVariable vi
- else begin
- defineVariable vi;
- checkAttributes vi.vattr;
- checkType vi.vtype CTDecl;
- if not (vi.vglob &&
- vi.vstorage <> Register) then
- E.s (bug "Invalid declaration of %s" vi.vname)
- end)
- ()
-
- | GVar (vi, init, l) ->
- currentLoc := l;
- (* Maybe this is the first occurrence *)
- E.withContext (fun _ -> dprintf "GVar(%s)" vi.vname)
- (fun _ ->
- checkGlobal (GVarDecl (vi, l));
- (* Check the initializer *)
- begin match init.init with
- None -> ()
- | Some i -> ignore (checkInitType i vi.vtype)
- end;
- (* Cannot be a function *)
- if isFunctionType vi.vtype then
- E.s (bug "GVar for a function (%s)\n" vi.vname);
- )
- ()
-
-
- | GFun (fd, l) -> begin
- currentLoc := l;
- (* Check if this is the first occurrence *)
- let vi = fd.svar in
- let fname = vi.vname in
- E.withContext (fun _ -> dprintf "GFun(%s)" fname)
- (fun _ ->
- checkGlobal (GVarDecl (vi, l));
- (* Check that the argument types in the type are identical to the
- * formals *)
- let rec loopArgs targs formals =
- match targs, formals with
- [], [] -> ()
- | (fn, ft, fa) :: targs, fo :: formals ->
- if fn <> fo.vname || ft != fo.vtype || fa != fo.vattr then
- ignore (warnContext
- "Formal %s not shared (type + locals) in %s"
- fo.vname fname);
- loopArgs targs formals
-
- | _ ->
- E.s (bug "Type has different number of formals for %s"
- fname)
- in
- begin match vi.vtype with
- TFun (rt, args, isva, a) -> begin
- currentReturnType := rt;
- loopArgs (argsToList args) fd.sformals
- end
- | _ -> E.s (bug "Function %s does not have a function type"
- fname)
- end;
- ignore (fd.smaxid >= 0 || E.s (bug "smaxid < 0 for %s" fname));
- (* Now start a new environment, in a finally clause *)
- begin try
- startEnv ();
- (* Do the locals *)
- let doLocal tctx v =
- if v.vglob then
- ignore (warnContext
- "Local %s has the vglob flag set" v.vname);
- if v.vstorage <> NoStorage && v.vstorage <> Register then
- ignore (warnContext
- "Local %s has storage %a\n" v.vname
- d_storage v.vstorage);
- checkType v.vtype tctx;
- checkAttributes v.vattr;
- defineVariable v
- in
- List.iter (doLocal CTFArg) fd.sformals;
- List.iter (doLocal CTDecl) fd.slocals;
- statements := [];
- gotoTargets := [];
- checkBlock fd.sbody;
- H.clear labels;
- (* Now verify that we have scanned all targets *)
- List.iter
- (fun (lab, t) -> if not (List.memq t !statements) then
- ignore (warnContext
- "Target of \"goto %s\" statement does not appear in function body" lab))
- !gotoTargets;
- statements := [];
- gotoTargets := [];
- (* Done *)
- endEnv ()
- with e ->
- endEnv ();
- raise e
- end;
- ())
- () (* final argument of withContext *)
- end
-
-
-let checkFile flags fl =
- if !E.verboseFlag then ignore (E.log "Checking file %s\n" fl.fileName);
- valid := true;
- List.iter
- (function
- NoCheckGlobalIds -> checkGlobalIds := false)
- flags;
- iterGlobals fl (fun g -> try checkGlobal g with _ -> ());
- (* Check that for all struct/union tags there is a definition *)
- H.iter
- (fun k (comp, isadef) ->
- if !isadef = Used then
- begin
- valid := false;
- ignore (E.warn "Compinfo %s is referenced but not defined"
- (compFullName comp))
- end)
- compUsed;
- (* Check that for all enum tags there is a definition *)
- H.iter
- (fun k (enum, isadef) ->
- if !isadef = Used then
- begin
- valid := false;
- ignore (E.warn "Enuminfo %s is referenced but not defined"
- enum.ename)
- end)
- enumUsed;
- (* Clean the hashes to let the GC do its job *)
- H.clear typeDefs;
- H.clear varNamesEnv;
- H.clear varIdsEnv;
- H.clear allVarIds;
- H.clear compNames;
- H.clear compUsed;
- H.clear enumUsed;
- H.clear typUsed;
- varNamesList := [];
- if !E.verboseFlag then
- ignore (E.log "Finished checking file %s\n" fl.fileName);
- !valid
-
diff --git a/cil/src/check.mli b/cil/src/check.mli
deleted file mode 100644
index fdcb8b82cdd66a10116ac87e6b102c9a1329a1bc..0000000000000000000000000000000000000000
--- a/cil/src/check.mli
+++ /dev/null
@@ -1,45 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
- (* Checks the well-formedness of the file. Prints warnings and
- * returns false if errors are found *)
-
-type checkFlags =
- NoCheckGlobalIds (* Do not check that the global ids have the proper
- * hash value *)
-
-val checkFile: checkFlags list -> Cil.file -> bool
diff --git a/cil/src/cil.ml b/cil/src/cil.ml
deleted file mode 100644
index 2c4e12a713c5b9af341f3f046fabe60f098c118c..0000000000000000000000000000000000000000
--- a/cil/src/cil.ml
+++ /dev/null
@@ -1,6427 +0,0 @@
-(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-(* MODIF: useLogicalOperators flag set to true by default. *)
-
-(*
- *
- * Copyright (c) 2001-2003,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * Ben Liblit <liblit@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-open Escape
-open Pretty
-open Trace (* sm: 'trace' function *)
-module E = Errormsg
-module H = Hashtbl
-module IH = Inthash
-
-(*
- * CIL: An intermediate language for analyzing C progams.
- *
- * Version Tue Dec 12 15:21:52 PST 2000
- * Scott McPeak, George Necula, Wes Weimer
- *
- *)
-
-(* The module Cilversion is generated automatically by Makefile from
- * information in configure.in *)
-let cilVersion = Cilversion.cilVersion
-let cilVersionMajor = Cilversion.cilVersionMajor
-let cilVersionMinor = Cilversion.cilVersionMinor
-let cilVersionRevision = Cilversion.cilVersionRev
-
-(* A few globals that control the interpretation of C source *)
-let msvcMode = ref false (* Whether the pretty printer should
- * print output for the MS VC
- * compiler. Default is GCC *)
-
-let useLogicalOperators = ref (*false*) true
-
-
-module M = Machdep
-(* Cil.initCil will set this to the current machine description.
- Makefile.cil generates the file obj/@ARCHOS@/machdep.ml,
- which contains the descriptions of gcc and msvc. *)
-let theMachine : M.mach ref = ref M.gcc
-
-
-let lowerConstants: bool ref = ref true
- (** Do lower constants (default true) *)
-let insertImplicitCasts: bool ref = ref true
- (** Do insert implicit casts (default true) *)
-
-
-let little_endian = ref true
-let char_is_unsigned = ref false
-let underscore_name = ref false
-
-type lineDirectiveStyle =
- | LineComment
- | LinePreprocessorInput
- | LinePreprocessorOutput
-
-let lineDirectiveStyle = ref (Some LinePreprocessorInput)
-
-let print_CIL_Input = ref false
-
-let printCilAsIs = ref false
-
-let lineLength = ref 80
-
-(* sm: return the string 's' if we're printing output for gcc, suppres
- * it if we're printing for CIL to parse back in. the purpose is to
- * hide things from gcc that it complains about, but still be able
- * to do lossless transformations when CIL is the consumer *)
-let forgcc (s: string) : string =
- if (!print_CIL_Input) then "" else s
-
-
-let debugConstFold = false
-
-(** The Abstract Syntax of CIL *)
-
-
-(** The top-level representation of a CIL source file. Its main contents is
- the list of global declarations and definitions. *)
-type file =
- { mutable fileName: string; (** The complete file name *)
- mutable globals: global list; (** List of globals as they will appear
- in the printed file *)
- mutable globinit: fundec option;
- (** An optional global initializer function. This is a function where
- * you can put stuff that must be executed before the program is
- * started. This function, is conceptually at the end of the file,
- * although it is not part of the globals list. Use {!Cil.getGlobInit}
- * to create/get one. *)
- mutable globinitcalled: bool;
- (** Whether the global initialization function is called in main. This
- should always be false if there is no global initializer. When
- you create a global initialization CIL will try to insert code in
- main to call it. *)
- }
-
-and comment = location * string
-
-(** The main type for representing global declarations and definitions. A list
- of these form a CIL file. The order of globals in the file is generally
- important. *)
-and global =
- | GType of typeinfo * location
- (** A typedef. All uses of type names (through the [TNamed] constructor)
- must be preceeded in the file by a definition of the name. The string
- is the defined name and always not-empty. *)
-
- | GCompTag of compinfo * location
- (** Defines a struct/union tag with some fields. There must be one of
- these for each struct/union tag that you use (through the [TComp]
- constructor) since this is the only context in which the fields are
- printed. Consequently nested structure tag definitions must be
- broken into individual definitions with the innermost structure
- defined first. *)
-
- | GCompTagDecl of compinfo * location
- (** Declares a struct/union tag. Use as a forward declaration. This is
- * printed without the fields. *)
-
- | GEnumTag of enuminfo * location
- (** Declares an enumeration tag with some fields. There must be one of
- these for each enumeration tag that you use (through the [TEnum]
- constructor) since this is the only context in which the items are
- printed. *)
-
- | GEnumTagDecl of enuminfo * location
- (** Declares an enumeration tag. Use as a forward declaration. This is
- * printed without the items. *)
-
- | GVarDecl of varinfo * location
- (** A variable declaration (not a definition). If the variable has a
- function type then this is a prototype. There can be several
- declarations and at most one definition for a given variable. If both
- forms appear then they must share the same varinfo structure. A
- prototype shares the varinfo with the fundec of the definition. Either
- has storage Extern or there must be a definition in this file *)
-
- | GVar of varinfo * initinfo * location
- (** A variable definition. Can have an initializer. The initializer is
- * updateable so that you can change it without requiring to recreate
- * the list of globals. There can be at most one definition for a
- * variable in an entire program. Cannot have storage Extern or function
- * type. *)
-
-
- | GFun of fundec * location
- (** A function definition. *)
-
- | GAsm of string * location (** Global asm statement. These ones
- can contain only a template *)
- | GPragma of attribute * location (** Pragmas at top level. Use the same
- syntax as attributes *)
- | GText of string (** Some text (printed verbatim) at
- top level. E.g., this way you can
- put comments in the output. *)
-
-
-(** The various types available. Every type is associated with a list of
- * attributes, which are always kept in sorted order. Use {!Cil.addAttribute}
- * and {!Cil.addAttributes} to construct list of attributes. If you want to
- * inspect a type, you should use {!Cil.unrollType} to see through the uses
- * of named types. *)
-and typ =
- TVoid of attributes (** Void type *)
- | TInt of ikind * attributes (** An integer type. The kind specifies
- the sign and width. *)
- | TFloat of fkind * attributes (** A floating-point type. The kind
- specifies the precision. *)
-
- | TPtr of typ * attributes
- (** Pointer type. *)
-
- | TArray of typ * exp option * attributes
- (** Array type. It indicates the base type and the array length. *)
-
- | TFun of typ * (string * typ * attributes) list option * bool * attributes
- (** Function type. Indicates the type of the result, the name, type
- * and name attributes of the formal arguments ([None] if no
- * arguments were specified, as in a function whose definition or
- * prototype we have not seen; [Some \[\]] means void). Use
- * {!Cil.argsToList} to obtain a list of arguments. The boolean
- * indicates if it is a variable-argument function. If this is the
- * type of a varinfo for which we have a function declaration then
- * the information for the formals must match that in the
- * function's sformals. *)
-
- | TNamed of typeinfo * attributes
- (* The use of a named type. All uses of the same type name must
- * share the typeinfo. Each such type name must be preceeded
- * in the file by a [GType] global. This is printed as just the
- * type name. The actual referred type is not printed here and is
- * carried only to simplify processing. To see through a sequence
- * of named type references, use {!Cil.unrollType}. The attributes
- * are in addition to those given when the type name was defined. *)
-
- | TComp of compinfo * attributes
- (** A reference to a struct or a union type. All references to the
- same struct or union must share the same compinfo among them and
- with a [GCompTag] global that preceeds all uses (except maybe
- those that are pointers to the composite type). The attributes
- given are those pertaining to this use of the type and are in
- addition to the attributes that were given at the definition of
- the type and which are stored in the compinfo. *)
-
- | TEnum of enuminfo * attributes
- (** A reference to an enumeration type. All such references must
- share the enuminfo among them and with a [GEnumTag] global that
- preceeds all uses. The attributes refer to this use of the
- enumeration and are in addition to the attributes of the
- enumeration itself, which are stored inside the enuminfo *)
-
-
-
- | TBuiltin_va_list of attributes
- (** This is the same as the gcc's type with the same name *)
-
-(** Various kinds of integers *)
-and ikind =
- IChar (** [char] *)
- | ISChar (** [signed char] *)
- | IUChar (** [unsigned char] *)
- | IInt (** [int] *)
- | IUInt (** [unsigned int] *)
- | IShort (** [short] *)
- | IUShort (** [unsigned short] *)
- | ILong (** [long] *)
- | IULong (** [unsigned long] *)
- | ILongLong (** [long long] (or [_int64] on Microsoft Visual C) *)
- | IULongLong (** [unsigned long long] (or [unsigned _int64] on Microsoft
- Visual C) *)
-
-(** Various kinds of floating-point numbers*)
-and fkind =
- FFloat (** [float] *)
- | FDouble (** [double] *)
- | FLongDouble (** [long double] *)
-
-(** An attribute has a name and some optional parameters *)
-and attribute = Attr of string * attrparam list
-
-(** Attributes are lists sorted by the attribute name *)
-and attributes = attribute list
-
-(** The type of parameters in attributes *)
-and attrparam =
- | AInt of int (** An integer constant *)
- | AStr of string (** A string constant *)
- | ACons of string * attrparam list (** Constructed attributes. These
- are printed [foo(a1,a2,...,an)].
- The list of parameters can be
- empty and in that case the
- parentheses are not printed. *)
- | ASizeOf of typ (** A way to talk about types *)
- | ASizeOfE of attrparam
- | ASizeOfS of typsig (** Replacement for ASizeOf in type
- signatures. Only used for
- attributes inside typsigs.*)
- | AAlignOf of typ
- | AAlignOfE of attrparam
- | AAlignOfS of typsig
- | AUnOp of unop * attrparam
- | ABinOp of binop * attrparam * attrparam
- | ADot of attrparam * string (** a.foo **)
-
-
-(** Information about a composite type (a struct or a union). Use
- {!Cil.mkCompInfo}
- to create non-recursive or (potentially) recursive versions of this. Make
- sure you have a [GCompTag] for each one of these. *)
-and compinfo = {
- mutable cstruct: bool; (** True if struct, False if union *)
- mutable cname: string; (** The name. Always non-empty. Use
- * {!Cil.compFullName} to get the
- * full name of a comp (along with
- * the struct or union) *)
- mutable ckey: int; (** A unique integer constructed from
- * the name. Use {!Hashtbl.hash} on
- * the string returned by
- * {!Cil.compFullName}. All compinfo
- * for a given key are shared. *)
- mutable cfields: fieldinfo list; (** Information about the fields *)
- mutable cattr: attributes; (** The attributes that are defined at
- the same time as the composite
- type *)
- mutable cdefined: bool; (** Whether this is a defined
- * compinfo. *)
- mutable creferenced: bool; (** True if used. Initially set to
- * false *)
- }
-
-(** Information about a struct/union field *)
-and fieldinfo = {
- mutable fcomp: compinfo; (** The compinfo of the host. Note
- that this must be shared with the
- host since there can be only one
- compinfo for a given id *)
- mutable fname: string; (** The name of the field. Might be
- * the value of
- * {!Cil.missingFieldName} in which
- * case it must be a bitfield and is
- * not printed and it does not
- * participate in initialization *)
- mutable ftype: typ; (** The type *)
- mutable fbitfield: int option; (** If a bitfield then ftype should be
- an integer type *)
- mutable fattr: attributes; (** The attributes for this field
- * (not for its type) *)
- mutable floc: location; (** The location where this field
- * is defined *)
-}
-
-
-
-(** Information about an enumeration. This is shared by all references to an
- enumeration. Make sure you have a [GEnumTag] for each of of these. *)
-and enuminfo = {
- mutable ename: string; (** The name. Always non-empty *)
- mutable eitems: (string * exp * location) list; (** Items with names
- and values. This list
- should be
- non-empty. The item
- values must be
- compile-time
- constants. *)
- mutable eattr: attributes; (** Attributes *)
- mutable ereferenced: bool; (** True if used. Initially set to false*)
-}
-
-(** Information about a defined type *)
-and typeinfo = {
- mutable tname: string;
- (** The name. Can be empty only in a [GType] when introducing a composite
- * or enumeration tag. If empty cannot be refered to from the file *)
- mutable ttype: typ;
- (** The actual type. *)
- mutable treferenced: bool;
- (** True if used. Initially set to false*)
-}
-
-
-(** Information about a variable. These structures are shared by all
- * references to the variable. So, you can change the name easily, for
- * example. Use one of the {!Cil.makeLocalVar}, {!Cil.makeTempVar} or
- * {!Cil.makeGlobalVar} to create instances of this data structure. *)
-and varinfo = {
- mutable vname: string; (** The name of the variable. Cannot
- * be empty. *)
- mutable vtype: typ; (** The declared type of the
- * variable. *)
- mutable vattr: attributes; (** A list of attributes associated
- * with the variable. *)
- mutable vstorage: storage; (** The storage-class *)
- (* The other fields are not used in varinfo when they appear in the formal
- * argument list in a [TFun] type *)
-
-
- mutable vglob: bool; (** True if this is a global variable*)
-
- (** Whether this varinfo is for an inline function. *)
- mutable vinline: bool;
-
- mutable vdecl: location; (** Location of variable declaration *)
-
- mutable vid: int; (** A unique integer identifier. *)
- mutable vaddrof: bool; (** True if the address of this
- variable is taken. CIL will set
- * these flags when it parses C, but
- * you should make sure to set the
- * flag whenever your transformation
- * create [AddrOf] expression. *)
-
- mutable vreferenced: bool; (** True if this variable is ever
- referenced. This is computed by
- [removeUnusedVars]. It is safe to
- just initialize this to False *)
-}
-
-(** Storage-class information *)
-and storage =
- NoStorage | (** The default storage. Nothing is
- * printed *)
- Static |
- Register |
- Extern
-
-
-(** Expressions (Side-effect free)*)
-and exp =
- Const of constant (** Constant *)
- | Lval of lval (** Lvalue *)
- | SizeOf of typ (** sizeof(<type>). Has [unsigned
- * int] type (ISO 6.5.3.4). This is
- * not turned into a constant because
- * some transformations might want to
- * change types *)
-
- | SizeOfE of exp (** sizeof(<expression>) *)
- | SizeOfStr of string
- (** sizeof(string_literal). We separate this case out because this is the
- * only instance in which a string literal should not be treated as
- * having type pointer to character. *)
-
- | AlignOf of typ (** Has [unsigned int] type *)
- | AlignOfE of exp
-
-
- | UnOp of unop * exp * typ (** Unary operation. Includes
- the type of the result *)
-
- | BinOp of binop * exp * exp * typ
- (** Binary operation. Includes the
- type of the result. The arithemtic
- conversions are made explicit
- for the arguments *)
- | CastE of typ * exp (** Use {!Cil.mkCast} to make casts *)
-
- | AddrOf of lval (** Always use {!Cil.mkAddrOf} to
- * construct one of these. Apply to an
- * lvalue of type [T] yields an
- * expression of type [TPtr(T)] *)
-
- | StartOf of lval (** There is no C correspondent for this. C has
- * implicit coercions from an array to the address
- * of the first element. [StartOf] is used in CIL to
- * simplify type checking and is just an explicit
- * form of the above mentioned implicit conversion.
- * It is not printed. Given an lval of type
- * [TArray(T)] produces an expression of type
- * [TPtr(T)]. *)
-
-
-(** Literal constants *)
-and constant =
- | CInt64 of int64 * ikind * string option
- (** Integer constant. Give the ikind (see ISO9899 6.1.3.2)
- * and the textual representation, if available. Use
- * {!Cil.integer} or {!Cil.kinteger} to create these. Watch
- * out for integers that cannot be represented on 64 bits.
- * OCAML does not give Overflow exceptions. *)
- | CStr of string (** String constant (of pointer type) *)
- | CWStr of int64 list (** Wide string constant (of type "wchar_t *") *)
- | CChr of char (** Character constant. This has type int, so use
- * charConstToInt to read the value in case
- * sign-extension is needed. *)
- | CReal of float * fkind * string option (** Floating point constant. Give
- the fkind (see ISO 6.4.4.2) and
- also the textual representation,
- if available *)
- | CEnum of exp * string * enuminfo
- (** An enumeration constant with the given value, name, from the given
- * enuminfo. This is not used if {!Cil.lowerEnum} is false (default).
- * Use {!Cillower.lowerEnumVisitor} to replace these with integer
- * constants. *)
-
-(** Unary operators *)
-and unop =
- Neg (** Unary minus *)
- | BNot (** Bitwise complement (~) *)
- | LNot (** Logical Not (!) *)
-
-(** Binary operations *)
-and binop =
- PlusA (** arithmetic + *)
- | PlusPI (** pointer + integer *)
- | IndexPI (** pointer + integer but only when
- * it arises from an expression
- * [e\[i\]] when [e] is a pointer and
- * not an array. This is semantically
- * the same as PlusPI but CCured uses
- * this as a hint that the integer is
- * probably positive. *)
- | MinusA (** arithmetic - *)
- | MinusPI (** pointer - integer *)
- | MinusPP (** pointer - pointer *)
- | Mult (** * *)
- | Div (** / *)
- | Mod (** % *)
- | Shiftlt (** shift left *)
- | Shiftrt (** shift right *)
-
- | Lt (** < (arithmetic comparison) *)
- | Gt (** > (arithmetic comparison) *)
- | Le (** <= (arithmetic comparison) *)
- | Ge (** > (arithmetic comparison) *)
- | Eq (** == (arithmetic comparison) *)
- | Ne (** != (arithmetic comparison) *)
- | BAnd (** bitwise and *)
- | BXor (** exclusive-or *)
- | BOr (** inclusive-or *)
-
- | LAnd (** logical and *)
- | LOr (** logical or *)
-
-
-
-
-(** An lvalue denotes the contents of a range of memory addresses. This range
- * is denoted as a host object along with an offset within the object. The
- * host object can be of two kinds: a local or global variable, or an object
- * whose address is in a pointer expression. We distinguish the two cases so
- * that we can tell quickly whether we are accessing some component of a
- * variable directly or we are accessing a memory location through a pointer.*)
-and lval =
- lhost * offset
-
-(** The host part of an {!Cil.lval}. *)
-and lhost =
- | Var of varinfo
- (** The host is a variable. *)
-
- | Mem of exp
- (** The host is an object of type [T] when the expression has pointer
- * [TPtr(T)]. *)
-
-
-(** The offset part of an {!Cil.lval}. Each offset can be applied to certain
- * kinds of lvalues and its effect is that it advances the starting address
- * of the lvalue and changes the denoted type, essentially focussing to some
- * smaller lvalue that is contained in the original one. *)
-and offset =
- | NoOffset (** No offset. Can be applied to any lvalue and does
- * not change either the starting address or the type.
- * This is used when the lval consists of just a host
- * or as a terminator in a list of other kinds of
- * offsets. *)
-
- | Field of fieldinfo * offset
- (** A field offset. Can be applied only to an lvalue
- * that denotes a structure or a union that contains
- * the mentioned field. This advances the offset to the
- * beginning of the mentioned field and changes the
- * type to the type of the mentioned field. *)
-
- | Index of exp * offset
- (** An array index offset. Can be applied only to an
- * lvalue that denotes an array. This advances the
- * starting address of the lval to the beginning of the
- * mentioned array element and changes the denoted type
- * to be the type of the array element *)
-
-
-
-(* The following equivalences hold *)
-(* Mem(AddrOf(Mem a, aoff)), off = Mem a, aoff + off *)
-(* Mem(AddrOf(Var v, aoff)), off = Var v, aoff + off *)
-(* AddrOf (Mem a, NoOffset) = a *)
-
-(** Initializers for global variables. You can create an initializer with
- * {!Cil.makeZeroInit}. *)
-and init =
- | SingleInit of exp (** A single initializer *)
- | CompoundInit of typ * (offset * init) list
- (** Used only for initializers of structures, unions and arrays.
- * The offsets are all of the form [Field(f, NoOffset)] or
- * [Index(i, NoOffset)] and specify the field or the index being
- * initialized. For structures all fields
- * must have an initializer (except the unnamed bitfields), in
- * the proper order. This is necessary since the offsets are not
- * printed. For arrays the list must contain a prefix of the
- * initializers; the rest are 0-initialized.
- * For unions there must be exactly one initializer. If
- * the initializer is not for the first field then a field
- * designator is printed, so you better be on GCC since MSVC does
- * not understand this. You can scan an initializer list with
- * {!Cil.foldLeftCompound}. *)
-
-(** We want to be able to update an initializer in a global variable, so we
- * define it as a mutable field *)
-and initinfo = {
- mutable init : init option;
- }
-
-
-(** Function definitions. *)
-and fundec =
- { mutable svar: varinfo;
- (** Holds the name and type as a variable, so we can refer to it
- * easily from the program. All references to this function either
- * in a function call or in a prototype must point to the same
- * varinfo. *)
- mutable sformals: varinfo list;
- (** Formals. These must be shared with the formals that appear in the
- * type of the function. Use {!Cil.setFormals} or
- * {!Cil.setFunctionType} to set these
- * formals and ensure that they are reflected in the function type.
- * Do not make copies of these because the body refers to them. *)
- mutable slocals: varinfo list;
- (** Locals. Does not include the sformals. Do not make copies of
- * these because the body refers to them. *)
- mutable smaxid: int; (** Max local id. Starts at 0. *)
- mutable sbody: block; (** The function body. *)
- mutable smaxstmtid: int option; (** max id of a (reachable) statement
- * in this function, if we have
- * computed it. range = 0 ...
- * (smaxstmtid-1). This is computed by
- * {!Cil.computeCFGInfo}. *)
- mutable sallstmts: stmt list; (** After you call {!Cil.computeCFGInfo}
- * this field is set to contain all
- * statements in the function *)
- }
-
-
-(** A block is a sequence of statements with the control falling through from
- one element to the next *)
-and block =
- { mutable battrs: attributes; (** Attributes for the block *)
- mutable bstmts: stmt list; (** The statements comprising the block*)
- }
-
-
-(** Statements.
- The statement is the structural unit in the control flow graph. Use mkStmt
- to make a statement and then fill in the fields. *)
-and stmt = {
- mutable labels: label list; (** Whether the statement starts with
- some labels, case statements or
- default statement *)
- mutable skind: stmtkind; (** The kind of statement *)
-
- (* Now some additional control flow information. Initially this is not
- * filled in. *)
- mutable sid: int; (** A number (>= 0) that is unique
- in a function. *)
- mutable succs: stmt list; (** The successor statements. They can
- always be computed from the skind
- and the context in which this
- statement appears *)
- mutable preds: stmt list; (** The inverse of the succs function*)
- }
-
-(** Labels *)
-and label =
- Label of string * location * bool
- (** A real label. If the bool is "true", the label is from the
- * input source program. If the bool is "false", the label was
- * created by CIL or some other transformation *)
- | Case of exp * location (** A case statement *)
- | Default of location (** A default statement *)
-
-
-
-(* The various kinds of statements *)
-and stmtkind =
- | Instr of instr list (** A group of instructions that do not
- contain control flow. Control
- implicitly falls through. *)
- | Return of exp option * location (** The return statement. This is a
- leaf in the CFG. *)
-
- | Goto of stmt ref * location (** A goto statement. Appears from
- actual goto's in the code. *)
- | Break of location (** A break to the end of the nearest
- enclosing loop or Switch *)
- | Continue of location (** A continue to the start of the
- nearest enclosing loop *)
- | If of exp * block * block * location (** A conditional.
- Two successors, the "then" and
- the "else" branches. Both
- branches fall-through to the
- successor of the If statement *)
- | Switch of exp * block * (stmt list) * location
- (** A switch statement. The block
- contains within all of the cases.
- We also have direct pointers to the
- statements that implement the
- cases. Which cases they implement
- you can get from the labels of the
- statement *)
-
-(*
- | Loop of block * location * (stmt option) * (stmt option)
- (** A [while(1)] loop. The
- * termination test is implemented
- * in the body of a loop using a
- * [Break] statement. If
- * prepareCFG has been called, the
- * first stmt option will point to
- * the stmt containing the
- * continue label for this loop
- * and the second will point to
- * the stmt containing the break
- * label for this loop. *)
-*)
- | While of exp * block * location (** A while loop. *)
- | DoWhile of exp * block * location (** A do...while loop. *)
- | For of block * exp * block * block * location (** A for loop. *)
-
- | Block of block (** Just a block of statements. Use it
- as a way to keep some attributes
- local *)
- (** On MSVC we support structured exception handling. This is what you
- * might expect. Control can get into the finally block either from the
- * end of the body block, or if an exception is thrown. The location
- * corresponds to the try keyword. *)
- | TryFinally of block * block * location
-
- (** On MSVC we support structured exception handling. The try/except
- * statement is a bit tricky:
- __try { blk }
- __except (e) {
- handler
- }
-
- The argument to __except must be an expression. However, we keep a
- list of instructions AND an expression in case you need to make
- function calls. We'll print those as a comma expression. The control
- can get to the __except expression only if an exception is thrown.
- After that, depending on the value of the expression the control
- goes to the handler, propagates the exception, or retries the
- exception !!! The location corresponds to the try keyword.
- *)
- | TryExcept of block * (instr list * exp) * block * location
-
-
-(** Instructions. They may cause effects directly but may not have control
- flow.*)
-and instr =
- Set of lval * exp * location (** An assignment. A cast is present
- if the exp has different type
- from lval *)
- | Call of lval option * exp * exp list * location
- (** optional: result is an lval. A cast might be
- necessary if the declared result type of the
- function is not the same as that of the
- destination. If the function is declared then
- casts are inserted for those arguments that
- correspond to declared formals. (The actual
- number of arguments might be smaller or larger
- than the declared number of arguments. C allows
- this.) If the type of the result variable is not
- the same as the declared type of the function
- result then an implicit cast exists. *)
-
- (* See the GCC specification for the meaning of ASM.
- * If the source is MS VC then only the templates
- * are used *)
- (* sm: I've added a notes.txt file which contains more
- * information on interpreting Asm instructions *)
- | Asm of attributes * (* Really only const and volatile can appear
- * here *)
- string list * (* templates (CR-separated) *)
- (string * lval) list * (* outputs must be lvals with
- * constraints. I would like these
- * to be actually variables, but I
- * run into some trouble with ASMs
- * in the Linux sources *)
- (string * exp) list * (* inputs with constraints *)
- string list * (* register clobbers *)
- location
- (** An inline assembly instruction. The arguments are (1) a list of
- attributes (only const and volatile can appear here and only for
- GCC), (2) templates (CR-separated), (3) a list of
- outputs, each of which is an lvalue with a constraint, (4) a list
- of input expressions along with constraints, (5) clobbered
- registers, and (5) location information *)
-
-
-
-(** Describes a location in a source file *)
-and location = {
- line: int; (** The line number. -1 means "do not know" *)
- file: string; (** The name of the source file*)
- byte: int; (** The byte position in the source file *)
-}
-
-(* Type signatures. Two types are identical iff they have identical
- * signatures *)
-and typsig =
- TSArray of typsig * int64 option * attribute list
- | TSPtr of typsig * attribute list
- | TSComp of bool * string * attribute list
- | TSFun of typsig * typsig list * bool * attribute list
- | TSEnum of string * attribute list
- | TSBase of typ
-
-
-
-(** To be able to add/remove features easily, each feature should be package
- * as an interface with the following interface. These features should be *)
-type featureDescr = {
- fd_enabled: bool ref;
- (** The enable flag. Set to default value *)
-
- fd_name: string;
- (** This is used to construct an option "--doxxx" and "--dontxxx" that
- * enable and disable the feature *)
-
- fd_description: string;
- (* A longer name that can be used to document the new options *)
-
- fd_extraopt: (string * Arg.spec * string) list;
- (** Additional command line options *)
-
- fd_doit: (file -> unit);
- (** This performs the transformation *)
-
- fd_post_check: bool;
- (* Whether to perform a CIL consistency checking after this stage, if
- * checking is enabled (--check is passed to cilly) *)
-}
-
-let locUnknown = { line = -1;
- file = "";
- byte = -1;}
-
-(* A reference to the current location *)
-let currentLoc : location ref = ref locUnknown
-
-(* A reference to the current global being visited *)
-let currentGlobal: global ref = ref (GText "dummy")
-
-
-let compareLoc (a: location) (b: location) : int =
- let namecmp = compare a.file b.file in
- if namecmp != 0
- then namecmp
- else
- let linecmp = a.line - b.line in
- if linecmp != 0
- then linecmp
- else a.byte - b.byte
-
-let argsToList : (string * typ * attributes) list option
- -> (string * typ * attributes) list
- = function
- None -> []
- | Some al -> al
-
-
-(* A hack to allow forward reference of d_exp *)
-let pd_exp : (unit -> exp -> doc) ref =
- ref (fun _ -> E.s (E.bug "pd_exp not initialized"))
-
-(** Different visiting actions. 'a will be instantiated with [exp], [instr],
- etc. *)
-type 'a visitAction =
- SkipChildren (** Do not visit the children. Return
- the node as it is. *)
- | DoChildren (** Continue with the children of this
- node. Rebuild the node on return
- if any of the children changes
- (use == test) *)
- | ChangeTo of 'a (** Replace the expression with the
- given one *)
- | ChangeDoChildrenPost of 'a * ('a -> 'a) (** First consider that the entire
- exp is replaced by the first
- parameter. Then continue with
- the children. On return rebuild
- the node if any of the children
- has changed and then apply the
- function on the node *)
-
-
-
-(* sm/gn: cil visitor interface for traversing Cil trees. *)
-(* Use visitCilStmt and/or visitCilFile to use this. *)
-(* Some of the nodes are changed in place if the children are changed. Use
- * one of Change... actions if you want to copy the node *)
-
-(** A visitor interface for traversing CIL trees. Create instantiations of
- * this type by specializing the class {!Cil.nopCilVisitor}. *)
-class type cilVisitor = object
-
- method vvdec: varinfo -> varinfo visitAction
- (** Invoked for each variable declaration. The subtrees to be traversed
- * are those corresponding to the type and attributes of the variable.
- * Note that variable declarations are all the [GVar], [GVarDecl], [GFun],
- * all the [varinfo] in formals of function types, and the formals and
- * locals for function definitions. This means that the list of formals
- * in a function definition will be traversed twice, once as part of the
- * function type and second as part of the formals in a function
- * definition. *)
-
- method vvrbl: varinfo -> varinfo visitAction
- (** Invoked on each variable use. Here only the [SkipChildren] and
- * [ChangeTo] actions make sense since there are no subtrees. Note that
- * the type and attributes of the variable are not traversed for a
- * variable use *)
-
- method vexpr: exp -> exp visitAction
- (** Invoked on each expression occurence. The subtrees are the
- * subexpressions, the types (for a [Cast] or [SizeOf] expression) or the
- * variable use. *)
-
- method vlval: lval -> lval visitAction
- (** Invoked on each lvalue occurence *)
-
- method voffs: offset -> offset visitAction
- (** Invoked on each offset occurrence that is *not* as part
- * of an initializer list specification, i.e. in an lval or
- * recursively inside an offset. *)
-
- method vinitoffs: offset -> offset visitAction
- (** Invoked on each offset appearing in the list of a
- * CompoundInit initializer. *)
-
- method vinst: instr -> instr list visitAction
- (** Invoked on each instruction occurrence. The [ChangeTo] action can
- * replace this instruction with a list of instructions *)
-
- method vstmt: stmt -> stmt visitAction
- (** Control-flow statement. *)
-
- method vblock: block -> block visitAction (** Block. Replaced in
- place. *)
- method vfunc: fundec -> fundec visitAction (** Function definition.
- Replaced in place. *)
- method vglob: global -> global list visitAction (** Global (vars, types,
- etc.) *)
- method vinit: init -> init visitAction (** Initializers for globals *)
- method vtype: typ -> typ visitAction (** Use of some type. Note
- * that for structure/union
- * and enumeration types the
- * definition of the
- * composite type is not
- * visited. Use [vglob] to
- * visit it. *)
- method vattr: attribute -> attribute list visitAction
- (** Attribute. Each attribute can be replaced by a list *)
- method vattrparam: attrparam -> attrparam visitAction
- (** Attribute parameters. *)
-
- (** Add here instructions while visiting to queue them to
- * preceede the current statement or instruction being processed *)
- method queueInstr: instr list -> unit
-
- (** Gets the queue of instructions and resets the queue *)
- method unqueueInstr: unit -> instr list
-
-end
-
-(* the default visitor does nothing at each node, but does *)
-(* not stop; hence they return true *)
-class nopCilVisitor : cilVisitor = object
- method vvrbl (v:varinfo) = DoChildren (* variable *)
- method vvdec (v:varinfo) = DoChildren (* variable
- * declaration *)
- method vexpr (e:exp) = DoChildren (* expression *)
- method vlval (l:lval) = DoChildren (* lval (base is 1st
- * field) *)
- method voffs (o:offset) = DoChildren (* lval or recursive offset *)
- method vinitoffs (o:offset) = DoChildren (* initializer offset *)
- method vinst (i:instr) = DoChildren (* imperative instruction *)
- method vstmt (s:stmt) = DoChildren (* constrol-flow statement *)
- method vblock (b: block) = DoChildren
- method vfunc (f:fundec) = DoChildren (* function definition *)
- method vglob (g:global) = DoChildren (* global (vars, types, etc.) *)
- method vinit (i:init) = DoChildren (* global initializers *)
- method vtype (t:typ) = DoChildren (* use of some type *)
- method vattr (a: attribute) = DoChildren
- method vattrparam (a: attrparam) = DoChildren
-
- val mutable instrQueue = []
-
- method queueInstr (il: instr list) =
- List.iter (fun i -> instrQueue <- i :: instrQueue) il
-
- method unqueueInstr () =
- let res = List.rev instrQueue in
- instrQueue <- [];
- res
-
-end
-
-let assertEmptyQueue vis =
- if vis#unqueueInstr () <> [] then
- (* Either a visitor inserted an instruction somewhere that it shouldn't
- have (i.e. at the top level rather than inside of a statement), or
- there's a bug in the visitor engine. *)
- E.s (E.bug "Visitor's instruction queue is not empty.\n You should only use queueInstr inside a function body!");
- ()
-
-
-let lu = locUnknown
-
-(* sm: utility *)
-let startsWith (prefix: string) (s: string) : bool =
-(
- let prefixLen = (String.length prefix) in
- (String.length s) >= prefixLen &&
- (String.sub s 0 prefixLen) = prefix
-)
-
-
-let get_instrLoc (inst : instr) =
- match inst with
- Set(_, _, loc) -> loc
- | Call(_, _, _, loc) -> loc
- | Asm(_, _, _, _, _, loc) -> loc
-let get_globalLoc (g : global) =
- match g with
- | GFun(_,l) -> (l)
- | GType(_,l) -> (l)
- | GEnumTag(_,l) -> (l)
- | GEnumTagDecl(_,l) -> (l)
- | GCompTag(_,l) -> (l)
- | GCompTagDecl(_,l) -> (l)
- | GVarDecl(_,l) -> (l)
- | GVar(_,_,l) -> (l)
- | GAsm(_,l) -> (l)
- | GPragma(_,l) -> (l)
- | GText(_) -> locUnknown
-
-let rec get_stmtLoc (statement : stmtkind) =
- match statement with
- Instr([]) -> lu
- | Instr(hd::tl) -> get_instrLoc(hd)
- | Return(_, loc) -> loc
- | Goto(_, loc) -> loc
- | Break(loc) -> loc
- | Continue(loc) -> loc
- | If(_, _, _, loc) -> loc
- | Switch (_, _, _, loc) -> loc
-(*
- | Loop (_, loc, _, _) -> loc
-*)
- | While (_, _, loc) -> loc
- | DoWhile (_, _, loc) -> loc
- | For (_, _, _, _, loc) -> loc
- | Block b -> if b.bstmts == [] then lu
- else get_stmtLoc ((List.hd b.bstmts).skind)
- | TryFinally (_, _, l) -> l
- | TryExcept (_, _, _, l) -> l
-
-
-(* The next variable identifier to use. Counts up *)
-let nextGlobalVID = ref 1
-
-(* The next compindo identifier to use. Counts up. *)
-let nextCompinfoKey = ref 1
-
-(* Some error reporting functions *)
-let d_loc (_: unit) (loc: location) : doc =
- text loc.file ++ chr ':' ++ num loc.line
-
-let d_thisloc (_: unit) : doc = d_loc () !currentLoc
-
-let error (fmt : ('a,unit,doc) format) : 'a =
- let f d =
- E.hadErrors := true;
- ignore (eprintf "@!%t: Error: %a@!"
- d_thisloc insert d);
- nil
- in
- Pretty.gprintf f fmt
-
-let unimp (fmt : ('a,unit,doc) format) : 'a =
- let f d =
- E.hadErrors := true;
- ignore (eprintf "@!%t: Unimplemented: %a@!"
- d_thisloc insert d);
- nil
- in
- Pretty.gprintf f fmt
-
-let bug (fmt : ('a,unit,doc) format) : 'a =
- let f d =
- E.hadErrors := true;
- ignore (eprintf "@!%t: Bug: %a@!"
- d_thisloc insert d);
- E.showContext ();
- nil
- in
- Pretty.gprintf f fmt
-
-let errorLoc (loc: location) (fmt : ('a,unit,doc) format) : 'a =
- let f d =
- E.hadErrors := true;
- ignore (eprintf "@!%a: Error: %a@!"
- d_loc loc insert d);
- E.showContext ();
- nil
- in
- Pretty.gprintf f fmt
-
-let warn (fmt : ('a,unit,doc) format) : 'a =
- let f d =
- ignore (eprintf "@!%t: Warning: %a@!"
- d_thisloc insert d);
- nil
- in
- Pretty.gprintf f fmt
-
-
-let warnOpt (fmt : ('a,unit,doc) format) : 'a =
- let f d =
- if !E.warnFlag then
- ignore (eprintf "@!%t: Warning: %a@!"
- d_thisloc insert d);
- nil
- in
- Pretty.gprintf f fmt
-
-let warnContext (fmt : ('a,unit,doc) format) : 'a =
- let f d =
- ignore (eprintf "@!%t: Warning: %a@!"
- d_thisloc insert d);
- E.showContext ();
- nil
- in
- Pretty.gprintf f fmt
-
-let warnContextOpt (fmt : ('a,unit,doc) format) : 'a =
- let f d =
- if !E.warnFlag then
- ignore (eprintf "@!%t: Warning: %a@!"
- d_thisloc insert d);
- E.showContext ();
- nil
- in
- Pretty.gprintf f fmt
-
-let warnLoc (loc: location) (fmt : ('a,unit,doc) format) : 'a =
- let f d =
- ignore (eprintf "@!%a: Warning: %a@!"
- d_loc loc insert d);
- E.showContext ();
- nil
- in
- Pretty.gprintf f fmt
-
-
-
-(* Construct an integer. Use only for values that fit on 31 bits.
- For larger values, use kinteger *)
-let integer (i: int) = Const (CInt64(Int64.of_int i, IInt, None))
-
-let zero = integer 0
-let one = integer 1
-let mone = integer (-1)
-
-(** Given the character c in a (CChr c), sign-extend it to 32 bits.
- (This is the official way of interpreting character constants, according to
- ISO C 6.4.4.4.10, which says that character constants are chars cast to ints)
- Returns CInt64(sign-extened c, IInt, None) *)
-let charConstToInt (c: char) : constant =
- let c' = Char.code c in
- let value =
- if c' < 128
- then Int64.of_int c'
- else Int64.of_int (c' - 256)
- in
- CInt64(value, IInt, None)
-
-
-let rec isInteger = function
- | Const(CInt64 (n,_,_)) -> Some n
- | Const(CChr c) -> isInteger (Const (charConstToInt c)) (* sign-extend *)
- | Const(CEnum(v, s, ei)) -> isInteger v
- | CastE(_, e) -> isInteger e
- | _ -> None
-
-
-
-let rec isZero (e: exp) : bool = isInteger e = Some Int64.zero
-
-let voidType = TVoid([])
-let intType = TInt(IInt,[])
-let uintType = TInt(IUInt,[])
-let longType = TInt(ILong,[])
-let ulongType = TInt(IULong,[])
-let charType = TInt(IChar, [])
-
-let charPtrType = TPtr(charType,[])
-let charConstPtrType = TPtr(TInt(IChar, [Attr("const", [])]),[])
-let stringLiteralType = ref charPtrType
-
-let voidPtrType = TPtr(voidType, [])
-let intPtrType = TPtr(intType, [])
-let uintPtrType = TPtr(uintType, [])
-
-let doubleType = TFloat(FDouble, [])
-
-
-(* An integer type that fits pointers. Initialized by initCIL *)
-let upointType = ref voidType
-
-(* An integer type that fits wchar_t. Initialized by initCIL *)
-let wcharKind = ref IChar
-let wcharType = ref voidType
-
-
-(* An integer type that is the type of sizeof. Initialized by initCIL *)
-let typeOfSizeOf = ref voidType
-let kindOfSizeOf = ref IUInt
-
-let initCIL_called = ref false
-
-(** Returns true if and only if the given integer type is signed. *)
-let isSigned = function
- | IUChar
- | IUShort
- | IUInt
- | IULong
- | IULongLong ->
- false
- | ISChar
- | IShort
- | IInt
- | ILong
- | ILongLong ->
- true
- | IChar ->
- not !theMachine.M.char_is_unsigned
-
-let mkStmt (sk: stmtkind) : stmt =
- { skind = sk;
- labels = [];
- sid = -1; succs = []; preds = [] }
-
-let mkBlock (slst: stmt list) : block =
- { battrs = []; bstmts = slst; }
-
-let mkEmptyStmt () = mkStmt (Instr [])
-let mkStmtOneInstr (i: instr) = mkStmt (Instr [i])
-
-let dummyInstr = (Asm([], ["dummy statement!!"], [], [], [], lu))
-let dummyStmt = mkStmt (Instr [dummyInstr])
-
-let compactStmts (b: stmt list) : stmt list =
- (* Try to compress statements. Scan the list of statements and remember
- * the last instrunction statement encountered, along with a Clist of
- * instructions in it. *)
- let rec compress (lastinstrstmt: stmt) (* Might be dummStmt *)
- (lastinstrs: instr Clist.clist)
- (body: stmt list) =
- let finishLast (tail: stmt list) : stmt list =
- if lastinstrstmt == dummyStmt then tail
- else begin
- lastinstrstmt.skind <- Instr (Clist.toList lastinstrs);
- lastinstrstmt :: tail
- end
- in
- match body with
- [] -> finishLast []
- | ({skind=Instr il} as s) :: rest ->
- let ils = Clist.fromList il in
- if lastinstrstmt != dummyStmt && s.labels == [] then
- compress lastinstrstmt (Clist.append lastinstrs ils) rest
- else
- finishLast (compress s ils rest)
-
- | s :: rest ->
- let res = s :: compress dummyStmt Clist.empty rest in
- finishLast res
- in
- compress dummyStmt Clist.empty b
-
-
-(** Construct sorted lists of attributes ***)
-let rec addAttribute (Attr(an, _) as a: attribute) (al: attributes) =
- let rec insertSorted = function
- [] -> [a]
- | ((Attr(an0, _) as a0) :: rest) as l ->
- if an < an0 then a :: l
- else if Util.equals a a0 then l (* Do not add if already in there *)
- else a0 :: insertSorted rest (* Make sure we see all attributes with
- * this name *)
- in
- insertSorted al
-
-(** The second attribute list is sorted *)
-and addAttributes al0 (al: attributes) : attributes =
- if al0 == [] then al else
- List.fold_left (fun acc a -> addAttribute a acc) al al0
-
-and dropAttribute (an: string) (al: attributes) =
- List.filter (fun (Attr(an', _)) -> an <> an') al
-
-and dropAttributes (anl: string list) (al: attributes) =
- List.fold_left (fun acc an -> dropAttribute an acc) al anl
-
-and filterAttributes (s: string) (al: attribute list) : attribute list =
- List.filter (fun (Attr(an, _)) -> an = s) al
-
-(* sm: *)
-let hasAttribute s al =
- (filterAttributes s al <> [])
-
-
-type attributeClass =
- AttrName of bool
- (* Attribute of a name. If argument is true and we are on MSVC then
- * the attribute is printed using __declspec as part of the storage
- * specifier *)
- | AttrFunType of bool
- (* Attribute of a function type. If argument is true and we are on
- * MSVC then the attribute is printed just before the function name *)
-
- | AttrType (* Attribute of a type *)
-
-(* This table contains the mapping of predefined attributes to classes.
- * Extend this table with more attributes as you need. This table is used to
- * determine how to associate attributes with names or type during cabs2cil
- * conversion *)
-let attributeHash: (string, attributeClass) H.t =
- let table = H.create 13 in
- List.iter (fun a -> H.add table a (AttrName false))
- [ "section"; "constructor"; "destructor"; "unused"; "used"; "weak";
- "no_instrument_function"; "alias"; "no_check_memory_usage";
- "exception"; "model"; (* "restrict"; *)
- "aconst"; "__asm__" (* Gcc uses this to specifiy the name to be used in
- * assembly for a global *)];
-
- (* Now come the MSVC declspec attributes *)
- List.iter (fun a -> H.add table a (AttrName true))
- [ "thread"; "naked"; "dllimport"; "dllexport";
- "selectany"; "allocate"; "nothrow"; "novtable"; "property"; "noreturn";
- "uuid"; "align" ];
-
- List.iter (fun a -> H.add table a (AttrFunType false))
- [ "format"; "regparm"; "longcall";
- "noinline"; "always_inline"; ];
-
- List.iter (fun a -> H.add table a (AttrFunType true))
- [ "stdcall";"cdecl"; "fastcall" ];
-
- List.iter (fun a -> H.add table a AttrType)
- [ "const"; "volatile"; "restrict"; "mode" ];
- table
-
-
-(* Partition the attributes into classes *)
-let partitionAttributes
- ~(default:attributeClass)
- (attrs: attribute list) :
- attribute list * attribute list * attribute list =
- let rec loop (n,f,t) = function
- [] -> n, f, t
- | (Attr(an, _) as a) :: rest ->
- match (try H.find attributeHash an with Not_found -> default) with
- AttrName _ -> loop (addAttribute a n, f, t) rest
- | AttrFunType _ ->
- loop (n, addAttribute a f, t) rest
- | AttrType -> loop (n, f, addAttribute a t) rest
- in
- loop ([], [], []) attrs
-
-
-(* Get the full name of a comp *)
-let compFullName comp =
- (if comp.cstruct then "struct " else "union ") ^ comp.cname
-
-
-let missingFieldName = "___missing_field_name"
-
-(** Creates a a (potentially recursive) composite type. Make sure you add a
- * GTag for it to the file! **)
-let mkCompInfo
- (isstruct: bool)
- (n: string)
- (* fspec is a function that when given a forward
- * representation of the structure type constructs the type of
- * the fields. The function can ignore this argument if not
- * constructing a recursive type. *)
- (mkfspec: compinfo -> (string * typ * int option * attribute list *
- location) list)
- (a: attribute list) : compinfo =
-
- (* make an new name for anonymous structs *)
- if n = "" then
- E.s (E.bug "mkCompInfo: missing structure name\n");
- (* Make a new self cell and a forward reference *)
- let comp =
- { cstruct = isstruct; cname = ""; ckey = 0; cfields = [];
- cattr = a; creferenced = false;
- (* Make this compinfo undefined by default *)
- cdefined = false; }
- in
- comp.cname <- n;
- comp.ckey <- !nextCompinfoKey;
- incr nextCompinfoKey;
- let flds =
- List.map (fun (fn, ft, fb, fa, fl) ->
- { fcomp = comp;
- ftype = ft;
- fname = fn;
- fbitfield = fb;
- fattr = fa;
- floc = fl}) (mkfspec comp) in
- comp.cfields <- flds;
- if flds <> [] then comp.cdefined <- true;
- comp
-
-(** Make a copy of a compinfo, changing the name and the key *)
-let copyCompInfo (ci: compinfo) (n: string) : compinfo =
- let ci' = {ci with cname = n;
- ckey = !nextCompinfoKey; } in
- incr nextCompinfoKey;
- (* Copy the fields and set the new pointers to parents *)
- ci'.cfields <- List.map (fun f -> {f with fcomp = ci'}) ci'.cfields;
- ci'
-
-(**** Utility functions ******)
-
-let rec typeAttrs = function
- TVoid a -> a
- | TInt (_, a) -> a
- | TFloat (_, a) -> a
- | TNamed (t, a) -> addAttributes a (typeAttrs t.ttype)
- | TPtr (_, a) -> a
- | TArray (_, _, a) -> a
- | TComp (comp, a) -> addAttributes comp.cattr a
- | TEnum (enum, a) -> addAttributes enum.eattr a
- | TFun (_, _, _, a) -> a
- | TBuiltin_va_list a -> a
-
-
-let setTypeAttrs t a =
- match t with
- TVoid _ -> TVoid a
- | TInt (i, _) -> TInt (i, a)
- | TFloat (f, _) -> TFloat (f, a)
- | TNamed (t, _) -> TNamed(t, a)
- | TPtr (t', _) -> TPtr(t', a)
- | TArray (t', l, _) -> TArray(t', l, a)
- | TComp (comp, _) -> TComp (comp, a)
- | TEnum (enum, _) -> TEnum (enum, a)
- | TFun (r, args, v, _) -> TFun(r,args,v,a)
- | TBuiltin_va_list _ -> TBuiltin_va_list a
-
-
-let typeAddAttributes a0 t =
-begin
- match a0 with
- | [] ->
- (* no attributes, keep same type *)
- t
- | _ ->
- (* anything else: add a0 to existing attributes *)
- let add (a: attributes) = addAttributes a0 a in
- match t with
- TVoid a -> TVoid (add a)
- | TInt (ik, a) -> TInt (ik, add a)
- | TFloat (fk, a) -> TFloat (fk, add a)
- | TEnum (enum, a) -> TEnum (enum, add a)
- | TPtr (t, a) -> TPtr (t, add a)
- | TArray (t, l, a) -> TArray (t, l, add a)
- | TFun (t, args, isva, a) -> TFun(t, args, isva, add a)
- | TComp (comp, a) -> TComp (comp, add a)
- | TNamed (t, a) -> TNamed (t, add a)
- | TBuiltin_va_list a -> TBuiltin_va_list (add a)
-end
-
-let typeRemoveAttributes (anl: string list) t =
- let drop (al: attributes) = dropAttributes anl al in
- match t with
- TVoid a -> TVoid (drop a)
- | TInt (ik, a) -> TInt (ik, drop a)
- | TFloat (fk, a) -> TFloat (fk, drop a)
- | TEnum (enum, a) -> TEnum (enum, drop a)
- | TPtr (t, a) -> TPtr (t, drop a)
- | TArray (t, l, a) -> TArray (t, l, drop a)
- | TFun (t, args, isva, a) -> TFun(t, args, isva, drop a)
- | TComp (comp, a) -> TComp (comp, drop a)
- | TNamed (t, a) -> TNamed (t, drop a)
- | TBuiltin_va_list a -> TBuiltin_va_list (drop a)
-
-let unrollType (t: typ) : typ =
- let rec withAttrs (al: attributes) (t: typ) : typ =
- match t with
- TNamed (r, a') -> withAttrs (addAttributes al a') r.ttype
- | x -> typeAddAttributes al x
- in
- withAttrs [] t
-
-let rec unrollTypeDeep (t: typ) : typ =
- let rec withAttrs (al: attributes) (t: typ) : typ =
- match t with
- TNamed (r, a') -> withAttrs (addAttributes al a') r.ttype
- | TPtr(t, a') -> TPtr(unrollTypeDeep t, addAttributes al a')
- | TArray(t, l, a') -> TArray(unrollTypeDeep t, l, addAttributes al a')
- | TFun(rt, args, isva, a') ->
- TFun (unrollTypeDeep rt,
- (match args with
- None -> None
- | Some argl ->
- Some (List.map (fun (an,at,aa) ->
- (an, unrollTypeDeep at, aa)) argl)),
- isva,
- addAttributes al a')
- | x -> typeAddAttributes al x
- in
- withAttrs [] t
-
-let isVoidType t =
- match unrollType t with
- TVoid _ -> true
- | _ -> false
-let isVoidPtrType t =
- match unrollType t with
- TPtr(tau,_) when isVoidType tau -> true
- | _ -> false
-
-let var vi : lval = (Var vi, NoOffset)
-(* let assign vi e = Instrs(Set (var vi, e), lu) *)
-
-let mkString s = Const(CStr s)
-
-
-let mkWhile ~(guard:exp) ~(body: stmt list) : stmt list =
- (* Do it like this so that the pretty printer recognizes it *)
-(*
- [ mkStmt (Loop (mkBlock (mkStmt (If(guard,
- mkBlock [ mkEmptyStmt () ],
- mkBlock [ mkStmt (Break lu)], lu)) ::
- body), lu, None, None)) ]
-*)
- [ mkStmt (While (guard, mkBlock body, lu)) ]
-
-
-
-let mkFor ~(start: stmt list) ~(guard: exp) ~(next: stmt list)
- ~(body: stmt list) : stmt list =
- (start @
- (mkWhile guard (body @ next)))
-
-
-let mkForIncr ~(iter : varinfo) ~(first: exp) ~stopat:(past: exp) ~(incr: exp)
- ~(body: stmt list) : stmt list =
- (* See what kind of operator we need *)
- let compop, nextop =
- match unrollType iter.vtype with
- TPtr _ -> Lt, PlusPI
- | _ -> Lt, PlusA
- in
- mkFor
- [ mkStmt (Instr [(Set (var iter, first, lu))]) ]
- (BinOp(compop, Lval(var iter), past, intType))
- [ mkStmt (Instr [(Set (var iter,
- (BinOp(nextop, Lval(var iter), incr, iter.vtype)),
- lu))])]
- body
-
-
-let rec stripCasts (e: exp) =
- match e with CastE(_, e') -> stripCasts e' | _ -> e
-
-
-
-(* the name of the C function we call to get ccgr ASTs
-external parse : string -> file = "cil_main"
-*)
-(*
- Pretty Printing
- *)
-
-let d_ikind () = function
- IChar -> text "char"
- | ISChar -> text "signed char"
- | IUChar -> text "unsigned char"
- | IInt -> text "int"
- | IUInt -> text "unsigned int"
- | IShort -> text "short"
- | IUShort -> text "unsigned short"
- | ILong -> text "long"
- | IULong -> text "unsigned long"
- | ILongLong ->
- if !msvcMode then text "__int64" else text "long long"
- | IULongLong ->
- if !msvcMode then text "unsigned __int64"
- else text "unsigned long long"
-
-let d_fkind () = function
- FFloat -> text "float"
- | FDouble -> text "double"
- | FLongDouble -> text "long double"
-
-let d_storage () = function
- NoStorage -> nil
- | Static -> text "static "
- | Extern -> text "extern "
- | Register -> text "register "
-
-(* sm: need this value below *)
-let mostNeg32BitInt : int64 = (Int64.of_string "-0x80000000")
-let mostNeg64BitInt : int64 = (Int64.of_string "-0x8000000000000000")
-
-(* constant *)
-let d_const () c =
- match c with
- CInt64(_, _, Some s) -> text s (* Always print the text if there is one *)
- | CInt64(i, ik, None) ->
- (** We must make sure to capture the type of the constant. For some
- * constants this is done with a suffix, for others with a cast prefix.*)
- let suffix : string =
- match ik with
- IUInt -> "U"
- | ILong -> "L"
- | IULong -> "UL"
- | ILongLong -> if !msvcMode then "L" else "LL"
- | IULongLong -> if !msvcMode then "UL" else "ULL"
- | _ -> ""
- in
- let prefix : string =
- if suffix <> "" then ""
- else if ik = IInt then ""
- else "(" ^ (sprint !lineLength (d_ikind () ik)) ^ ")"
- in
- (* Watch out here for negative integers that we should be printing as
- * large positive ones *)
- if i < Int64.zero
- && (match ik with
- IUInt | IULong | IULongLong | IUChar | IUShort -> true | _ -> false) then
- let high = Int64.shift_right i 32 in
- if ik <> IULongLong && ik <> ILongLong && high = Int64.of_int (-1) then
- (* Print only the low order 32 bits *)
- text (prefix ^ "0x" ^
- (Int64.format "%x"
- (Int64.logand i (Int64.shift_right_logical high 32))
- ^ suffix))
- else
- text (prefix ^ "0x" ^ Int64.format "%x" i ^ suffix)
- else (
- if (i = mostNeg32BitInt) then
- (* sm: quirk here: if you print -2147483648 then this is two tokens *)
- (* in C, and the second one is too large to represent in a signed *)
- (* int.. so we do what's done in limits.h, and print (-2147483467-1); *)
- (* in gcc this avoids a warning, but it might avoid a real problem *)
- (* on another compiler or a 64-bit architecture *)
- text (prefix ^ "(-0x7FFFFFFF-1)")
- else if (i = mostNeg64BitInt) then
- (* The same is true of the largest 64-bit negative. *)
- text (prefix ^ "(-0x7FFFFFFFFFFFFFFF-1)")
- else
- text (prefix ^ (Int64.to_string i ^ suffix))
- )
-
- | CStr(s) -> text ("\"" ^ escape_string s ^ "\"")
- | CWStr(s) ->
- (* text ("L\"" ^ escape_string s ^ "\"") *)
- (List.fold_left (fun acc elt ->
- acc ++
- if (elt >= Int64.zero &&
- elt <= (Int64.of_int 255)) then
- text (escape_char (Char.chr (Int64.to_int elt)))
- else
- ( text (Printf.sprintf "\\x%LX\"" elt) ++ break ++
- (text "\""))
- ) (text "L\"") s ) ++ text "\""
- (* we cannot print L"\xabcd" "feedme" as L"\xabcdfeedme" --
- * the former has 7 wide characters and the later has 3. *)
-
- | CChr(c) -> text ("'" ^ escape_char c ^ "'")
- | CReal(_, _, Some s) -> text s
- | CReal(f, _, None) -> text (string_of_float f)
- | CEnum(_, s, ei) -> text s
-
-
-(* Parentheses level. An expression "a op b" is printed parenthesized if its
- * parentheses level is >= that that of its context. Identifiers have the
- * lowest level and weakly binding operators (e.g. |) have the largest level.
- * The correctness criterion is that a smaller level MUST correspond to a
- * stronger precedence!
- *)
-let derefStarLevel = 20
-let indexLevel = 20
-let arrowLevel = 20
-let addrOfLevel = 30
-let additiveLevel = 60
-let comparativeLevel = 70
-let bitwiseLevel = 75
-let getParenthLevel = function
- | BinOp((LAnd | LOr), _,_,_) -> 80
- (* Bit operations. *)
- | BinOp((BOr|BXor|BAnd),_,_,_) -> bitwiseLevel (* 75 *)
-
- (* Comparisons *)
- | BinOp((Eq|Ne|Gt|Lt|Ge|Le),_,_,_) ->
- comparativeLevel (* 70 *)
- (* Additive. Shifts can have higher
- * level than + or - but I want
- * parentheses around them *)
- | BinOp((MinusA|MinusPP|MinusPI|PlusA|
- PlusPI|IndexPI|Shiftlt|Shiftrt),_,_,_)
- -> additiveLevel (* 60 *)
-
- (* Multiplicative *)
- | BinOp((Div|Mod|Mult),_,_,_) -> 40
-
- (* Unary *)
- | CastE(_,_) -> 30
- | AddrOf(_) -> 30
- | StartOf(_) -> 30
- | UnOp((Neg|BNot|LNot),_,_) -> 30
-
- (* Lvals *)
- | Lval(Mem _ , _) -> 20
- | Lval(Var _, (Field _|Index _)) -> 20
- | SizeOf _ | SizeOfE _ | SizeOfStr _ -> 20
- | AlignOf _ | AlignOfE _ -> 20
-
- | Lval(Var _, NoOffset) -> 0 (* Plain variables *)
- | Const _ -> 0 (* Constants *)
-
-
-
-(* Separate out the storage-modifier name attributes *)
-let separateStorageModifiers (al: attribute list) =
- let isstoragemod (Attr(an, _): attribute) : bool =
- try
- match H.find attributeHash an with
- AttrName issm -> issm
- | _ -> E.s (E.bug "separateStorageModifier: %s is not a name attribute" an)
- with Not_found -> false
- in
- let stom, rest = List.partition isstoragemod al in
- if not !msvcMode then
- stom, rest
- else
- (* Put back the declspec. Put it without the leading __ since these will
- * be added later *)
- let stom' =
- List.map (fun (Attr(an, args)) ->
- Attr("declspec", [ACons(an, args)])) stom in
- stom', rest
-
-
-let isIntegralType t =
- match unrollType t with
- (TInt _ | TEnum _) -> true
- | _ -> false
-
-let isArithmeticType t =
- match unrollType t with
- (TInt _ | TEnum _ | TFloat _) -> true
- | _ -> false
-
-
-let isPointerType t =
- match unrollType t with
- TPtr _ -> true
- | _ -> false
-
-let isFunctionType t =
- match unrollType t with
- TFun _ -> true
- | _ -> false
-
-(**** Compute the type of an expression ****)
-let rec typeOf (e: exp) : typ =
- match e with
- | Const(CInt64 (_, ik, _)) -> TInt(ik, [])
-
- (* Character constants have type int. ISO/IEC 9899:1999 (E),
- * section 6.4.4.4 [Character constants], paragraph 10, if you
- * don't believe me. *)
- | Const(CChr _) -> intType
-
- (* The type of a string is a pointer to characters ! The only case when
- * you would want it to be an array is as an argument to sizeof, but we
- * have SizeOfStr for that *)
- | Const(CStr s) -> !stringLiteralType
-
- | Const(CWStr s) -> TPtr(!wcharType,[])
-
- | Const(CReal (_, fk, _)) -> TFloat(fk, [])
-
- | Const(CEnum(_, _, ei)) -> TEnum(ei, [])
-
- | Lval(lv) -> typeOfLval lv
- | SizeOf _ | SizeOfE _ | SizeOfStr _ -> !typeOfSizeOf
- | AlignOf _ | AlignOfE _ -> !typeOfSizeOf
- | UnOp (_, _, t) -> t
- | BinOp (_, _, _, t) -> t
- | CastE (t, _) -> t
- | AddrOf (lv) -> TPtr(typeOfLval lv, [])
- | StartOf (lv) -> begin
- match unrollType (typeOfLval lv) with
- TArray (t,_, _) -> TPtr(t, [])
- | _ -> E.s (E.bug "typeOf: StartOf on a non-array")
- end
-
-and typeOfInit (i: init) : typ =
- match i with
- SingleInit e -> typeOf e
- | CompoundInit (t, _) -> t
-
-and typeOfLval = function
- Var vi, off -> typeOffset vi.vtype off
- | Mem addr, off -> begin
- match unrollType (typeOf addr) with
- TPtr (t, _) -> typeOffset t off
- | _ -> E.s (bug "typeOfLval: Mem on a non-pointer")
- end
-
-and typeOffset basetyp =
- let blendAttributes baseAttrs =
- let (_, _, contageous) =
- partitionAttributes ~default:(AttrName false) baseAttrs in
- typeAddAttributes contageous
- in
- function
- NoOffset -> basetyp
- | Index (_, o) -> begin
- match unrollType basetyp with
- TArray (t, _, baseAttrs) ->
- let elementType = typeOffset t o in
- blendAttributes baseAttrs elementType
- | t -> E.s (E.bug "typeOffset: Index on a non-array")
- end
- | Field (fi, o) ->
- match unrollType basetyp with
- TComp (_, baseAttrs) ->
- let fieldType = typeOffset fi.ftype o in
- blendAttributes baseAttrs fieldType
- | _ -> E.s (bug "typeOffset: Field on a non-compound")
-
-
-(**
- **
- ** MACHINE DEPENDENT PART
- **
- **)
-exception SizeOfError of string * typ
-
-
-(* Get the minimum aligment in bytes for a given type *)
-let rec alignOf_int = function
- | TInt((IChar|ISChar|IUChar), _) -> 1
- | TInt((IShort|IUShort), _) -> !theMachine.M.alignof_short
- | TInt((IInt|IUInt), _) -> !theMachine.M.alignof_int
- | TInt((ILong|IULong), _) -> !theMachine.M.alignof_long
- | TInt((ILongLong|IULongLong), _) -> !theMachine.M.alignof_longlong
- | TEnum _ -> !theMachine.M.alignof_enum
- | TFloat(FFloat, _) -> !theMachine.M.alignof_float
- | TFloat(FDouble, _) -> !theMachine.M.alignof_double
- | TFloat(FLongDouble, _) -> !theMachine.M.alignof_longdouble
- | TNamed (t, _) -> alignOf_int t.ttype
- | TArray (t, _, _) -> alignOf_int t
- | TPtr _ | TBuiltin_va_list _ -> !theMachine.M.alignof_ptr
-
- (* For composite types get the maximum alignment of any field inside *)
- | TComp (c, _) ->
- (* On GCC the zero-width fields do not contribute to the alignment. On
- * MSVC only those zero-width that _do_ appear after other
- * bitfields contribute to the alignment. So we drop those that
- * do not occur after othe bitfields *)
- let rec dropZeros (afterbitfield: bool) = function
- | f :: rest when f.fbitfield = Some 0 && not afterbitfield ->
- dropZeros afterbitfield rest
- | f :: rest -> f :: dropZeros (f.fbitfield <> None) rest
- | [] -> []
- in
- let fields = dropZeros false c.cfields in
- List.fold_left
- (fun sofar f ->
- (* Bitfields with zero width do not contribute to the alignment in
- * GCC *)
- if not !msvcMode && f.fbitfield = Some 0 then sofar else
- max sofar (alignOf_int f.ftype)) 1 fields
- (* These are some error cases *)
- | TFun _ when not !msvcMode -> !theMachine.M.alignof_fun
-
- | TFun _ as t -> raise (SizeOfError ("function", t))
- | TVoid _ as t -> raise (SizeOfError ("void", t))
-
-
-let bitsSizeOfInt (ik: ikind): int =
- match ik with
- | IChar | ISChar | IUChar -> 8
- | IInt | IUInt -> 8 * !theMachine.M.sizeof_int
- | IShort | IUShort -> 8 * !theMachine.M.sizeof_short
- | ILong | IULong -> 8 * !theMachine.M.sizeof_long
- | ILongLong | IULongLong -> 8 * !theMachine.M.sizeof_longlong
-
-(* Represents an integer as for a given kind.
- Returns a flag saying whether the value was changed
- during truncation (because it was too large to fit in k). *)
-let truncateInteger64 (k: ikind) (i: int64) : int64 * bool =
- let nrBits = bitsSizeOfInt k in
- let signed = isSigned k in
- if nrBits = 64 then
- i, false
- else begin
- let i1 = Int64.shift_left i (64 - nrBits) in
- let i2 =
- if signed then Int64.shift_right i1 (64 - nrBits)
- else Int64.shift_right_logical i1 (64 - nrBits)
- in
- let truncated =
- if i2 = i then false
- else
- (* Examine the bits that we chopped off. If they are all zero, then
- * any difference between i2 and i is due to a simple sign-extension.
- * e.g. casting the constant 0x80000000 to int makes it
- * 0xffffffff80000000.
- * Suppress the truncation warning in this case. *)
- let chopped = Int64.shift_right_logical i (64 - nrBits)
- in chopped <> Int64.zero
- in
- i2, truncated
- end
-
-(* Construct an integer constant with possible truncation *)
-let kinteger64 (k: ikind) (i: int64) : exp =
- let i', truncated = truncateInteger64 k i in
- if truncated then
- ignore (warnOpt "Truncating integer %s to %s\n"
- (Int64.format "0x%x" i) (Int64.format "0x%x" i'));
- Const (CInt64(i', k, None))
-
-(* Construct an integer of a given kind. *)
-let kinteger (k: ikind) (i: int) = kinteger64 k (Int64.of_int i)
-
-
-type offsetAcc =
- { oaFirstFree: int; (* The first free bit *)
- oaLastFieldStart: int; (* Where the previous field started *)
- oaLastFieldWidth: int; (* The width of the previous field. Might not
- * be same as FirstFree - FieldStart because
- * of internal padding *)
- oaPrevBitPack: (int * ikind * int) option; (* If the previous fields
- * were packed bitfields,
- * the bit where packing
- * has started, the ikind
- * of the bitfield and the
- * width of the ikind *)
- }
-
-
-(* GCC version *)
-(* Does not use the sofar.oaPrevBitPack *)
-let rec offsetOfFieldAcc_GCC (fi: fieldinfo)
- (sofar: offsetAcc) : offsetAcc =
- (* field type *)
- let ftype = unrollType fi.ftype in
- let ftypeAlign = 8 * alignOf_int ftype in
- let ftypeBits = bitsSizeOf ftype in
-(*
- if fi.fcomp.cname = "comp2468" ||
- fi.fcomp.cname = "comp2469" ||
- fi.fcomp.cname = "comp2470" ||
- fi.fcomp.cname = "comp2471" ||
- fi.fcomp.cname = "comp2472" ||
- fi.fcomp.cname = "comp2473" ||
- fi.fcomp.cname = "comp2474" ||
- fi.fcomp.cname = "comp2475" ||
- fi.fcomp.cname = "comp2476" ||
- fi.fcomp.cname = "comp2477" ||
- fi.fcomp.cname = "comp2478" then
-
- ignore (E.log "offsetOfFieldAcc_GCC(%s of %s:%a%a,firstFree=%d,pack=%a)\n"
- fi.fname fi.fcomp.cname
- d_type ftype
- insert
- (match fi.fbitfield with
- None -> nil
- | Some wdthis -> dprintf ":%d" wdthis)
- sofar.oaFirstFree
- insert
- (match sofar.oaPrevBitPack with
- None -> text "None"
- | Some (packstart, _, wdpack) ->
- dprintf "Some(packstart=%d,wd=%d)"
- packstart wdpack));
-*)
- match ftype, fi.fbitfield with
- (* A width of 0 means that we must end the current packing. It seems that
- * GCC pads only up to the alignment boundary for the type of this field.
- * *)
- | _, Some 0 ->
- let firstFree = addTrailing sofar.oaFirstFree ftypeAlign in
- { oaFirstFree = firstFree;
- oaLastFieldStart = firstFree;
- oaLastFieldWidth = 0;
- oaPrevBitPack = None }
-
- (* A bitfield cannot span more alignment boundaries of its type than the
- * type itself *)
- | _, Some wdthis
- when (sofar.oaFirstFree + wdthis + ftypeAlign - 1) / ftypeAlign
- - sofar.oaFirstFree / ftypeAlign > ftypeBits / ftypeAlign ->
- let start = addTrailing sofar.oaFirstFree ftypeAlign in
- { oaFirstFree = start + wdthis;
- oaLastFieldStart = start;
- oaLastFieldWidth = wdthis;
- oaPrevBitPack = None }
-
- (* Try a simple method. Just put the field down *)
- | _, Some wdthis ->
- { oaFirstFree = sofar.oaFirstFree + wdthis;
- oaLastFieldStart = sofar.oaFirstFree;
- oaLastFieldWidth = wdthis;
- oaPrevBitPack = None
- }
-
- (* Non-bitfield *)
- | _, None ->
- (* Align this field *)
- let newStart = addTrailing sofar.oaFirstFree ftypeAlign in
- { oaFirstFree = newStart + ftypeBits;
- oaLastFieldStart = newStart;
- oaLastFieldWidth = ftypeBits;
- oaPrevBitPack = None;
- }
-
-(* MSVC version *)
-and offsetOfFieldAcc_MSVC (fi: fieldinfo)
- (sofar: offsetAcc) : offsetAcc =
- (* field type *)
- let ftype = unrollType fi.ftype in
- let ftypeAlign = 8 * alignOf_int ftype in
- let ftypeBits = bitsSizeOf ftype in
-(*
- ignore (E.log "offsetOfFieldAcc_MSVC(%s of %s:%a%a,firstFree=%d, pack=%a)\n"
- fi.fname fi.fcomp.cname
- d_type ftype
- insert
- (match fi.fbitfield with
- None -> nil
- | Some wdthis -> dprintf ":%d" wdthis)
- sofar.oaFirstFree
- insert
- (match sofar.oaPrevBitPack with
- None -> text "None"
- | Some (prevpack, _, wdpack) -> dprintf "Some(prev=%d,wd=%d)"
- prevpack wdpack));
-*)
- match ftype, fi.fbitfield, sofar.oaPrevBitPack with
- (* Ignore zero-width bitfields that come after non-bitfields *)
- | TInt (ikthis, _), Some 0, None ->
- let firstFree = sofar.oaFirstFree in
- { oaFirstFree = firstFree;
- oaLastFieldStart = firstFree;
- oaLastFieldWidth = 0;
- oaPrevBitPack = None }
-
- (* If we are in a bitpack and we see a bitfield for a type with the
- * different width than the pack, then we finish the pack and retry *)
- | _, Some _, Some (packstart, _, wdpack) when wdpack != ftypeBits ->
- let firstFree =
- if sofar.oaFirstFree = packstart then packstart else
- packstart + wdpack
- in
- offsetOfFieldAcc_MSVC fi
- { oaFirstFree = addTrailing firstFree ftypeAlign;
- oaLastFieldStart = sofar.oaLastFieldStart;
- oaLastFieldWidth = sofar.oaLastFieldWidth;
- oaPrevBitPack = None }
-
- (* A width of 0 means that we must end the current packing. *)
- | TInt (ikthis, _), Some 0, Some (packstart, _, wdpack) ->
- let firstFree =
- if sofar.oaFirstFree = packstart then packstart else
- packstart + wdpack
- in
- let firstFree = addTrailing firstFree ftypeAlign in
- { oaFirstFree = firstFree;
- oaLastFieldStart = firstFree;
- oaLastFieldWidth = 0;
- oaPrevBitPack = Some (firstFree, ikthis, ftypeBits) }
-
- (* Check for a bitfield that fits in the current pack after some other
- * bitfields *)
- | TInt(ikthis, _), Some wdthis, Some (packstart, ikprev, wdpack)
- when packstart + wdpack >= sofar.oaFirstFree + wdthis ->
- { oaFirstFree = sofar.oaFirstFree + wdthis;
- oaLastFieldStart = sofar.oaFirstFree;
- oaLastFieldWidth = wdthis;
- oaPrevBitPack = sofar.oaPrevBitPack
- }
-
-
- | _, _, Some (packstart, _, wdpack) -> (* Finish up the bitfield pack and
- * restart. *)
- let firstFree =
- if sofar.oaFirstFree = packstart then packstart else
- packstart + wdpack
- in
- offsetOfFieldAcc_MSVC fi
- { oaFirstFree = addTrailing firstFree ftypeAlign;
- oaLastFieldStart = sofar.oaLastFieldStart;
- oaLastFieldWidth = sofar.oaLastFieldWidth;
- oaPrevBitPack = None }
-
- (* No active bitfield pack. But we are seeing a bitfield. *)
- | TInt(ikthis, _), Some wdthis, None ->
- let firstFree = addTrailing sofar.oaFirstFree ftypeAlign in
- { oaFirstFree = firstFree + wdthis;
- oaLastFieldStart = firstFree;
- oaLastFieldWidth = wdthis;
- oaPrevBitPack = Some (firstFree, ikthis, ftypeBits); }
-
- (* No active bitfield pack. Non-bitfield *)
- | _, None, None ->
- (* Align this field *)
- let firstFree = addTrailing sofar.oaFirstFree ftypeAlign in
- { oaFirstFree = firstFree + ftypeBits;
- oaLastFieldStart = firstFree;
- oaLastFieldWidth = ftypeBits;
- oaPrevBitPack = None;
- }
-
- | _, Some _, None -> E.s (E.bug "offsetAcc")
-
-
-and offsetOfFieldAcc ~(fi: fieldinfo)
- ~(sofar: offsetAcc) : offsetAcc =
- if !msvcMode then offsetOfFieldAcc_MSVC fi sofar
- else offsetOfFieldAcc_GCC fi sofar
-
-(* The size of a type, in bits. If struct or array then trailing padding is
- * added *)
-and bitsSizeOf t =
- if not !initCIL_called then
- E.s (E.error "You did not call Cil.initCIL before using the CIL library");
- match t with
- | TInt (ik,_) -> bitsSizeOfInt ik
- | TFloat(FDouble, _) -> 8 * !theMachine.M.sizeof_double
- | TFloat(FLongDouble, _) -> 8 * !theMachine.M.sizeof_longdouble
- | TFloat _ -> 8 * !theMachine.M.sizeof_float
- | TEnum _ -> 8 * !theMachine.M.sizeof_enum
- | TPtr _ -> 8 * !theMachine.M.sizeof_ptr
- | TBuiltin_va_list _ -> 8 * !theMachine.M.sizeof_ptr
- | TNamed (t, _) -> bitsSizeOf t.ttype
- | TComp (comp, _) when comp.cfields == [] -> begin
- (* Empty structs are allowed in msvc mode *)
- if not comp.cdefined && not !msvcMode then
- raise (SizeOfError ("abstract type", t)) (*abstract type*)
- else
- 0
- end
-
- | TComp (comp, _) when comp.cstruct -> (* Struct *)
- (* Go and get the last offset *)
- let startAcc =
- { oaFirstFree = 0;
- oaLastFieldStart = 0;
- oaLastFieldWidth = 0;
- oaPrevBitPack = None;
- } in
- let lastoff =
- List.fold_left (fun acc fi -> offsetOfFieldAcc ~fi ~sofar:acc)
- startAcc comp.cfields
- in
- if !msvcMode && lastoff.oaFirstFree = 0 && comp.cfields <> [] then
- (* On MSVC if we have just a zero-width bitfields then the length
- * is 32 and is not padded *)
- 32
- else
- addTrailing lastoff.oaFirstFree (8 * alignOf_int t)
-
- | TComp (comp, _) -> (* when not comp.cstruct *)
- (* Get the maximum of all fields *)
- let startAcc =
- { oaFirstFree = 0;
- oaLastFieldStart = 0;
- oaLastFieldWidth = 0;
- oaPrevBitPack = None;
- } in
- let max =
- List.fold_left (fun acc fi ->
- let lastoff = offsetOfFieldAcc ~fi ~sofar:startAcc in
- if lastoff.oaFirstFree > acc then
- lastoff.oaFirstFree else acc) 0 comp.cfields in
- (* Add trailing by simulating adding an extra field *)
- addTrailing max (8 * alignOf_int t)
-
- | TArray(t, Some len, _) -> begin
- match constFold true len with
- Const(CInt64(l,_,_)) ->
- addTrailing ((bitsSizeOf t) * (Int64.to_int l)) (8 * alignOf_int t)
- | _ -> raise (SizeOfError ("array non-constant length", t))
- end
-
-
- | TVoid _ -> 8 * !theMachine.M.sizeof_void
- | TFun _ when not !msvcMode -> (* On GCC the size of a function is defined *)
- 8 * !theMachine.M.sizeof_fun
-
- | TArray (_, None, _) -> (* it seems that on GCC the size of such an
- * array is 0 *)
- 0
-
- | TFun _ -> raise (SizeOfError ("function", t))
-
-
-and addTrailing nrbits roundto =
- (nrbits + roundto - 1) land (lnot (roundto - 1))
-
-and sizeOf t =
- try
- integer ((bitsSizeOf t) lsr 3)
- with SizeOfError _ -> SizeOf(t)
-
-
-and bitsOffset (baset: typ) (off: offset) : int * int =
- let rec loopOff (baset: typ) (width: int) (start: int) = function
- NoOffset -> start, width
- | Index(e, off) -> begin
- let ei =
- match isInteger e with
- Some i64 -> Int64.to_int i64
- | None -> raise (SizeOfError ("index not constant", baset))
- in
- let bt =
- match unrollType baset with
- TArray(bt, _, _) -> bt
- | _ -> E.s (E.bug "bitsOffset: Index on a non-array")
- in
- let bitsbt = bitsSizeOf bt in
- loopOff bt bitsbt (start + ei * bitsbt) off
- end
- | Field(f, off) when not f.fcomp.cstruct ->
- (* All union fields start at offset 0 *)
- loopOff f.ftype (bitsSizeOf f.ftype) start off
-
- | Field(f, off) ->
- (* Construct a list of fields preceeding and including this one *)
- let prevflds =
- let rec loop = function
- [] -> E.s (E.bug "bitsOffset: Cannot find field %s in %s\n"
- f.fname f.fcomp.cname)
- | fi' :: _ when fi' == f -> [fi']
- | fi' :: rest -> fi' :: loop rest
- in
- loop f.fcomp.cfields
- in
- let lastoff =
- List.fold_left (fun acc fi' -> offsetOfFieldAcc ~fi:fi' ~sofar:acc)
- { oaFirstFree = 0; (* Start at 0 because each struct is done
- * separately *)
- oaLastFieldStart = 0;
- oaLastFieldWidth = 0;
- oaPrevBitPack = None } prevflds
- in
- (* ignore (E.log "Field %s of %s: start=%d, lastFieldStart=%d\n"
- f.fname f.fcomp.cname start lastoff.oaLastFieldStart); *)
- loopOff f.ftype lastoff.oaLastFieldWidth
- (start + lastoff.oaLastFieldStart) off
- in
- loopOff baset (bitsSizeOf baset) 0 off
-
-
-
-
-(*** Constant folding. If machdep is true then fold even sizeof operations ***)
-and constFold (machdep: bool) (e: exp) : exp =
- match e with
- BinOp(bop, e1, e2, tres) -> constFoldBinOp machdep bop e1 e2 tres
- | UnOp(unop, e1, tres) -> begin
- try
- let tk =
- match unrollType tres with
- TInt(ik, _) -> ik
- | TEnum _ -> IInt
- | _ -> raise Not_found (* probably a float *)
- in
- match constFold machdep e1 with
- Const(CInt64(i,ik,_)) -> begin
- match unop with
- Neg -> kinteger64 tk (Int64.neg i)
- | BNot -> kinteger64 tk (Int64.lognot i)
- | LNot -> if i = Int64.zero then one else zero
- end
- | e1c -> UnOp(unop, e1c, tres)
- with Not_found -> e
- end
- (* Characters are integers *)
- | Const(CChr c) -> Const(charConstToInt c)
- | Const(CEnum (v, _, _)) -> constFold machdep v
- | SizeOf t when machdep -> begin
- try
- let bs = bitsSizeOf t in
- kinteger !kindOfSizeOf (bs / 8)
- with SizeOfError _ -> e
- end
- | SizeOfE e when machdep -> constFold machdep (SizeOf (typeOf e))
- | SizeOfStr s when machdep -> kinteger !kindOfSizeOf (1 + String.length s)
- | AlignOf t when machdep -> kinteger !kindOfSizeOf (alignOf_int t)
- | AlignOfE e when machdep -> begin
- (* The alignmetn of an expression is not always the alignment of its
- * type. I know that for strings this is not true *)
- match e with
- Const (CStr _) when not !msvcMode ->
- kinteger !kindOfSizeOf !theMachine.M.alignof_str
- (* For an array, it is the alignment of the array ! *)
- | _ -> constFold machdep (AlignOf (typeOf e))
- end
-
- | CastE(it,
- AddrOf (Mem (CastE(TPtr(bt, _), z)), off))
- when machdep && isZero z -> begin
- try
- let start, width = bitsOffset bt off in
- if start mod 8 <> 0 then
- E.s (error "Using offset of bitfield\n");
- constFold machdep (CastE(it, (integer (start / 8))))
- with SizeOfError _ -> e
- end
-
-
- | CastE (t, e) -> begin
- match constFold machdep e, unrollType t with
- (* Might truncate silently *)
- Const(CInt64(i,k,_)), TInt(nk,_) ->
- let i', _ = truncateInteger64 nk i in
- Const(CInt64(i', nk, None))
- | e', _ -> CastE (t, e')
- end
-
- | _ -> e
-
-and constFoldBinOp (machdep: bool) bop e1 e2 tres =
- let e1' = constFold machdep e1 in
- let e2' = constFold machdep e2 in
- if isIntegralType tres then begin
- let newe =
- let rec mkInt = function
- Const(CChr c) -> Const(charConstToInt c)
- | Const(CEnum (v, s, ei)) -> mkInt v
- | CastE(TInt (ik, ta), e) -> begin
- match mkInt e with
- Const(CInt64(i, _, _)) ->
- let i', _ = truncateInteger64 ik i in
- Const(CInt64(i', ik, None))
-
- | e' -> CastE(TInt(ik, ta), e')
- end
- | e -> e
- in
- let tk =
- match unrollType tres with
- TInt(ik, _) -> ik
- | TEnum _ -> IInt
- | _ -> E.s (bug "constFoldBinOp")
- in
- (* See if the result is unsigned *)
- let isunsigned typ = not (isSigned typ) in
- let ge (unsigned: bool) (i1: int64) (i2: int64) : bool =
- if unsigned then
- let l1 = Int64.shift_right_logical i1 1 in
- let l2 = Int64.shift_right_logical i2 1 in (* Both positive now *)
- (l1 > l2) || (l1 = l2 &&
- Int64.logand i1 Int64.one >= Int64.logand i2 Int64.one)
- else i1 >= i2
- in
- let shiftInBounds i2 =
- (* We only try to fold shifts if the second arg is positive and
- less than 64. Otherwise, the semantics are processor-dependent,
- so let the compiler sort it out. *)
- i2 >= Int64.zero && i2 < (Int64.of_int 64)
- in
- (* Assume that the necessary promotions have been done *)
- match bop, mkInt e1', mkInt e2' with
- | PlusA, Const(CInt64(z,_,_)), e2'' when z = Int64.zero -> e2''
- | PlusA, e1'', Const(CInt64(z,_,_)) when z = Int64.zero -> e1''
- | PlusPI, e1'', Const(CInt64(z,_,_)) when z = Int64.zero -> e1''
- | IndexPI, e1'', Const(CInt64(z,_,_)) when z = Int64.zero -> e1''
- | MinusPI, e1'', Const(CInt64(z,_,_)) when z = Int64.zero -> e1''
- | PlusA, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
- kinteger64 tk (Int64.add i1 i2)
- | MinusA, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
- kinteger64 tk (Int64.sub i1 i2)
- | Mult, Const(CInt64(i1,ik1,_)), Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
- kinteger64 tk (Int64.mul i1 i2)
- | Mult, Const(CInt64(0L,_,_)), _ -> zero
- | Mult, Const(CInt64(1L,_,_)), e2'' -> e2''
- | Mult, _, Const(CInt64(0L,_,_)) -> zero
- | Mult, e1'', Const(CInt64(1L,_,_)) -> e1''
- | Div, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 -> begin
- try kinteger64 tk (Int64.div i1 i2)
- with Division_by_zero -> BinOp(bop, e1', e2', tres)
- end
- | Div, e1'', Const(CInt64(1L,_,_)) -> e1''
-
- | Mod, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 -> begin
- try kinteger64 tk (Int64.rem i1 i2)
- with Division_by_zero -> BinOp(bop, e1', e2', tres)
- end
- | BAnd, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
- kinteger64 tk (Int64.logand i1 i2)
- | BAnd, Const(CInt64(0L,_,_)), _ -> zero
- | BAnd, _, Const(CInt64(0L,_,_)) -> zero
- | BOr, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
- kinteger64 tk (Int64.logor i1 i2)
- | BOr, _, _ when isZero e1' -> e2'
- | BOr, _, _ when isZero e2' -> e1'
- | BXor, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
- kinteger64 tk (Int64.logxor i1 i2)
-
- | Shiftlt, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,_,_)) when shiftInBounds i2 ->
- kinteger64 tk (Int64.shift_left i1 (Int64.to_int i2))
- | Shiftlt, Const(CInt64(0L,_,_)), _ -> zero
- | Shiftlt, e1'', Const(CInt64(0L,_,_)) -> e1''
-
- | Shiftrt, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,_,_)) when shiftInBounds i2 ->
- if isunsigned ik1 then
- kinteger64 tk (Int64.shift_right_logical i1 (Int64.to_int i2))
- else
- kinteger64 tk (Int64.shift_right i1 (Int64.to_int i2))
- | Shiftrt, Const(CInt64(0L,_,_)), _ -> zero
- | Shiftrt, e1'', Const(CInt64(0L,_,_)) -> e1''
-
- | Eq, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
- integer (if i1 = i2 then 1 else 0)
- | Ne, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
- integer (if i1 <> i2 then 1 else 0)
- | Le, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
- integer (if ge (isunsigned ik1) i2 i1 then 1 else 0)
-
- | Ge, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
- integer (if ge (isunsigned ik1) i1 i2 then 1 else 0)
-
- | Lt, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
- integer (if i1 <> i2 && ge (isunsigned ik1) i2 i1 then 1 else 0)
-
- | Gt, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
- integer (if i1 <> i2 && ge (isunsigned ik1) i1 i2 then 1 else 0)
- | LAnd, _, _ when isZero e1' || isZero e2' -> zero
- | LOr, _, _ when isZero e1' -> e2'
- | LOr, _, _ when isZero e2' -> e1'
- | _ -> BinOp(bop, e1', e2', tres)
- in
- if debugConstFold then
- ignore (E.log "Folded %a to %a\n"
- (!pd_exp) (BinOp(bop, e1', e2', tres)) (!pd_exp) newe);
- newe
- end else
- BinOp(bop, e1', e2', tres)
-
-
-
-let parseInt (str: string) : exp =
- let hasSuffix str =
- let l = String.length str in
- fun s ->
- let ls = String.length s in
- l >= ls && s = String.uppercase (String.sub str (l - ls) ls)
- in
- let l = String.length str in
- (* See if it is octal or hex *)
- let octalhex = (l >= 1 && String.get str 0 = '0') in
- (* The length of the suffix and a list of possible kinds. See ISO
- * 6.4.4.1 *)
- let hasSuffix = hasSuffix str in
- let suffixlen, kinds =
- if hasSuffix "ULL" || hasSuffix "LLU" then
- 3, [IULongLong]
- else if hasSuffix "LL" then
- 2, if octalhex then [ILongLong; IULongLong] else [ILongLong]
- else if hasSuffix "UL" || hasSuffix "LU" then
- 2, [IULong; IULongLong]
- else if hasSuffix "L" then
- 1, if octalhex then [ILong; IULong; ILongLong; IULongLong]
- else [ILong; ILongLong]
- else if hasSuffix "U" then
- 1, [IUInt; IULong; IULongLong]
- else if (!msvcMode && hasSuffix "UI64") then
- 4, [IULongLong]
- else if (!msvcMode && hasSuffix "I64") then
- 3, [ILongLong]
- else
- 0, if octalhex || true (* !!! This is against the ISO but it
- * is what GCC and MSVC do !!! *)
- then [IInt; IUInt; ILong; IULong; ILongLong; IULongLong]
- else [IInt; ILong; IUInt; ILongLong]
- in
- (* Convert to integer. To prevent overflow we do the arithmetic
- * on Int64 and we take care of overflow. We work only with
- * positive integers since the lexer takes care of the sign *)
- let rec toInt (base: int64) (acc: int64) (idx: int) : int64 =
- let doAcc (what: int) =
- let acc' =
- Int64.add (Int64.mul base acc) (Int64.of_int what) in
- if acc < Int64.zero || (* We clearly overflow since base >= 2
- * *)
- (acc' > Int64.zero && acc' < acc) then
- E.s (unimp "Cannot represent on 64 bits the integer %s\n"
- str)
- else
- toInt base acc' (idx + 1)
- in
- if idx >= l - suffixlen then begin
- acc
- end else
- let ch = String.get str idx in
- if ch >= '0' && ch <= '9' then
- doAcc (Char.code ch - Char.code '0')
- else if ch >= 'a' && ch <= 'f' then
- doAcc (10 + Char.code ch - Char.code 'a')
- else if ch >= 'A' && ch <= 'F' then
- doAcc (10 + Char.code ch - Char.code 'A')
- else
- E.s (bug "Invalid integer constant: %s (char %c at idx=%d)"
- str ch idx)
- in
- try
- let i =
- if octalhex then
- if l >= 2 &&
- (let c = String.get str 1 in c = 'x' || c = 'X') then
- toInt (Int64.of_int 16) Int64.zero 2
- else
- toInt (Int64.of_int 8) Int64.zero 1
- else
- toInt (Int64.of_int 10) Int64.zero 0
- in
- (* Construct an integer of the first kinds that fits. i must be
- * POSITIVE *)
- let res =
- let rec loop = function
- | ((IInt | ILong) as k) :: _
- when i < Int64.shift_left (Int64.of_int 1) 31 ->
- kinteger64 k i
- | ((IUInt | IULong) as k) :: _
- when i < Int64.shift_left (Int64.of_int 1) 32
- -> kinteger64 k i
- | (ILongLong as k) :: _
- when i <= Int64.sub (Int64.shift_left
- (Int64.of_int 1) 63)
- (Int64.of_int 1)
- ->
- kinteger64 k i
- | (IULongLong as k) :: _ -> kinteger64 k i
- | _ :: rest -> loop rest
- | [] -> E.s (E.unimp "Cannot represent the integer %s\n"
- (Int64.to_string i))
- in
- loop kinds
- in
- res
- with e -> begin
- ignore (E.log "int_of_string %s (%s)\n" str
- (Printexc.to_string e));
- zero
- end
-
-
-
-let d_unop () u =
- match u with
- Neg -> text "-"
- | BNot -> text "~"
- | LNot -> text "!"
-
-let d_binop () b =
- match b with
- PlusA | PlusPI | IndexPI -> text "+"
- | MinusA | MinusPP | MinusPI -> text "-"
- | Mult -> text "*"
- | Div -> text "/"
- | Mod -> text "%"
- | Shiftlt -> text "<<"
- | Shiftrt -> text ">>"
- | Lt -> text "<"
- | Gt -> text ">"
- | Le -> text "<="
- | Ge -> text ">="
- | Eq -> text "=="
- | Ne -> text "!="
- | BAnd -> text "&"
- | BXor -> text "^"
- | BOr -> text "|"
- | LAnd -> text "&&"
- | LOr -> text "||"
-
-let invalidStmt = mkStmt (Instr [])
-
-(** Construct a hash with the builtins *)
-let gccBuiltins : (string, typ * typ list * bool) H.t =
- let h = H.create 17 in
- (* See if we have builtin_va_list *)
- let hasbva = M.gccHas__builtin_va_list in
- let ulongLongType = TInt(IULongLong, []) in
- let floatType = TFloat(FFloat, []) in
- let longDoubleType = TFloat (FLongDouble, []) in
- let voidConstPtrType = TPtr(TVoid [Attr ("const", [])], []) in
- let sizeType = uintType in
-
- H.add h "__builtin___fprintf_chk" (intType, [ voidPtrType; intType; charConstPtrType ], true) (* first argument is really FILE*, not void*, but we don't want to build in the definition for FILE *);
- H.add h "__builtin___memcpy_chk" (voidPtrType, [ voidPtrType; voidConstPtrType; sizeType; sizeType ], false);
- H.add h "__builtin___memmove_chk" (voidPtrType, [ voidPtrType; voidConstPtrType; sizeType; sizeType ], false);
- H.add h "__builtin___mempcpy_chk" (voidPtrType, [ voidPtrType; voidConstPtrType; sizeType; sizeType ], false);
- H.add h "__builtin___memset_chk" (voidPtrType, [ voidPtrType; intType; sizeType; sizeType ], false);
- H.add h "__builtin___printf_chk" (intType, [ intType; charConstPtrType ], true);
- H.add h "__builtin___snprintf_chk" (intType, [ charPtrType; sizeType; intType; sizeType; charConstPtrType ], true);
- H.add h "__builtin___sprintf_chk" (intType, [ charPtrType; intType; sizeType; charConstPtrType ], true);
- H.add h "__builtin___stpcpy_chk" (charPtrType, [ charPtrType; charConstPtrType; sizeType ], false);
- H.add h "__builtin___strcat_chk" (charPtrType, [ charPtrType; charConstPtrType; sizeType ], false);
- H.add h "__builtin___strcpy_chk" (charPtrType, [ charPtrType; charConstPtrType; sizeType ], false);
- H.add h "__builtin___strncat_chk" (charPtrType, [ charPtrType; charConstPtrType; sizeType; sizeType ], false);
- H.add h "__builtin___strncpy_chk" (charPtrType, [ charPtrType; charConstPtrType; sizeType; sizeType ], false);
- H.add h "__builtin___vfprintf_chk" (intType, [ voidPtrType; intType; charConstPtrType; TBuiltin_va_list [] ], false) (* first argument is really FILE*, not void*, but we don't want to build in the definition for FILE *);
- H.add h "__builtin___vprintf_chk" (intType, [ intType; charConstPtrType; TBuiltin_va_list [] ], false);
- H.add h "__builtin___vsnprintf_chk" (intType, [ charPtrType; sizeType; intType; sizeType; charConstPtrType; TBuiltin_va_list [] ], false);
- H.add h "__builtin___vsprintf_chk" (intType, [ charPtrType; intType; sizeType; charConstPtrType; TBuiltin_va_list [] ], false);
-
- H.add h "__builtin_acos" (doubleType, [ doubleType ], false);
- H.add h "__builtin_acosf" (floatType, [ floatType ], false);
- H.add h "__builtin_acosl" (longDoubleType, [ longDoubleType ], false);
-
- H.add h "__builtin_alloca" (voidPtrType, [ uintType ], false);
-
- H.add h "__builtin_asin" (doubleType, [ doubleType ], false);
- H.add h "__builtin_asinf" (floatType, [ floatType ], false);
- H.add h "__builtin_asinl" (longDoubleType, [ longDoubleType ], false);
-
- H.add h "__builtin_atan" (doubleType, [ doubleType ], false);
- H.add h "__builtin_atanf" (floatType, [ floatType ], false);
- H.add h "__builtin_atanl" (longDoubleType, [ longDoubleType ], false);
-
- H.add h "__builtin_atan2" (doubleType, [ doubleType; doubleType ], false);
- H.add h "__builtin_atan2f" (floatType, [ floatType; floatType ], false);
- H.add h "__builtin_atan2l" (longDoubleType, [ longDoubleType;
- longDoubleType ], false);
-
- H.add h "__builtin_ceil" (doubleType, [ doubleType ], false);
- H.add h "__builtin_ceilf" (floatType, [ floatType ], false);
- H.add h "__builtin_ceill" (longDoubleType, [ longDoubleType ], false);
-
- H.add h "__builtin_cos" (doubleType, [ doubleType ], false);
- H.add h "__builtin_cosf" (floatType, [ floatType ], false);
- H.add h "__builtin_cosl" (longDoubleType, [ longDoubleType ], false);
-
- H.add h "__builtin_cosh" (doubleType, [ doubleType ], false);
- H.add h "__builtin_coshf" (floatType, [ floatType ], false);
- H.add h "__builtin_coshl" (longDoubleType, [ longDoubleType ], false);
-
- H.add h "__builtin_clz" (intType, [ uintType ], false);
- H.add h "__builtin_clzl" (intType, [ ulongType ], false);
- H.add h "__builtin_clzll" (intType, [ ulongLongType ], false);
- H.add h "__builtin_constant_p" (intType, [ intType ], false);
- H.add h "__builtin_ctz" (intType, [ uintType ], false);
- H.add h "__builtin_ctzl" (intType, [ ulongType ], false);
- H.add h "__builtin_ctzll" (intType, [ ulongLongType ], false);
-
- H.add h "__builtin_exp" (doubleType, [ doubleType ], false);
- H.add h "__builtin_expf" (floatType, [ floatType ], false);
- H.add h "__builtin_expl" (longDoubleType, [ longDoubleType ], false);
-
- H.add h "__builtin_expect" (longType, [ longType; longType ], false);
-
- H.add h "__builtin_fabs" (doubleType, [ doubleType ], false);
- H.add h "__builtin_fabsf" (floatType, [ floatType ], false);
- H.add h "__builtin_fabsl" (longDoubleType, [ longDoubleType ], false);
-
- H.add h "__builtin_ffs" (intType, [ uintType ], false);
- H.add h "__builtin_ffsl" (intType, [ ulongType ], false);
- H.add h "__builtin_ffsll" (intType, [ ulongLongType ], false);
- H.add h "__builtin_frame_address" (voidPtrType, [ uintType ], false);
-
- H.add h "__builtin_floor" (doubleType, [ doubleType ], false);
- H.add h "__builtin_floorf" (floatType, [ floatType ], false);
- H.add h "__builtin_floorl" (longDoubleType, [ longDoubleType ], false);
-
- H.add h "__builtin_huge_val" (doubleType, [], false);
- H.add h "__builtin_huge_valf" (floatType, [], false);
- H.add h "__builtin_huge_vall" (longDoubleType, [], false);
- H.add h "__builtin_inf" (doubleType, [], false);
- H.add h "__builtin_inff" (floatType, [], false);
- H.add h "__builtin_infl" (longDoubleType, [], false);
- H.add h "__builtin_memcpy" (voidPtrType, [ voidPtrType; voidConstPtrType; uintType ], false);
- H.add h "__builtin_mempcpy" (voidPtrType, [ voidPtrType; voidConstPtrType; sizeType ], false);
-
- H.add h "__builtin_fmod" (doubleType, [ doubleType ], false);
- H.add h "__builtin_fmodf" (floatType, [ floatType ], false);
- H.add h "__builtin_fmodl" (longDoubleType, [ longDoubleType ], false);
-
- H.add h "__builtin_frexp" (doubleType, [ doubleType; intPtrType ], false);
- H.add h "__builtin_frexpf" (floatType, [ floatType; intPtrType ], false);
- H.add h "__builtin_frexpl" (longDoubleType, [ longDoubleType;
- intPtrType ], false);
-
- H.add h "__builtin_ldexp" (doubleType, [ doubleType; intType ], false);
- H.add h "__builtin_ldexpf" (floatType, [ floatType; intType ], false);
- H.add h "__builtin_ldexpl" (longDoubleType, [ longDoubleType;
- intType ], false);
-
- H.add h "__builtin_log" (doubleType, [ doubleType ], false);
- H.add h "__builtin_logf" (floatType, [ floatType ], false);
- H.add h "__builtin_logl" (longDoubleType, [ longDoubleType ], false);
-
- H.add h "__builtin_log10" (doubleType, [ doubleType ], false);
- H.add h "__builtin_log10f" (floatType, [ floatType ], false);
- H.add h "__builtin_log10l" (longDoubleType, [ longDoubleType ], false);
-
- H.add h "__builtin_modff" (floatType, [ floatType;
- TPtr(floatType,[]) ], false);
- H.add h "__builtin_modfl" (longDoubleType, [ longDoubleType;
- TPtr(longDoubleType, []) ],
- false);
-
- H.add h "__builtin_nan" (doubleType, [ charConstPtrType ], false);
- H.add h "__builtin_nanf" (floatType, [ charConstPtrType ], false);
- H.add h "__builtin_nanl" (longDoubleType, [ charConstPtrType ], false);
- H.add h "__builtin_nans" (doubleType, [ charConstPtrType ], false);
- H.add h "__builtin_nansf" (floatType, [ charConstPtrType ], false);
- H.add h "__builtin_nansl" (longDoubleType, [ charConstPtrType ], false);
- H.add h "__builtin_next_arg" ((if hasbva then TBuiltin_va_list [] else voidPtrType), [], false) (* When we parse builtin_next_arg we drop the second argument *);
- H.add h "__builtin_object_size" (sizeType, [ voidPtrType; intType ], false);
-
- H.add h "__builtin_parity" (intType, [ uintType ], false);
- H.add h "__builtin_parityl" (intType, [ ulongType ], false);
- H.add h "__builtin_parityll" (intType, [ ulongLongType ], false);
-
- H.add h "__builtin_popcount" (intType, [ uintType ], false);
- H.add h "__builtin_popcountl" (intType, [ ulongType ], false);
- H.add h "__builtin_popcountll" (intType, [ ulongLongType ], false);
-
- H.add h "__builtin_powi" (doubleType, [ doubleType; intType ], false);
- H.add h "__builtin_powif" (floatType, [ floatType; intType ], false);
- H.add h "__builtin_powil" (longDoubleType, [ longDoubleType; intType ], false);
- H.add h "__builtin_prefetch" (voidType, [ voidConstPtrType ], true);
- H.add h "__builtin_return" (voidType, [ voidConstPtrType ], false);
- H.add h "__builtin_return_address" (voidPtrType, [ uintType ], false);
-
- H.add h "__builtin_sin" (doubleType, [ doubleType ], false);
- H.add h "__builtin_sinf" (floatType, [ floatType ], false);
- H.add h "__builtin_sinl" (longDoubleType, [ longDoubleType ], false);
-
- H.add h "__builtin_sinh" (doubleType, [ doubleType ], false);
- H.add h "__builtin_sinhf" (floatType, [ floatType ], false);
- H.add h "__builtin_sinhl" (longDoubleType, [ longDoubleType ], false);
-
- H.add h "__builtin_sqrt" (doubleType, [ doubleType ], false);
- H.add h "__builtin_sqrtf" (floatType, [ floatType ], false);
- H.add h "__builtin_sqrtl" (longDoubleType, [ longDoubleType ], false);
-
- H.add h "__builtin_stpcpy" (charPtrType, [ charPtrType; charConstPtrType ], false);
- H.add h "__builtin_strchr" (charPtrType, [ charPtrType; charType ], false);
- H.add h "__builtin_strcmp" (intType, [ charConstPtrType; charConstPtrType ], false);
- H.add h "__builtin_strcpy" (charPtrType, [ charPtrType; charConstPtrType ], false);
- H.add h "__builtin_strcspn" (uintType, [ charConstPtrType; charConstPtrType ], false);
- H.add h "__builtin_strncat" (charPtrType, [ charPtrType; charConstPtrType; sizeType ], false);
- H.add h "__builtin_strncmp" (intType, [ charConstPtrType; charConstPtrType; sizeType ], false);
- H.add h "__builtin_strncpy" (charPtrType, [ charPtrType; charConstPtrType; sizeType ], false);
- H.add h "__builtin_strspn" (intType, [ charConstPtrType; charConstPtrType ], false);
- H.add h "__builtin_strpbrk" (charPtrType, [ charConstPtrType; charConstPtrType ], false);
- (* When we parse builtin_types_compatible_p, we change its interface *)
- H.add h "__builtin_types_compatible_p"
- (intType, [ uintType; (* Sizeof the type *)
- uintType (* Sizeof the type *) ],
- false);
- H.add h "__builtin_tan" (doubleType, [ doubleType ], false);
- H.add h "__builtin_tanf" (floatType, [ floatType ], false);
- H.add h "__builtin_tanl" (longDoubleType, [ longDoubleType ], false);
-
- H.add h "__builtin_tanh" (doubleType, [ doubleType ], false);
- H.add h "__builtin_tanhf" (floatType, [ floatType ], false);
- H.add h "__builtin_tanhl" (longDoubleType, [ longDoubleType ], false);
-
-
- if hasbva then begin
- H.add h "__builtin_va_end" (voidType, [ TBuiltin_va_list [] ], false);
- H.add h "__builtin_varargs_start"
- (voidType, [ TBuiltin_va_list [] ], false);
- H.add h "__builtin_va_start" (voidType, [ TBuiltin_va_list [] ], false);
- (* When we parse builtin_stdarg_start, we drop the second argument *)
- H.add h "__builtin_stdarg_start" (voidType, [ TBuiltin_va_list []; ],
- false);
- (* When we parse builtin_va_arg we change its interface *)
- H.add h "__builtin_va_arg" (voidType, [ TBuiltin_va_list [];
- uintType; (* Sizeof the type *)
- voidPtrType; (* Ptr to res *) ],
- false);
- H.add h "__builtin_va_copy" (voidType, [ TBuiltin_va_list [];
- TBuiltin_va_list [] ],
- false);
- end;
- h
-
-(** Construct a hash with the builtins *)
-let msvcBuiltins : (string, typ * typ list * bool) H.t =
- (* These are empty for now but can be added to depending on the application*)
- let h = H.create 17 in
- (** Take a number of wide string literals *)
- H.add h "__annotation" (voidType, [ ], true);
- h
-
-
-
-let pTypeSig : (typ -> typsig) ref =
- ref (fun _ -> E.s (E.bug "pTypeSig not initialized"))
-
-
-(** A printer interface for CIL trees. Create instantiations of
- * this type by specializing the class {!Cil.defaultCilPrinter}. *)
-class type cilPrinter = object
- method pVDecl: unit -> varinfo -> doc
- (** Invoked for each variable declaration. Note that variable
- * declarations are all the [GVar], [GVarDecl], [GFun], all the [varinfo]
- * in formals of function types, and the formals and locals for function
- * definitions. *)
-
- method pVar: varinfo -> doc
- (** Invoked on each variable use. *)
-
- method pLval: unit -> lval -> doc
- (** Invoked on each lvalue occurence *)
-
- method pOffset: doc -> offset -> doc
- (** Invoked on each offset occurence. The second argument is the base. *)
-
- method pInstr: unit -> instr -> doc
- (** Invoked on each instruction occurrence. *)
-
- method pStmt: unit -> stmt -> doc
- (** Control-flow statement. This is used by
- * {!Cil.printGlobal} and by {!Cil.dumpGlobal}. *)
-
- method dStmt: out_channel -> int -> stmt -> unit
- (** Dump a control-flow statement to a file with a given indentation. This is used by
- * {!Cil.dumpGlobal}. *)
-
- method dBlock: out_channel -> int -> block -> unit
- (** Dump a control-flow block to a file with a given indentation. This is
- * used by {!Cil.dumpGlobal}. *)
-
- method pBlock: unit -> block -> Pretty.doc
- (** Print a block. *)
-
- method pGlobal: unit -> global -> doc
- (** Global (vars, types, etc.). This can be slow and is used only by
- * {!Cil.printGlobal} but by {!Cil.dumpGlobal} for everything else except
- * [GVar] and [GFun]. *)
-
- method dGlobal: out_channel -> global -> unit
- (** Dump a global to a file. This is used by {!Cil.dumpGlobal}. *)
-
- method pFieldDecl: unit -> fieldinfo -> doc
- (** A field declaration *)
-
- method pType: doc option -> unit -> typ -> doc
- (* Use of some type in some declaration. The first argument is used to print
- * the declared element, or is None if we are just printing a type with no
- * name being decalred. Note that for structure/union and enumeration types
- * the definition of the composite type is not visited. Use [vglob] to
- * visit it. *)
-
- method pAttr: attribute -> doc * bool
- (** Attribute. Also return an indication whether this attribute must be
- * printed inside the __attribute__ list or not. *)
-
- method pAttrParam: unit -> attrparam -> doc
- (** Attribute paramter *)
-
- method pAttrs: unit -> attributes -> doc
- (** Attribute lists *)
-
- method pLabel: unit -> label -> doc
- (** Label *)
-
- method pLineDirective: ?forcefile:bool -> location -> Pretty.doc
- (** Print a line-number. This is assumed to come always on an empty line.
- * If the forcefile argument is present and is true then the file name
- * will be printed always. Otherwise the file name is printed only if it
- * is different from the last time time this function is called. The last
- * file name is stored in a private field inside the cilPrinter object. *)
-
- method pStmtKind : stmt -> unit -> stmtkind -> Pretty.doc
- (** Print a statement kind. The code to be printed is given in the
- * {!Cil.stmtkind} argument. The initial {!Cil.stmt} argument
- * records the statement which follows the one being printed;
- * {!Cil.defaultCilPrinterClass} uses this information to prettify
- * statement printing in certain special cases. *)
-
- method pExp: unit -> exp -> doc
- (** Print expressions *)
-
- method pInit: unit -> init -> doc
- (** Print initializers. This can be slow and is used by
- * {!Cil.printGlobal} but not by {!Cil.dumpGlobal}. *)
-
- method dInit: out_channel -> int -> init -> unit
- (** Dump a global to a file with a given indentation. This is used by
- * {!Cil.dumpGlobal}. *)
-end
-
-
-class defaultCilPrinterClass : cilPrinter = object (self)
- val mutable currentFormals : varinfo list = []
- method private getLastNamedArgument (s: string) : exp =
- match List.rev currentFormals with
- f :: _ -> Lval (var f)
- | [] ->
- E.s (warn "Cannot find the last named argument when priting call to %s\n" s)
-
- (*** VARIABLES ***)
- (* variable use *)
- method pVar (v:varinfo) = text v.vname
-
- (* variable declaration *)
- method pVDecl () (v:varinfo) =
- let stom, rest = separateStorageModifiers v.vattr in
- (* First the storage modifiers *)
- text (if v.vinline then "__inline " else "")
- ++ d_storage () v.vstorage
- ++ (self#pAttrs () stom)
- ++ (self#pType (Some (text v.vname)) () v.vtype)
- ++ text " "
- ++ self#pAttrs () rest
-
- (*** L-VALUES ***)
- method pLval () (lv:lval) = (* lval (base is 1st field) *)
- match lv with
- Var vi, o -> self#pOffset (self#pVar vi) o
- | Mem e, Field(fi, o) ->
- self#pOffset
- ((self#pExpPrec arrowLevel () e) ++ text ("->" ^ fi.fname)) o
- | Mem e, o ->
- self#pOffset
- (text "(*" ++ self#pExpPrec derefStarLevel () e ++ text ")") o
-
- (** Offsets **)
- method pOffset (base: doc) = function
- | NoOffset -> base
- | Field (fi, o) ->
- self#pOffset (base ++ text "." ++ text fi.fname) o
- | Index (e, o) ->
- self#pOffset (base ++ text "[" ++ self#pExp () e ++ text "]") o
-
- method private pLvalPrec (contextprec: int) () lv =
- if getParenthLevel (Lval(lv)) >= contextprec then
- text "(" ++ self#pLval () lv ++ text ")"
- else
- self#pLval () lv
-
- (*** EXPRESSIONS ***)
- method pExp () (e: exp) : doc =
- let level = getParenthLevel e in
- match e with
- Const(c) -> d_const () c
- | Lval(l) -> self#pLval () l
- | UnOp(u,e1,_) ->
- (d_unop () u) ++ chr ' ' ++ (self#pExpPrec level () e1)
-
- | BinOp(b,e1,e2,_) ->
- align
- ++ (self#pExpPrec level () e1)
- ++ chr ' '
- ++ (d_binop () b)
- ++ chr ' '
- ++ (self#pExpPrec level () e2)
- ++ unalign
-
- | CastE(t,e) ->
- text "("
- ++ self#pType None () t
- ++ text ")"
- ++ self#pExpPrec level () e
-
- | SizeOf (t) ->
- text "sizeof(" ++ self#pType None () t ++ chr ')'
- | SizeOfE (e) ->
- text "sizeof(" ++ self#pExp () e ++ chr ')'
-
- | SizeOfStr s ->
- text "sizeof(" ++ d_const () (CStr s) ++ chr ')'
-
- | AlignOf (t) ->
- text "__alignof__(" ++ self#pType None () t ++ chr ')'
- | AlignOfE (e) ->
- text "__alignof__(" ++ self#pExp () e ++ chr ')'
- | AddrOf(lv) ->
- text "& " ++ (self#pLvalPrec addrOfLevel () lv)
-
- | StartOf(lv) -> self#pLval () lv
-
- method private pExpPrec (contextprec: int) () (e: exp) =
- let thisLevel = getParenthLevel e in
- let needParens =
- if thisLevel >= contextprec then
- true
- else if contextprec == bitwiseLevel then
- (* quiet down some GCC warnings *)
- thisLevel == additiveLevel || thisLevel == comparativeLevel
- else
- false
- in
- if needParens then
- chr '(' ++ self#pExp () e ++ chr ')'
- else
- self#pExp () e
-
- method pInit () = function
- SingleInit e -> self#pExp () e
- | CompoundInit (t, initl) ->
- (* We do not print the type of the Compound *)
-(*
- let dinit e = d_init () e in
- dprintf "{@[%a@]}"
- (docList ~sep:(chr ',' ++ break) dinit) initl
-*)
- let printDesignator =
- if not !msvcMode then begin
- (* Print only for union when we do not initialize the first field *)
- match unrollType t, initl with
- TComp(ci, _), [(Field(f, NoOffset), _)] ->
- if not (ci.cstruct) && ci.cfields != [] &&
- (List.hd ci.cfields) != f then
- true
- else
- false
- | _ -> false
- end else
- false
- in
- let d_oneInit = function
- Field(f, NoOffset), i ->
- (if printDesignator then
- text ("." ^ f.fname ^ " = ")
- else nil) ++ self#pInit () i
- | Index(e, NoOffset), i ->
- (if printDesignator then
- text "[" ++ self#pExp () e ++ text "] = " else nil) ++
- self#pInit () i
- | _ -> E.s (unimp "Trying to print malformed initializer")
- in
- chr '{' ++ (align
- ++ ((docList ~sep:(chr ',' ++ break) d_oneInit) () initl)
- ++ unalign)
- ++ chr '}'
-(*
- | ArrayInit (_, _, il) ->
- chr '{' ++ (align
- ++ ((docList (chr ',' ++ break) (self#pInit ())) () il)
- ++ unalign)
- ++ chr '}'
-*)
- (* dump initializers to a file. *)
- method dInit (out: out_channel) (ind: int) (i: init) =
- (* Dump an array *)
- let dumpArray (bt: typ) (il: 'a list) (getelem: 'a -> init) =
- let onALine = (* How many elements on a line *)
- match unrollType bt with TComp _ | TArray _ -> 1 | _ -> 4
- in
- let rec outputElements (isfirst: bool) (room_on_line: int) = function
- [] -> output_string out "}"
- | (i: 'a) :: rest ->
- if not isfirst then output_string out ", ";
- let new_room_on_line =
- if room_on_line == 0 then begin
- output_string out "\n"; output_string out (String.make ind ' ');
- onALine - 1
- end else
- room_on_line - 1
- in
- self#dInit out (ind + 2) (getelem i);
- outputElements false new_room_on_line rest
- in
- output_string out "{ ";
- outputElements true onALine il
- in
- match i with
- SingleInit e ->
- fprint out !lineLength (indent ind (self#pExp () e))
- | CompoundInit (t, initl) -> begin
- match unrollType t with
- TArray(bt, _, _) ->
- dumpArray bt initl (fun (_, i) -> i)
- | _ ->
- (* Now a structure or a union *)
- fprint out !lineLength (indent ind (self#pInit () i))
- end
-(*
- | ArrayInit (bt, len, initl) -> begin
- (* If the base type does not contain structs then use the pInit
- match unrollType bt with
- TComp _ | TArray _ ->
- dumpArray bt initl (fun x -> x)
- | _ -> *)
- fprint out !lineLength (indent ind (self#pInit () i))
- end
-*)
-
- (** What terminator to print after an instruction. sometimes we want to
- * print sequences of instructions separated by comma *)
- val mutable printInstrTerminator = ";"
-
- (*** INSTRUCTIONS ****)
- method pInstr () (i:instr) = (* imperative instruction *)
- match i with
- | Set(lv,e,l) -> begin
- (* Be nice to some special cases *)
- match e with
- BinOp((PlusA|PlusPI|IndexPI),Lval(lv'), Const(CInt64(one,_,_)),_)
- when Util.equals lv lv' && one = Int64.one && not !printCilAsIs ->
- self#pLineDirective l
- ++ self#pLval () lv
- ++ text (" ++" ^ printInstrTerminator)
-
- | BinOp((MinusA|MinusPI),Lval(lv'),
- Const(CInt64(one,_,_)), _)
- when Util.equals lv lv' && one = Int64.one && not !printCilAsIs ->
- self#pLineDirective l
- ++ self#pLval () lv
- ++ text (" --" ^ printInstrTerminator)
-
- | BinOp((PlusA|PlusPI|IndexPI),Lval(lv'),Const(CInt64(mone,_,_)),_)
- when Util.equals lv lv' && mone = Int64.minus_one
- && not !printCilAsIs ->
- self#pLineDirective l
- ++ self#pLval () lv
- ++ text (" --" ^ printInstrTerminator)
-
- | BinOp((PlusA|PlusPI|IndexPI|MinusA|MinusPP|MinusPI|BAnd|BOr|BXor|
- Mult|Div|Mod|Shiftlt|Shiftrt) as bop,
- Lval(lv'),e,_) when Util.equals lv lv' ->
- self#pLineDirective l
- ++ self#pLval () lv
- ++ text " " ++ d_binop () bop
- ++ text "= "
- ++ self#pExp () e
- ++ text printInstrTerminator
-
- | _ ->
- self#pLineDirective l
- ++ self#pLval () lv
- ++ text " = "
- ++ self#pExp () e
- ++ text printInstrTerminator
-
- end
- (* In cabs2cil we have turned the call to builtin_va_arg into a
- * three-argument call: the last argument is the address of the
- * destination *)
- | Call(None, Lval(Var vi, NoOffset), [dest; SizeOf t; adest], l)
- when vi.vname = "__builtin_va_arg" && not !printCilAsIs ->
- let destlv = match stripCasts adest with
- AddrOf destlv -> destlv
- | _ -> E.s (E.error "Encountered unexpected call to %s\n" vi.vname)
- in
- self#pLineDirective l
- ++ self#pLval () destlv ++ text " = "
-
- (* Now the function name *)
- ++ text "__builtin_va_arg"
- ++ text "(" ++ (align
- (* Now the arguments *)
- ++ self#pExp () dest
- ++ chr ',' ++ break
- ++ self#pType None () t
- ++ unalign)
- ++ text (")" ^ printInstrTerminator)
-
- (* In cabs2cil we have dropped the last argument in the call to
- * __builtin_stdarg_start. *)
- | Call(None, Lval(Var vi, NoOffset), [marker], l)
- when vi.vname = "__builtin_stdarg_start" && not !printCilAsIs -> begin
- let last = self#getLastNamedArgument vi.vname in
- self#pInstr () (Call(None,Lval(Var vi,NoOffset),[marker; last],l))
- end
-
- (* In cabs2cil we have dropped the last argument in the call to
- * __builtin_next_arg. *)
- | Call(res, Lval(Var vi, NoOffset), [ ], l)
- when vi.vname = "__builtin_next_arg" && not !printCilAsIs -> begin
- let last = self#getLastNamedArgument vi.vname in
- self#pInstr () (Call(res,Lval(Var vi,NoOffset),[last],l))
- end
-
- (* In cparser we have turned the call to
- * __builtin_types_compatible_p(t1, t2) into
- * __builtin_types_compatible_p(sizeof t1, sizeof t2), so that we can
- * represent the types as expressions.
- * Remove the sizeofs when printing. *)
- | Call(dest, Lval(Var vi, NoOffset), [SizeOf t1; SizeOf t2], l)
- when vi.vname = "__builtin_types_compatible_p" && not !printCilAsIs ->
- self#pLineDirective l
- (* Print the destination *)
- ++ (match dest with
- None -> nil
- | Some lv -> self#pLval () lv ++ text " = ")
- (* Now the call itself *)
- ++ dprintf "%s(%a, %a)" vi.vname
- (self#pType None) t1 (self#pType None) t2
- ++ text printInstrTerminator
- | Call(_, Lval(Var vi, NoOffset), _, l)
- when vi.vname = "__builtin_types_compatible_p" && not !printCilAsIs ->
- E.s (bug "__builtin_types_compatible_p: cabs2cil should have added sizeof to the arguments.")
-
- | Call(dest,e,args,l) ->
- self#pLineDirective l
- ++ (match dest with
- None -> nil
- | Some lv ->
- self#pLval () lv ++ text " = " ++
- (* Maybe we need to print a cast *)
- (let destt = typeOfLval lv in
- match unrollType (typeOf e) with
- TFun (rt, _, _, _)
- when not (Util.equals (!pTypeSig rt)
- (!pTypeSig destt)) ->
- text "(" ++ self#pType None () destt ++ text ")"
- | _ -> nil))
- (* Now the function name *)
- ++ (let ed = self#pExp () e in
- match e with
- Lval(Var _, _) -> ed
- | _ -> text "(" ++ ed ++ text ")")
- ++ text "(" ++
- (align
- (* Now the arguments *)
- ++ (docList ~sep:(chr ',' ++ break)
- (self#pExp ()) () args)
- ++ unalign)
- ++ text (")" ^ printInstrTerminator)
-
- | Asm(attrs, tmpls, outs, ins, clobs, l) ->
- if !msvcMode then
- self#pLineDirective l
- ++ text "__asm {"
- ++ (align
- ++ (docList ~sep:line text () tmpls)
- ++ unalign)
- ++ text ("}" ^ printInstrTerminator)
- else
- self#pLineDirective l
- ++ text ("__asm__ ")
- ++ self#pAttrs () attrs
- ++ text " ("
- ++ (align
- ++ (docList ~sep:line
- (fun x -> text ("\"" ^ escape_string x ^ "\""))
- () tmpls)
- ++
- (if outs = [] && ins = [] && clobs = [] then
- chr ':'
- else
- (text ": "
- ++ (docList ~sep:(chr ',' ++ break)
- (fun (c, lv) ->
- text ("\"" ^ escape_string c ^ "\" (")
- ++ self#pLval () lv
- ++ text ")") () outs)))
- ++
- (if ins = [] && clobs = [] then
- nil
- else
- (text ": "
- ++ (docList ~sep:(chr ',' ++ break)
- (fun (c, e) ->
- text ("\"" ^ escape_string c ^ "\" (")
- ++ self#pExp () e
- ++ text ")") () ins)))
- ++
- (if clobs = [] then nil
- else
- (text ": "
- ++ (docList ~sep:(chr ',' ++ break)
- (fun c -> text ("\"" ^ escape_string c ^ "\""))
- ()
- clobs)))
- ++ unalign)
- ++ text (")" ^ printInstrTerminator)
-
-
- (**** STATEMENTS ****)
- method pStmt () (s:stmt) = (* control-flow statement *)
- self#pStmtNext invalidStmt () s
-
- method dStmt (out: out_channel) (ind: int) (s:stmt) : unit =
- fprint out !lineLength (indent ind (self#pStmt () s))
-
- method dBlock (out: out_channel) (ind: int) (b:block) : unit =
- fprint out !lineLength (indent ind (align ++ self#pBlock () b))
-
- method private pStmtNext (next: stmt) () (s: stmt) =
- (* print the labels *)
- ((docList ~sep:line (fun l -> self#pLabel () l)) () s.labels)
- (* print the statement itself. If the labels are non-empty and the
- * statement is empty, print a semicolon *)
- ++
- (if s.skind = Instr [] && s.labels <> [] then
- text ";"
- else
- (if s.labels <> [] then line else nil)
- ++ self#pStmtKind next () s.skind)
-
- method private pLabel () = function
- Label (s, _, true) -> text (s ^ ": ")
- | Label (s, _, false) -> text (s ^ ": /* CIL Label */ ")
- | Case (e, _) -> text "case " ++ self#pExp () e ++ text ": "
- | Default _ -> text "default: "
-
- (* The pBlock will put the unalign itself *)
- method pBlock () (blk: block) =
- let rec dofirst () = function
- [] -> nil
- | [x] -> self#pStmtNext invalidStmt () x
- | x :: rest -> dorest nil x rest
- and dorest acc prev = function
- [] -> acc ++ (self#pStmtNext invalidStmt () prev)
- | x :: rest ->
- dorest (acc ++ (self#pStmtNext x () prev) ++ line)
- x rest
- in
- (* Let the host of the block decide on the alignment. The d_block will
- * pop the alignment as well *)
- text "{"
- ++
- (if blk.battrs <> [] then
- self#pAttrsGen true blk.battrs
- else nil)
- ++ line
- ++ (dofirst () blk.bstmts)
- ++ unalign ++ line ++ text "}"
-
-
- (* Store here the name of the last file printed in a line number. This is
- * private to the object *)
- val mutable lastFileName = ""
- (* Make sure that you only call self#pLineDirective on an empty line *)
- method pLineDirective ?(forcefile=false) l =
- currentLoc := l;
- match !lineDirectiveStyle with
- | Some style when l.line > 0 ->
- let directive =
- match style with
- | LineComment -> text "//#line "
- | LinePreprocessorOutput when not !msvcMode -> chr '#'
- | _ -> text "#line"
- in
- let filename =
- if forcefile || l.file <> lastFileName then
- begin
- lastFileName <- l.file;
- text " \"" ++ text l.file ++ text "\""
- end
- else
- nil
- in
- leftflush ++ directive ++ chr ' ' ++ num l.line ++ filename ++ line
- | _ ->
- nil
-
-
- method private pStmtKind (next: stmt) () = function
- Return(None, l) ->
- self#pLineDirective l
- ++ text "return;"
-
- | Return(Some e, l) ->
- self#pLineDirective l
- ++ text "return ("
- ++ self#pExp () e
- ++ text ");"
-
- | Goto (sref, l) -> begin
- (* Grab one of the labels *)
- let rec pickLabel = function
- [] -> None
- | Label (l, _, _) :: _ -> Some l
- | _ :: rest -> pickLabel rest
- in
- match pickLabel !sref.labels with
- Some l -> text ("goto " ^ l ^ ";")
- | None ->
- ignore (error "Cannot find label for target of goto\n");
- text "goto __invalid_label;"
- end
-
- | Break l ->
- self#pLineDirective l
- ++ text "break;"
-
- | Continue l ->
- self#pLineDirective l
- ++ text "continue;"
-
- | Instr il ->
- align
- ++ (docList ~sep:line (fun i -> self#pInstr () i) () il)
- ++ unalign
-
- | If(be,t,{bstmts=[];battrs=[]},l) when not !printCilAsIs ->
- self#pLineDirective l
- ++ text "if"
- ++ (align
- ++ text " ("
- ++ self#pExp () be
- ++ text ") "
- ++ self#pBlock () t)
-
- | If(be,t,{bstmts=[{skind=Goto(gref,_);labels=[]}];
- battrs=[]},l)
- when !gref == next && not !printCilAsIs ->
- self#pLineDirective l
- ++ text "if"
- ++ (align
- ++ text " ("
- ++ self#pExp () be
- ++ text ") "
- ++ self#pBlock () t)
-
- | If(be,{bstmts=[];battrs=[]},e,l) when not !printCilAsIs ->
- self#pLineDirective l
- ++ text "if"
- ++ (align
- ++ text " ("
- ++ self#pExp () (UnOp(LNot,be,intType))
- ++ text ") "
- ++ self#pBlock () e)
-
- | If(be,{bstmts=[{skind=Goto(gref,_);labels=[]}];
- battrs=[]},e,l)
- when !gref == next && not !printCilAsIs ->
- self#pLineDirective l
- ++ text "if"
- ++ (align
- ++ text " ("
- ++ self#pExp () (UnOp(LNot,be,intType))
- ++ text ") "
- ++ self#pBlock () e)
-
- | If(be,t,e,l) ->
- self#pLineDirective l
- ++ (align
- ++ text "if"
- ++ (align
- ++ text " ("
- ++ self#pExp () be
- ++ text ") "
- ++ self#pBlock () t)
- ++ text " " (* sm: indent next code 2 spaces (was 4) *)
- ++ (align
- ++ text "else "
- ++ self#pBlock () e)
- ++ unalign)
-
- | Switch(e,b,_,l) ->
- self#pLineDirective l
- ++ (align
- ++ text "switch ("
- ++ self#pExp () e
- ++ text ") "
- ++ self#pBlock () b)
-
-(*
- | Loop(b, l, _, _) -> begin
- (* Maybe the first thing is a conditional. Turn it into a WHILE *)
- try
- let term, bodystmts =
- let rec skipEmpty = function
- [] -> []
- | {skind=Instr [];labels=[]} :: rest -> skipEmpty rest
- | x -> x
- in
- (* Bill McCloskey: Do not remove the If if it has labels *)
- match skipEmpty b.bstmts with
- {skind=If(e,tb,fb,_); labels=[]} :: rest
- when not !printCilAsIs -> begin
- match skipEmpty tb.bstmts, skipEmpty fb.bstmts with
- [], {skind=Break _; labels=[]} :: _ -> e, rest
- | {skind=Break _; labels=[]} :: _, []
- -> UnOp(LNot, e, intType), rest
- | _ -> raise Not_found
- end
- | _ -> raise Not_found
- in
- self#pLineDirective l
- ++ text "wh"
- ++ (align
- ++ text "ile ("
- ++ self#pExp () term
- ++ text ") "
- ++ self#pBlock () {bstmts=bodystmts; battrs=b.battrs})
-
- with Not_found ->
- self#pLineDirective l
- ++ text "wh"
- ++ (align
- ++ text "ile (1) "
- ++ self#pBlock () b)
- end
-*)
-
- | While (e, b, l) ->
- self#pLineDirective l
- ++ (align
- ++ text "while ("
- ++ self#pExp () e
- ++ text ") "
- ++ self#pBlock () b)
-
- | DoWhile (e, b, l) ->
- self#pLineDirective l
- ++ (align
- ++ text "do "
- ++ self#pBlock () b
- ++ text " while ("
- ++ self#pExp () e
- ++ text ");")
-
- | For (bInit, e, bIter, b, l) ->
- ignore (E.warn
- "in for loops, the 1st and 3rd expressions are not printed");
- self#pLineDirective l
- ++ (align
- ++ text "for ("
- ++ text "/* ??? */" (* self#pBlock () bInit *)
- ++ text "; "
- ++ self#pExp () e
- ++ text "; "
- ++ text "/* ??? */" (* self#pBlock() bIter *)
- ++ text ") "
- ++ self#pBlock () b)
-
- | Block b -> align ++ self#pBlock () b
-
- | TryFinally (b, h, l) ->
- self#pLineDirective l
- ++ text "__try "
- ++ align
- ++ self#pBlock () b
- ++ text " __fin" ++ align ++ text "ally "
- ++ self#pBlock () h
-
- | TryExcept (b, (il, e), h, l) ->
- self#pLineDirective l
- ++ text "__try "
- ++ align
- ++ self#pBlock () b
- ++ text " __e" ++ align ++ text "xcept(" ++ line
- ++ align
- (* Print the instructions but with a comma at the end, instead of
- * semicolon *)
- ++ (printInstrTerminator <- ",";
- let res =
- (docList ~sep:line (self#pInstr ())
- () il)
- in
- printInstrTerminator <- ";";
- res)
- ++ self#pExp () e
- ++ text ") " ++ unalign
- ++ self#pBlock () h
-
-
- (*** GLOBALS ***)
- method pGlobal () (g:global) : doc = (* global (vars, types, etc.) *)
- match g with
- | GFun (fundec, l) ->
- (* If the function has attributes then print a prototype because
- * GCC cannot accept function attributes in a definition *)
- let oldattr = fundec.svar.vattr in
- (* Always pring the file name before function declarations *)
- let proto =
- if oldattr <> [] then
- (self#pLineDirective l) ++ (self#pVDecl () fundec.svar)
- ++ chr ';' ++ line
- else nil in
- (* Temporarily remove the function attributes *)
- fundec.svar.vattr <- [];
- let body = (self#pLineDirective ~forcefile:true l)
- ++ (self#pFunDecl () fundec) in
- fundec.svar.vattr <- oldattr;
- proto ++ body ++ line
-
- | GType (typ, l) ->
- self#pLineDirective ~forcefile:true l ++
- text "typedef "
- ++ (self#pType (Some (text typ.tname)) () typ.ttype)
- ++ text ";\n"
-
- | GEnumTag (enum, l) ->
- self#pLineDirective l ++
- text "enum" ++ align ++ text (" " ^ enum.ename) ++
- text " {" ++ line
- ++ (docList ~sep:(chr ',' ++ line)
- (fun (n,i, loc) ->
- text (n ^ " = ")
- ++ self#pExp () i)
- () enum.eitems)
- ++ unalign ++ line ++ text "} "
- ++ self#pAttrs () enum.eattr ++ text";\n"
-
- | GEnumTagDecl (enum, l) -> (* This is a declaration of a tag *)
- self#pLineDirective l ++
- text ("enum " ^ enum.ename ^ ";\n")
-
- | GCompTag (comp, l) -> (* This is a definition of a tag *)
- let n = comp.cname in
- let su, su1, su2 =
- if comp.cstruct then "struct", "str", "uct"
- else "union", "uni", "on"
- in
- let sto_mod, rest_attr = separateStorageModifiers comp.cattr in
- self#pLineDirective ~forcefile:true l ++
- text su1 ++ (align ++ text su2 ++ chr ' ' ++ (self#pAttrs () sto_mod)
- ++ text n
- ++ text " {" ++ line
- ++ ((docList ~sep:line (self#pFieldDecl ())) ()
- comp.cfields)
- ++ unalign)
- ++ line ++ text "}" ++
- (self#pAttrs () rest_attr) ++ text ";\n"
-
- | GCompTagDecl (comp, l) -> (* This is a declaration of a tag *)
- self#pLineDirective l ++
- text (compFullName comp) ++ text ";\n"
-
- | GVar (vi, io, l) ->
- self#pLineDirective ~forcefile:true l ++
- self#pVDecl () vi
- ++ chr ' '
- ++ (match io.init with
- None -> nil
- | Some i -> text " = " ++
- (let islong =
- match i with
- CompoundInit (_, il) when List.length il >= 8 -> true
- | _ -> false
- in
- if islong then
- line ++ self#pLineDirective l ++ text " "
- else nil) ++
- (self#pInit () i))
- ++ text ";\n"
-
- (* print global variable 'extern' declarations, and function prototypes *)
- | GVarDecl (vi, l) ->
- self#pLineDirective l ++
- (self#pVDecl () vi)
- ++ text ";\n"
-
- | GAsm (s, l) ->
- self#pLineDirective l ++
- text ("__asm__(\"" ^ escape_string s ^ "\");\n")
-
- | GPragma (Attr(an, args), l) ->
- (* sm: suppress printing pragmas that gcc does not understand *)
- (* assume anything starting with "ccured" is ours *)
- (* also don't print the 'combiner' pragma *)
- (* nor 'cilnoremove' *)
- let suppress =
- not !print_CIL_Input &&
- not !msvcMode &&
- ((startsWith "box" an) ||
- (startsWith "ccured" an) ||
- (an = "merger") ||
- (an = "cilnoremove")) in
- let d =
- match an, args with
- | _, [] ->
- text an
- | "weak", [ACons (symbol, [])] ->
- text "weak " ++ text symbol
- | _ ->
- text (an ^ "(")
- ++ docList ~sep:(chr ',') (self#pAttrParam ()) () args
- ++ text ")"
- in
- self#pLineDirective l
- ++ (if suppress then text "/* " else text "")
- ++ (text "#pragma ")
- ++ d
- ++ (if suppress then text " */\n" else text "\n")
-
- | GText s ->
- if s <> "//" then
- text s ++ text "\n"
- else
- nil
-
-
- method dGlobal (out: out_channel) (g: global) : unit =
- (* For all except functions and variable with initializers, use the
- * pGlobal *)
- match g with
- GFun (fdec, l) ->
- (* If the function has attributes then print a prototype because
- * GCC cannot accept function attributes in a definition *)
- let oldattr = fdec.svar.vattr in
- let proto =
- if oldattr <> [] then
- (self#pLineDirective l) ++ (self#pVDecl () fdec.svar)
- ++ chr ';' ++ line
- else nil in
- fprint out !lineLength
- (proto ++ (self#pLineDirective ~forcefile:true l));
- (* Temporarily remove the function attributes *)
- fdec.svar.vattr <- [];
- fprint out !lineLength (self#pFunDecl () fdec);
- fdec.svar.vattr <- oldattr;
- output_string out "\n"
-
- | GVar (vi, {init = Some i}, l) -> begin
- fprint out !lineLength
- (self#pLineDirective ~forcefile:true l ++
- self#pVDecl () vi
- ++ text " = "
- ++ (let islong =
- match i with
- CompoundInit (_, il) when List.length il >= 8 -> true
- | _ -> false
- in
- if islong then
- line ++ self#pLineDirective l ++ text " "
- else nil));
- self#dInit out 3 i;
- output_string out ";\n"
- end
-
- | g -> fprint out !lineLength (self#pGlobal () g)
-
- method pFieldDecl () fi =
- (self#pType
- (Some (text (if fi.fname = missingFieldName then "" else fi.fname)))
- ()
- fi.ftype)
- ++ text " "
- ++ (match fi.fbitfield with None -> nil
- | Some i -> text ": " ++ num i ++ text " ")
- ++ self#pAttrs () fi.fattr
- ++ text ";"
-
- method private pFunDecl () f =
- self#pVDecl () f.svar
- ++ line
- ++ text "{ "
- ++ (align
- (* locals. *)
- ++ (docList ~sep:line (fun vi -> self#pVDecl () vi ++ text ";")
- () f.slocals)
- ++ line ++ line
- (* the body *)
- ++ ((* remember the declaration *) currentFormals <- f.sformals;
- let body = self#pBlock () f.sbody in
- currentFormals <- [];
- body))
- ++ line
- ++ text "}"
-
- (***** PRINTING DECLARATIONS and TYPES ****)
-
- method pType (nameOpt: doc option) (* Whether we are declaring a name or
- * we are just printing a type *)
- () (t:typ) = (* use of some type *)
- let name = match nameOpt with None -> nil | Some d -> d in
- let printAttributes (a: attributes) =
- let pa = self#pAttrs () a in
- match nameOpt with
- | None when not !print_CIL_Input && not !msvcMode ->
- (* Cannot print the attributes in this case because gcc does not
- * like them here, except if we are printing for CIL, or for MSVC.
- * In fact, for MSVC we MUST print attributes such as __stdcall *)
- if pa = nil then nil else
- text "/*" ++ pa ++ text "*/"
- | _ -> pa
- in
- match t with
- TVoid a ->
- text "void"
- ++ self#pAttrs () a
- ++ text " "
- ++ name
-
- | TInt (ikind,a) ->
- d_ikind () ikind
- ++ self#pAttrs () a
- ++ text " "
- ++ name
-
- | TFloat(fkind, a) ->
- d_fkind () fkind
- ++ self#pAttrs () a
- ++ text " "
- ++ name
-
- | TComp (comp, a) -> (* A reference to a struct *)
- let su = if comp.cstruct then "struct" else "union" in
- text (su ^ " " ^ comp.cname ^ " ")
- ++ self#pAttrs () a
- ++ name
-
- | TEnum (enum, a) ->
- text ("enum " ^ enum.ename ^ " ")
- ++ self#pAttrs () a
- ++ name
- | TPtr (bt, a) ->
- (* Parenthesize the ( * attr name) if a pointer to a function or an
- * array. However, on MSVC the __stdcall modifier must appear right
- * before the pointer constructor "(__stdcall *f)". We push them into
- * the parenthesis. *)
- let (paren: doc option), (bt': typ) =
- match bt with
- TFun(rt, args, isva, fa) when !msvcMode ->
- let an, af', at = partitionAttributes ~default:AttrType fa in
- (* We take the af' and we put them into the parentheses *)
- Some (text "(" ++ printAttributes af'),
- TFun(rt, args, isva, addAttributes an at)
-
- | TFun _ | TArray _ -> Some (text "("), bt
-
- | _ -> None, bt
- in
- let name' = text "*" ++ printAttributes a ++ name in
- let name'' = (* Put the parenthesis *)
- match paren with
- Some p -> p ++ name' ++ text ")"
- | _ -> name'
- in
- self#pType
- (Some name'')
- ()
- bt'
-
- | TArray (elemt, lo, a) ->
- (* ignore the const attribute for arrays *)
- let a' = dropAttributes [ "const" ] a in
- let name' =
- if a' == [] then name else
- if nameOpt == None then printAttributes a' else
- text "(" ++ printAttributes a' ++ name ++ text ")"
- in
- self#pType
- (Some (name'
- ++ text "["
- ++ (match lo with None -> nil | Some e -> self#pExp () e)
- ++ text "]"))
- ()
- elemt
-
- | TFun (restyp, args, isvararg, a) ->
- let name' =
- if a == [] then name else
- if nameOpt == None then printAttributes a else
- text "(" ++ printAttributes a ++ name ++ text ")"
- in
- self#pType
- (Some
- (name'
- ++ text "("
- ++ (align
- ++
- (if args = Some [] && isvararg then
- text "..."
- else
- (if args = None then nil
- else if args = Some [] then text "void"
- else
- let pArg (aname, atype, aattr) =
- let stom, rest = separateStorageModifiers aattr in
- (* First the storage modifiers *)
- (self#pAttrs () stom)
- ++ (self#pType (Some (text aname)) () atype)
- ++ text " "
- ++ self#pAttrs () rest
- in
- (docList ~sep:(chr ',' ++ break) pArg) ()
- (argsToList args))
- ++ (if isvararg then break ++ text ", ..." else nil))
- ++ unalign)
- ++ text ")"))
- ()
- restyp
-
- | TNamed (t, a) ->
- text t.tname ++ self#pAttrs () a ++ text " " ++ name
-
- | TBuiltin_va_list a ->
- text "__builtin_va_list"
- ++ self#pAttrs () a
- ++ text " "
- ++ name
-
-
- (**** PRINTING ATTRIBUTES *********)
- method pAttrs () (a: attributes) =
- self#pAttrsGen false a
-
-
- (* Print one attribute. Return also an indication whether this attribute
- * should be printed inside the __attribute__ list *)
- method pAttr (Attr(an, args): attribute) : doc * bool =
- (* Recognize and take care of some known cases *)
- match an, args with
- "const", [] -> text "const", false
- (* Put the aconst inside the attribute list *)
- | "aconst", [] when not !msvcMode -> text "__const__", true
- | "thread", [] when not !msvcMode -> text "__thread", false
-(*
- | "used", [] when not !msvcMode -> text "__attribute_used__", false
-*)
- | "volatile", [] -> text "volatile", false
- | "restrict", [] -> text "__restrict", false
- | "missingproto", [] -> text "/* missing proto */", false
- | "cdecl", [] when !msvcMode -> text "__cdecl", false
- | "stdcall", [] when !msvcMode -> text "__stdcall", false
- | "fastcall", [] when !msvcMode -> text "__fastcall", false
- | "declspec", args when !msvcMode ->
- text "__declspec("
- ++ docList (self#pAttrParam ()) () args
- ++ text ")", false
- | "w64", [] when !msvcMode -> text "__w64", false
- | "asm", args ->
- text "__asm__("
- ++ docList (self#pAttrParam ()) () args
- ++ text ")", false
- (* we suppress printing mode(__si__) because it triggers an *)
- (* internal compiler error in all current gcc versions *)
- (* sm: I've now encountered a problem with mode(__hi__)... *)
- (* I don't know what's going on, but let's try disabling all "mode"..*)
- | "mode", [ACons(tag,[])] ->
- text "/* mode(" ++ text tag ++ text ") */", false
-
- (* sm: also suppress "format" because we seem to print it in *)
- (* a way gcc does not like *)
- | "format", _ -> text "/* format attribute */", false
-
- (* sm: here's another one I don't want to see gcc warnings about.. *)
- | "mayPointToStack", _ when not !print_CIL_Input
- (* [matth: may be inside another comment.]
- -> text "/*mayPointToStack*/", false
- *)
- -> text "", false
-
- | _ -> (* This is the dafault case *)
- (* Add underscores to the name *)
- let an' = if !msvcMode then "__" ^ an else "__" ^ an ^ "__" in
- if args = [] then
- text an', true
- else
- text (an' ^ "(")
- ++ (docList (self#pAttrParam ()) () args)
- ++ text ")",
- true
-
- method pAttrParam () = function
- | AInt n -> num n
- | AStr s -> text ("\"" ^ escape_string s ^ "\"")
- | ACons(s, []) -> text s
- | ACons(s,al) ->
- text (s ^ "(")
- ++ (docList (self#pAttrParam ()) () al)
- ++ text ")"
- | ASizeOfE a -> text "sizeof(" ++ self#pAttrParam () a ++ text ")"
- | ASizeOf t -> text "sizeof(" ++ self#pType None () t ++ text ")"
- | ASizeOfS ts -> text "sizeof(<typsig>)"
- | AAlignOfE a -> text "__alignof__(" ++ self#pAttrParam () a ++ text ")"
- | AAlignOf t -> text "__alignof__(" ++ self#pType None () t ++ text ")"
- | AAlignOfS ts -> text "__alignof__(<typsig>)"
- | AUnOp(u,a1) ->
- (d_unop () u) ++ text " (" ++ (self#pAttrParam () a1) ++ text ")"
-
- | ABinOp(b,a1,a2) ->
- align
- ++ text "("
- ++ (self#pAttrParam () a1)
- ++ text ") "
- ++ (d_binop () b)
- ++ break
- ++ text " (" ++ (self#pAttrParam () a2) ++ text ") "
- ++ unalign
- | ADot (ap, s) -> (self#pAttrParam () ap) ++ text ("." ^ s)
-
- (* A general way of printing lists of attributes *)
- method private pAttrsGen (block: bool) (a: attributes) =
- (* Scan all the attributes and separate those that must be printed inside
- * the __attribute__ list *)
- let rec loop (in__attr__: doc list) = function
- [] -> begin
- match in__attr__ with
- [] -> nil
- | _ :: _->
- (* sm: added 'forgcc' calls to not comment things out
- * if CIL is the consumer; this is to address a case
- * Daniel ran into where blockattribute(nobox) was being
- * dropped by the merger
- *)
- (if block then
- text (" " ^ (forgcc "/*") ^ " __blockattribute__(")
- else
- text "__attribute__((")
-
- ++ (docList ~sep:(chr ',' ++ break)
- (fun a -> a)) () in__attr__
- ++ text ")"
- ++ (if block then text (forgcc "*/") else text ")")
- end
- | x :: rest ->
- let dx, ina = self#pAttr x in
- if ina then
- loop (dx :: in__attr__) rest
- else
- dx ++ text " " ++ loop in__attr__ rest
- in
- let res = loop [] a in
- if res = nil then
- res
- else
- text " " ++ res ++ text " "
-
-end (* class defaultCilPrinterClass *)
-
-let defaultCilPrinter = new defaultCilPrinterClass
-
-(* Top-level printing functions *)
-let printType (pp: cilPrinter) () (t: typ) : doc =
- pp#pType None () t
-
-let printExp (pp: cilPrinter) () (e: exp) : doc =
- pp#pExp () e
-
-let printLval (pp: cilPrinter) () (lv: lval) : doc =
- pp#pLval () lv
-
-let printGlobal (pp: cilPrinter) () (g: global) : doc =
- pp#pGlobal () g
-
-let dumpGlobal (pp: cilPrinter) (out: out_channel) (g: global) : unit =
- pp#dGlobal out g
-
-let printAttr (pp: cilPrinter) () (a: attribute) : doc =
- let ad, _ = pp#pAttr a in ad
-
-let printAttrs (pp: cilPrinter) () (a: attributes) : doc =
- pp#pAttrs () a
-
-let printInstr (pp: cilPrinter) () (i: instr) : doc =
- pp#pInstr () i
-
-let printStmt (pp: cilPrinter) () (s: stmt) : doc =
- pp#pStmt () s
-
-let printBlock (pp: cilPrinter) () (b: block) : doc =
- (* We must add the alignment ourselves, beucase pBlock will pop it *)
- align ++ pp#pBlock () b
-
-let dumpStmt (pp: cilPrinter) (out: out_channel) (ind: int) (s: stmt) : unit =
- pp#dStmt out ind s
-
-let dumpBlock (pp: cilPrinter) (out: out_channel) (ind: int) (b: block) : unit =
- pp#dBlock out ind b
-
-let printInit (pp: cilPrinter) () (i: init) : doc =
- pp#pInit () i
-
-let dumpInit (pp: cilPrinter) (out: out_channel) (ind: int) (i: init) : unit =
- pp#dInit out ind i
-
-(* Now define some short cuts *)
-let d_exp () e = printExp defaultCilPrinter () e
-let _ = pd_exp := d_exp
-let d_lval () lv = printLval defaultCilPrinter () lv
-let d_offset base () off = defaultCilPrinter#pOffset base off
-let d_init () i = printInit defaultCilPrinter () i
-let d_type () t = printType defaultCilPrinter () t
-let d_global () g = printGlobal defaultCilPrinter () g
-let d_attrlist () a = printAttrs defaultCilPrinter () a
-let d_attr () a = printAttr defaultCilPrinter () a
-let d_attrparam () e = defaultCilPrinter#pAttrParam () e
-let d_label () l = defaultCilPrinter#pLabel () l
-let d_stmt () s = printStmt defaultCilPrinter () s
-let d_block () b = printBlock defaultCilPrinter () b
-let d_instr () i = printInstr defaultCilPrinter () i
-
-let d_shortglobal () = function
- GPragma (Attr(an, _), _) -> dprintf "#pragma %s" an
- | GType (ti, _) -> dprintf "typedef %s" ti.tname
- | GVarDecl (vi, _) -> dprintf "declaration of %s" vi.vname
- | GVar (vi, _, _) -> dprintf "definition of %s" vi.vname
- | GCompTag(ci,_) -> dprintf "definition of %s" (compFullName ci)
- | GCompTagDecl(ci,_) -> dprintf "declaration of %s" (compFullName ci)
- | GEnumTag(ei,_) -> dprintf "definition of enum %s" ei.ename
- | GEnumTagDecl(ei,_) -> dprintf "declaration of enum %s" ei.ename
- | GFun(fd, _) -> dprintf "definition of %s" fd.svar.vname
- | GText _ -> text "GText"
- | GAsm _ -> text "GAsm"
-
-
-(* sm: given an ordinary CIL object printer, yield one which
- * behaves the same, except it never prints #line directives
- * (this is useful for debugging printfs) *)
-let dn_obj (func: unit -> 'a -> doc) : (unit -> 'a -> doc) =
-begin
- (* construct the closure to return *)
- let theFunc () (obj:'a) : doc =
- begin
- let prevStyle = !lineDirectiveStyle in
- lineDirectiveStyle := None;
- let ret = (func () obj) in (* call underlying printer *)
- lineDirectiveStyle := prevStyle;
- ret
- end in
- theFunc
-end
-
-(* now define shortcuts for the non-location-printing versions,
- * with the naming prefix "dn_" *)
-let dn_exp = (dn_obj d_exp)
-let dn_lval = (dn_obj d_lval)
-(* dn_offset is missing because it has a different interface *)
-let dn_init = (dn_obj d_init)
-let dn_type = (dn_obj d_type)
-let dn_global = (dn_obj d_global)
-let dn_attrlist = (dn_obj d_attrlist)
-let dn_attr = (dn_obj d_attr)
-let dn_attrparam = (dn_obj d_attrparam)
-let dn_stmt = (dn_obj d_stmt)
-let dn_instr = (dn_obj d_instr)
-
-
-(* Now define a cilPlainPrinter *)
-class plainCilPrinterClass =
- (* We keep track of the composite types that we have done to avoid
- * recursion *)
- let donecomps : (int, unit) H.t = H.create 13 in
- object (self)
-
- inherit defaultCilPrinterClass as super
-
- (*** PLAIN TYPES ***)
- method pType (dn: doc option) () (t: typ) =
- match dn with
- None -> self#pOnlyType () t
- | Some d -> d ++ text " : " ++ self#pOnlyType () t
-
- method private pOnlyType () = function
- TVoid a -> dprintf "TVoid(@[%a@])" self#pAttrs a
- | TInt(ikind, a) -> dprintf "TInt(@[%a,@?%a@])"
- d_ikind ikind self#pAttrs a
- | TFloat(fkind, a) ->
- dprintf "TFloat(@[%a,@?%a@])" d_fkind fkind self#pAttrs a
- | TNamed (t, a) ->
- dprintf "TNamed(@[%s,@?%a,@?%a@])"
- t.tname self#pOnlyType t.ttype self#pAttrs a
- | TPtr(t, a) -> dprintf "TPtr(@[%a,@?%a@])" self#pOnlyType t self#pAttrs a
- | TArray(t,l,a) ->
- let dl = match l with
- None -> text "None" | Some l -> dprintf "Some(@[%a@])" self#pExp l in
- dprintf "TArray(@[%a,@?%a,@?%a@])"
- self#pOnlyType t insert dl self#pAttrs a
- | TEnum(enum,a) -> dprintf "Enum(%s,@[%a@])" enum.ename self#pAttrs a
- | TFun(tr,args,isva,a) ->
- dprintf "TFun(@[%a,@?%a%s,@?%a@])"
- self#pOnlyType tr
- insert
- (if args = None then text "None"
- else (docList ~sep:(chr ',' ++ break)
- (fun (an,at,aa) ->
- dprintf "%s: %a" an self#pOnlyType at))
- ()
- (argsToList args))
- (if isva then "..." else "") self#pAttrs a
- | TComp (comp, a) ->
- if H.mem donecomps comp.ckey then
- dprintf "TCompLoop(%s %s, _, %a)"
- (if comp.cstruct then "struct" else "union") comp.cname
- self#pAttrs comp.cattr
- else begin
- H.add donecomps comp.ckey (); (* Add it before we do the fields *)
- dprintf "TComp(@[%s %s,@?%a,@?%a,@?%a@])"
- (if comp.cstruct then "struct" else "union") comp.cname
- (docList ~sep:(chr ',' ++ break)
- (fun f -> dprintf "%s : %a" f.fname self#pOnlyType f.ftype))
- comp.cfields
- self#pAttrs comp.cattr
- self#pAttrs a
- end
- | TBuiltin_va_list a ->
- dprintf "TBuiltin_va_list(%a)" self#pAttrs a
-
-
- (* Some plain pretty-printers. Unlike the above these expose all the
- * details of the internal representation *)
- method pExp () = function
- Const(c) ->
- let d_plainconst () c =
- match c with
- CInt64(i, ik, so) ->
- dprintf "Int64(%s,%a,%s)"
- (Int64.format "%d" i)
- d_ikind ik
- (match so with Some s -> s | _ -> "None")
- | CStr(s) ->
- text ("CStr(\"" ^ escape_string s ^ "\")")
- | CWStr(s) ->
- dprintf "CWStr(%a)" d_const c
-
- | CChr(c) -> text ("CChr('" ^ escape_char c ^ "')")
- | CReal(f, fk, so) ->
- dprintf "CReal(%f, %a, %s)"
- f
- d_fkind fk
- (match so with Some s -> s | _ -> "None")
- | CEnum(_, s, _) -> text s
- in
- text "Const(" ++ d_plainconst () c ++ text ")"
-
-
- | Lval(lv) ->
- text "Lval("
- ++ (align
- ++ self#pLval () lv
- ++ unalign)
- ++ text ")"
-
- | CastE(t,e) -> dprintf "CastE(@[%a,@?%a@])" self#pOnlyType t self#pExp e
-
- | UnOp(u,e1,_) ->
- dprintf "UnOp(@[%a,@?%a@])"
- d_unop u self#pExp e1
-
- | BinOp(b,e1,e2,_) ->
- let d_plainbinop () b =
- match b with
- PlusA -> text "PlusA"
- | PlusPI -> text "PlusPI"
- | IndexPI -> text "IndexPI"
- | MinusA -> text "MinusA"
- | MinusPP -> text "MinusPP"
- | MinusPI -> text "MinusPI"
- | _ -> d_binop () b
- in
- dprintf "%a(@[%a,@?%a@])" d_plainbinop b
- self#pExp e1 self#pExp e2
-
- | SizeOf (t) ->
- text "sizeof(" ++ self#pType None () t ++ chr ')'
- | SizeOfE (e) ->
- text "sizeofE(" ++ self#pExp () e ++ chr ')'
- | SizeOfStr (s) ->
- text "sizeofStr(" ++ d_const () (CStr s) ++ chr ')'
- | AlignOf (t) ->
- text "__alignof__(" ++ self#pType None () t ++ chr ')'
- | AlignOfE (e) ->
- text "__alignof__(" ++ self#pExp () e ++ chr ')'
-
- | StartOf lv -> dprintf "StartOf(%a)" self#pLval lv
- | AddrOf (lv) -> dprintf "AddrOf(%a)" self#pLval lv
-
-
-
- method private d_plainoffset () = function
- NoOffset -> text "NoOffset"
- | Field(fi,o) ->
- dprintf "Field(@[%s:%a,@?%a@])"
- fi.fname self#pOnlyType fi.ftype self#d_plainoffset o
- | Index(e, o) ->
- dprintf "Index(@[%a,@?%a@])" self#pExp e self#d_plainoffset o
-
- method pInit () = function
- SingleInit e -> dprintf "SI(%a)" d_exp e
- | CompoundInit (t, initl) ->
- let d_plainoneinit (o, i) =
- self#d_plainoffset () o ++ text " = " ++ self#pInit () i
- in
- dprintf "CI(@[%a,@?%a@])" self#pOnlyType t
- (docList ~sep:(chr ',' ++ break) d_plainoneinit) initl
-(*
- | ArrayInit (t, len, initl) ->
- let idx = ref (- 1) in
- let d_plainoneinit i =
- incr idx;
- text "[" ++ num !idx ++ text "] = " ++ self#pInit () i
- in
- dprintf "AI(@[%a,%d,@?%a@])" self#pOnlyType t len
- (docList ~sep:(chr ',' ++ break) d_plainoneinit) initl
-*)
- method pLval () (lv: lval) =
- match lv with
- | Var vi, o -> dprintf "Var(@[%s,@?%a@])" vi.vname self#d_plainoffset o
- | Mem e, o -> dprintf "Mem(@[%a,@?%a@])" self#pExp e self#d_plainoffset o
-
-
-end
-let plainCilPrinter = new plainCilPrinterClass
-
-(* And now some shortcuts *)
-let d_plainexp () e = plainCilPrinter#pExp () e
-let d_plaintype () t = plainCilPrinter#pType None () t
-let d_plaininit () i = plainCilPrinter#pInit () i
-let d_plainlval () l = plainCilPrinter#pLval () l
-
-(* zra: this allows pretty printers not in cil.ml to
- be exposed to cilmain.ml *)
-let printerForMaincil = ref defaultCilPrinter
-
-let rec d_typsig () = function
- TSArray (ts, eo, al) ->
- dprintf "TSArray(@[%a,@?%a,@?%a@])"
- d_typsig ts
- insert (text (match eo with None -> "None"
- | Some e -> "Some " ^ Int64.to_string e))
- d_attrlist al
- | TSPtr (ts, al) ->
- dprintf "TSPtr(@[%a,@?%a@])"
- d_typsig ts d_attrlist al
- | TSComp (iss, name, al) ->
- dprintf "TSComp(@[%s %s,@?%a@])"
- (if iss then "struct" else "union") name
- d_attrlist al
- | TSFun (rt, args, isva, al) ->
- dprintf "TSFun(@[%a,@?%a,%b,@?%a@])"
- d_typsig rt
- (docList ~sep:(chr ',' ++ break) (d_typsig ())) args isva
- d_attrlist al
- | TSEnum (n, al) ->
- dprintf "TSEnum(@[%s,@?%a@])"
- n d_attrlist al
- | TSBase t -> dprintf "TSBase(%a)" d_type t
-
-
-let newVID () =
- let t = !nextGlobalVID in
- incr nextGlobalVID;
- t
-
- (* Make a varinfo. Used mostly as a helper function below *)
-let makeVarinfo global name typ =
- (* Strip const from type for locals *)
- let vi =
- { vname = name;
- vid = newVID ();
- vglob = global;
- vtype = if global then typ else typeRemoveAttributes ["const"] typ;
- vdecl = lu;
- vinline = false;
- vattr = [];
- vstorage = NoStorage;
- vaddrof = false;
- vreferenced = false; (* sm *)
- } in
- vi
-
-let copyVarinfo (vi: varinfo) (newname: string) : varinfo =
- let vi' = {vi with vname = newname; vid = newVID () } in
- vi'
-
-let makeLocal fdec name typ = (* a helper function *)
- fdec.smaxid <- 1 + fdec.smaxid;
- let vi = makeVarinfo false name typ in
- vi
-
- (* Make a local variable and add it to a function *)
-let makeLocalVar fdec ?(insert = true) name typ =
- let vi = makeLocal fdec name typ in
- if insert then fdec.slocals <- fdec.slocals @ [vi];
- vi
-
-
-let makeTempVar fdec ?(name = "__cil_tmp") typ : varinfo =
- let name = name ^ (string_of_int (1 + fdec.smaxid)) in
- makeLocalVar fdec name typ
-
-
- (* Set the formals and re-create the function name based on the information*)
-let setFormals (f: fundec) (forms: varinfo list) =
- f.sformals <- forms; (* Set the formals *)
- match unrollType f.svar.vtype with
- TFun(rt, _, isva, fa) ->
- f.svar.vtype <-
- TFun(rt,
- Some (List.map (fun a -> (a.vname, a.vtype, a.vattr)) forms),
- isva, fa)
- | _ -> E.s (E.bug "Set formals. %s does not have function type\n"
- f.svar.vname)
-
- (* Set the types of arguments and results as given by the function type
- * passed as the second argument *)
-let setFunctionType (f: fundec) (t: typ) =
- match unrollType t with
- TFun (rt, Some args, va, a) ->
- if List.length f.sformals <> List.length args then
- E.s (E.bug "setFunctionType: number of arguments differs from the number of formals");
- (* Change the function type. *)
- f.svar.vtype <- t;
- (* Change the sformals and we know that indirectly we'll change the
- * function type *)
- List.iter2
- (fun (an,at,aa) f ->
- f.vtype <- at; f.vattr <- aa)
- args f.sformals
-
- | _ -> E.s (E.bug "setFunctionType: not a function type")
-
-
- (* Set the types of arguments and results as given by the function type
- * passed as the second argument *)
-let setFunctionTypeMakeFormals (f: fundec) (t: typ) =
- match unrollType t with
- TFun (rt, Some args, va, a) ->
- if f.sformals <> [] then
- E.s (E.warn "setFunctionTypMakeFormals called on function %s with some formals already"
- f.svar.vname);
- (* Change the function type. *)
- f.svar.vtype <- t;
- f.sformals <- [];
-
- f.sformals <- List.map (fun (n,t,a) -> makeLocal f n t) args;
-
- setFunctionType f t
-
- | _ -> E.s (E.bug "setFunctionTypeMakeFormals: not a function type: %a"
- d_type t)
-
-
-let setMaxId (f: fundec) =
- f.smaxid <- List.length f.sformals + List.length f.slocals
-
-
- (* Make a formal variable for a function. Insert it in both the sformals
- * and the type of the function. You can optionally specify where to insert
- * this one. If where = "^" then it is inserted first. If where = "$" then
- * it is inserted last. Otherwise where must be the name of a formal after
- * which to insert this. By default it is inserted at the end. *)
-let makeFormalVar fdec ?(where = "$") name typ : varinfo =
- (* Search for the insertion place *)
- let thenewone = ref fdec.svar in (* Just a placeholder *)
- let makeit () : varinfo =
- let vi = makeLocal fdec name typ in
- thenewone := vi;
- vi
- in
- let rec loopFormals = function
- [] ->
- if where = "$" then [makeit ()]
- else E.s (E.error "makeFormalVar: cannot find insert-after formal %s"
- where)
- | f :: rest when f.vname = where -> f :: makeit () :: rest
- | f :: rest -> f :: loopFormals rest
- in
- let newformals =
- if where = "^" then makeit () :: fdec.sformals else
- loopFormals fdec.sformals in
- setFormals fdec newformals;
- !thenewone
-
- (* Make a global variable. Your responsibility to make sure that the name
- * is unique *)
-let makeGlobalVar name typ =
- let vi = makeVarinfo true name typ in
- vi
-
-
- (* Make an empty function *)
-let emptyFunction name =
- { svar = makeGlobalVar name (TFun(voidType, Some [], false,[]));
- smaxid = 0;
- slocals = [];
- sformals = [];
- sbody = mkBlock [];
- smaxstmtid = None;
- sallstmts = [];
- }
-
-
-
- (* A dummy function declaration handy for initialization *)
-let dummyFunDec = emptyFunction "@dummy"
-let dummyFile =
- { globals = [];
- fileName = "<dummy>";
- globinit = None;
- globinitcalled = false;}
-
-let saveBinaryFile (cil_file : file) (filename : string) =
- let outchan = open_out_bin filename in
- Marshal.to_channel outchan cil_file [] ;
- close_out outchan
-
-let saveBinaryFileChannel (cil_file : file) (outchan : out_channel) =
- Marshal.to_channel outchan cil_file []
-
-let loadBinaryFile (filename : string) : file =
- let inchan = open_in_bin filename in
- let cil_file = (Marshal.from_channel inchan : file) in
- close_in inchan ;
- cil_file
-
-
-(* Take the name of a file and make a valid symbol name out of it. There are
- * a few chanracters that are not valid in symbols *)
-let makeValidSymbolName (s: string) =
- let s = String.copy s in (* So that we can update in place *)
- let l = String.length s in
- for i = 0 to l - 1 do
- let c = String.get s i in
- let isinvalid =
- match c with
- '-' | '.' -> true
- | _ -> false
- in
- if isinvalid then
- String.set s i '_';
- done;
- s
-
-
-(*** Define the visiting engine ****)
-(* visit all the nodes in a Cil expression *)
-let doVisit (vis: cilVisitor)
- (startvisit: 'a -> 'a visitAction)
- (children: cilVisitor -> 'a -> 'a)
- (node: 'a) : 'a =
- let action = startvisit node in
- match action with
- SkipChildren -> node
- | ChangeTo node' -> node'
- | _ -> (* DoChildren and ChangeDoChildrenPost *)
- let nodepre = match action with
- ChangeDoChildrenPost (node', _) -> node'
- | _ -> node
- in
- let nodepost = children vis nodepre in
- match action with
- ChangeDoChildrenPost (_, f) -> f nodepost
- | _ -> nodepost
-
-(* mapNoCopy is like map but avoid copying the list if the function does not
- * change the elements. *)
-let rec mapNoCopy (f: 'a -> 'a) = function
- [] -> []
- | (i :: resti) as li ->
- let i' = f i in
- let resti' = mapNoCopy f resti in
- if i' != i || resti' != resti then i' :: resti' else li
-
-let rec mapNoCopyList (f: 'a -> 'a list) = function
- [] -> []
- | (i :: resti) as li ->
- let il' = f i in
- let resti' = mapNoCopyList f resti in
- match il' with
- [i'] when i' == i && resti' == resti -> li
- | _ -> il' @ resti'
-
-(* A visitor for lists *)
-let doVisitList (vis: cilVisitor)
- (startvisit: 'a -> 'a list visitAction)
- (children: cilVisitor -> 'a -> 'a)
- (node: 'a) : 'a list =
- let action = startvisit node in
- match action with
- SkipChildren -> [node]
- | ChangeTo nodes' -> nodes'
- | _ ->
- let nodespre = match action with
- ChangeDoChildrenPost (nodespre, _) -> nodespre
- | _ -> [node]
- in
- let nodespost = mapNoCopy (children vis) nodespre in
- match action with
- ChangeDoChildrenPost (_, f) -> f nodespost
- | _ -> nodespost
-
-let debugVisit = false
-
-let rec visitCilExpr (vis: cilVisitor) (e: exp) : exp =
- doVisit vis vis#vexpr childrenExp e
-and childrenExp (vis: cilVisitor) (e: exp) : exp =
- let vExp e = visitCilExpr vis e in
- let vTyp t = visitCilType vis t in
- let vLval lv = visitCilLval vis lv in
- match e with
- | Const (CEnum(v, s, ei)) ->
- let v' = vExp v in
- if v' != v then Const (CEnum(v', s, ei)) else e
-
- | Const _ -> e
- | SizeOf t ->
- let t'= vTyp t in
- if t' != t then SizeOf t' else e
- | SizeOfE e1 ->
- let e1' = vExp e1 in
- if e1' != e1 then SizeOfE e1' else e
- | SizeOfStr s -> e
-
- | AlignOf t ->
- let t' = vTyp t in
- if t' != t then AlignOf t' else e
- | AlignOfE e1 ->
- let e1' = vExp e1 in
- if e1' != e1 then AlignOfE e1' else e
- | Lval lv ->
- let lv' = vLval lv in
- if lv' != lv then Lval lv' else e
- | UnOp (uo, e1, t) ->
- let e1' = vExp e1 in let t' = vTyp t in
- if e1' != e1 || t' != t then UnOp(uo, e1', t') else e
- | BinOp (bo, e1, e2, t) ->
- let e1' = vExp e1 in let e2' = vExp e2 in let t' = vTyp t in
- if e1' != e1 || e2' != e2 || t' != t then BinOp(bo, e1',e2',t') else e
- | CastE (t, e1) ->
- let t' = vTyp t in let e1' = vExp e1 in
- if t' != t || e1' != e1 then CastE(t', e1') else e
- | AddrOf lv ->
- let lv' = vLval lv in
- if lv' != lv then AddrOf lv' else e
- | StartOf lv ->
- let lv' = vLval lv in
- if lv' != lv then StartOf lv' else e
-
-and visitCilInit (vis: cilVisitor) (i: init) : init =
- doVisit vis vis#vinit childrenInit i
-and childrenInit (vis: cilVisitor) (i: init) : init =
- let fExp e = visitCilExpr vis e in
- let fInit i = visitCilInit vis i in
- let fTyp t = visitCilType vis t in
- match i with
- | SingleInit e ->
- let e' = fExp e in
- if e' != e then SingleInit e' else i
- | CompoundInit (t, initl) ->
- let t' = fTyp t in
- (* Collect the new initializer list, in reverse. We prefer two
- * traversals to ensure tail-recursion. *)
- let newinitl : (offset * init) list ref = ref [] in
- (* Keep track whether the list has changed *)
- let hasChanged = ref false in
- let doOneInit ((o, i) as oi) =
- let o' = visitCilInitOffset vis o in (* use initializer version *)
- let i' = fInit i in
- let newio =
- if o' != o || i' != i then
- begin hasChanged := true; (o', i') end else oi
- in
- newinitl := newio :: !newinitl
- in
- List.iter doOneInit initl;
- let initl' = if !hasChanged then List.rev !newinitl else initl in
- if t' != t || initl' != initl then CompoundInit (t', initl') else i
-
-and visitCilLval (vis: cilVisitor) (lv: lval) : lval =
- doVisit vis vis#vlval childrenLval lv
-and childrenLval (vis: cilVisitor) (lv: lval) : lval =
- (* and visit its subexpressions *)
- let vExp e = visitCilExpr vis e in
- let vOff off = visitCilOffset vis off in
- match lv with
- Var v, off ->
- let v' = doVisit vis vis#vvrbl (fun _ x -> x) v in
- let off' = vOff off in
- if v' != v || off' != off then Var v', off' else lv
- | Mem e, off ->
- let e' = vExp e in
- let off' = vOff off in
- if e' != e || off' != off then Mem e', off' else lv
-
-and visitCilOffset (vis: cilVisitor) (off: offset) : offset =
- doVisit vis vis#voffs childrenOffset off
-and childrenOffset (vis: cilVisitor) (off: offset) : offset =
- let vOff off = visitCilOffset vis off in
- match off with
- Field (f, o) ->
- let o' = vOff o in
- if o' != o then Field (f, o') else off
- | Index (e, o) ->
- let e' = visitCilExpr vis e in
- let o' = vOff o in
- if e' != e || o' != o then Index (e', o') else off
- | NoOffset -> off
-
-(* sm: for offsets in initializers, the 'startvisit' will be the
- * vinitoffs method, but we can re-use the childrenOffset from
- * above since recursive offsets are visited by voffs. (this point
- * is moot according to cil.mli which claims the offsets in
- * initializers will never recursively contain offsets)
- *)
-and visitCilInitOffset (vis: cilVisitor) (off: offset) : offset =
- doVisit vis vis#vinitoffs childrenOffset off
-
-and visitCilInstr (vis: cilVisitor) (i: instr) : instr list =
- let oldloc = !currentLoc in
- currentLoc := (get_instrLoc i);
- assertEmptyQueue vis;
- let res = doVisitList vis vis#vinst childrenInstr i in
- currentLoc := oldloc;
- (* See if we have accumulated some instructions *)
- vis#unqueueInstr () @ res
-
-and childrenInstr (vis: cilVisitor) (i: instr) : instr =
- let fExp = visitCilExpr vis in
- let fLval = visitCilLval vis in
- match i with
- | Set(lv,e,l) ->
- let lv' = fLval lv in let e' = fExp e in
- if lv' != lv || e' != e then Set(lv',e',l) else i
- | Call(None,f,args,l) ->
- let f' = fExp f in let args' = mapNoCopy fExp args in
- if f' != f || args' != args then Call(None,f',args',l) else i
- | Call(Some lv,fn,args,l) ->
- let lv' = fLval lv in let fn' = fExp fn in
- let args' = mapNoCopy fExp args in
- if lv' != lv || fn' != fn || args' != args
- then Call(Some lv', fn', args', l) else i
-
- | Asm(sl,isvol,outs,ins,clobs,l) ->
- let outs' = mapNoCopy (fun ((s,lv) as pair) ->
- let lv' = fLval lv in
- if lv' != lv then (s,lv') else pair) outs in
- let ins' = mapNoCopy (fun ((s,e) as pair) ->
- let e' = fExp e in
- if e' != e then (s,e') else pair) ins in
- if outs' != outs || ins' != ins then
- Asm(sl,isvol,outs',ins',clobs,l) else i
-
-
-(* visit all nodes in a Cil statement tree in preorder *)
-and visitCilStmt (vis: cilVisitor) (s: stmt) : stmt =
- let oldloc = !currentLoc in
- currentLoc := (get_stmtLoc s.skind) ;
- assertEmptyQueue vis;
- let toPrepend : instr list ref = ref [] in (* childrenStmt may add to this *)
- let res = doVisit vis vis#vstmt (childrenStmt toPrepend) s in
- (* Now see if we have saved some instructions *)
- toPrepend := !toPrepend @ vis#unqueueInstr ();
- (match !toPrepend with
- [] -> () (* Return the same statement *)
- | _ ->
- (* Make our statement contain the instructions to prepend *)
- res.skind <- Block { battrs = []; bstmts = [ mkStmt (Instr !toPrepend);
- mkStmt res.skind ] });
- currentLoc := oldloc;
- res
-
-and childrenStmt (toPrepend: instr list ref) (vis:cilVisitor) (s:stmt): stmt =
- let fExp e = (visitCilExpr vis e) in
- let fBlock b = visitCilBlock vis b in
- let fInst i = visitCilInstr vis i in
- (* Just change the statement kind *)
- let skind' =
- match s.skind with
- Break _ | Continue _ | Goto _ | Return (None, _) -> s.skind
- | Return (Some e, l) ->
- let e' = fExp e in
- if e' != e then Return (Some e', l) else s.skind
-(*
- | Loop (b, l, s1, s2) ->
- let b' = fBlock b in
- if b' != b then Loop (b', l, s1, s2) else s.skind
-*)
- | While (e, b, l) ->
- let e' = fExp e in
- let b' = fBlock b in
- if e' != e || b' != b then While (e', b', l) else s.skind
- | DoWhile (e, b, l) ->
- let b' = fBlock b in
- let e' = fExp e in
- if e' != e || b' != b then DoWhile (e', b', l) else s.skind
- | For (bInit, e, bIter, b, l) ->
- let bInit' = fBlock bInit in
- let e' = fExp e in
- let bIter' = fBlock bIter in
- let b' = fBlock b in
- if bInit' != bInit || e' != e || bIter' != bIter || b' != b then
- For (bInit', e', bIter', b', l) else s.skind
- | If(e, s1, s2, l) ->
- let e' = fExp e in
- (*if e queued any instructions, pop them here and remember them so that
- they are inserted before the If stmt, not in the then block. *)
- toPrepend := vis#unqueueInstr ();
- let s1'= fBlock s1 in let s2'= fBlock s2 in
- (* the stmts in the blocks should have cleaned up after themselves.*)
- assertEmptyQueue vis;
- if e' != e || s1' != s1 || s2' != s2 then
- If(e', s1', s2', l) else s.skind
- | Switch (e, b, stmts, l) ->
- let e' = fExp e in
- toPrepend := vis#unqueueInstr (); (* insert these before the switch *)
- let b' = fBlock b in
- (* the stmts in b should have cleaned up after themselves.*)
- assertEmptyQueue vis;
- (* Don't do stmts, but we better not change those *)
- if e' != e || b' != b then Switch (e', b', stmts, l) else s.skind
- | Instr il ->
- let il' = mapNoCopyList fInst il in
- if il' != il then Instr il' else s.skind
- | Block b ->
- let b' = fBlock b in
- if b' != b then Block b' else s.skind
- | TryFinally (b, h, l) ->
- let b' = fBlock b in
- let h' = fBlock h in
- if b' != b || h' != h then TryFinally(b', h', l) else s.skind
- | TryExcept (b, (il, e), h, l) ->
- let b' = fBlock b in
- assertEmptyQueue vis;
- (* visit the instructions *)
- let il' = mapNoCopyList fInst il in
- (* Visit the expression *)
- let e' = fExp e in
- let il'' =
- let more = vis#unqueueInstr () in
- if more != [] then
- il' @ more
- else
- il'
- in
- let h' = fBlock h in
- (* Now collect the instructions *)
- if b' != b || il'' != il || e' != e || h' != h then
- TryExcept(b', (il'', e'), h', l)
- else s.skind
- in
- if skind' != s.skind then s.skind <- skind';
- (* Visit the labels *)
- let labels' =
- let fLabel = function
- Case (e, l) as lb ->
- let e' = fExp e in
- if e' != e then Case (e', l) else lb
- | lb -> lb
- in
- mapNoCopy fLabel s.labels
- in
- if labels' != s.labels then s.labels <- labels';
- s
-
-
-
-and visitCilBlock (vis: cilVisitor) (b: block) : block =
- doVisit vis vis#vblock childrenBlock b
-and childrenBlock (vis: cilVisitor) (b: block) : block =
- let fStmt s = visitCilStmt vis s in
- let stmts' = mapNoCopy fStmt b.bstmts in
- if stmts' != b.bstmts then { battrs = b.battrs; bstmts = stmts'} else b
-
-
-and visitCilType (vis : cilVisitor) (t : typ) : typ =
- doVisit vis vis#vtype childrenType t
-and childrenType (vis : cilVisitor) (t : typ) : typ =
- (* look for types referred to inside t's definition *)
- let fTyp t = visitCilType vis t in
- let fAttr a = visitCilAttributes vis a in
- match t with
- TPtr(t1, a) ->
- let t1' = fTyp t1 in
- let a' = fAttr a in
- if t1' != t || a' != a then TPtr(t1', a') else t
- | TArray(t1, None, a) ->
- let t1' = fTyp t1 in
- let a' = fAttr a in
- if t1' != t || a' != a then TArray(t1', None, a') else t
- | TArray(t1, Some e, a) ->
- let t1' = fTyp t1 in
- let e' = visitCilExpr vis e in
- let a' = fAttr a in
- if t1' != t || e' != e || a' != a then TArray(t1', Some e', a') else t
-
- (* DON'T recurse into the compinfo, this is done in visitCilGlobal.
- User can iterate over cinfo.cfields manually, if desired.*)
- | TComp(cinfo, a) ->
- let a' = fAttr a in
- if a != a' then TComp(cinfo, a') else t
-
- | TFun(rettype, args, isva, a) ->
- let rettype' = fTyp rettype in
- (* iterate over formals, as variable declarations *)
- let argslist = argsToList args in
- let visitArg ((an,at,aa) as arg) =
- let at' = fTyp at in
- let aa' = fAttr aa in
- if at' != at || aa' != aa then (an,at',aa') else arg
- in
- let argslist' = mapNoCopy visitArg argslist in
- let a' = fAttr a in
- if rettype' != rettype || argslist' != argslist || a' != a then
- let args' = if argslist' == argslist then args else Some argslist' in
- TFun(rettype', args', isva, a') else t
-
- | TNamed(t1, a) -> (* Do not go into the type. Will do it at the time of
- * GType *)
- let a' = fAttr a in
- if a' != a then TNamed (t1, a') else t
-
- | _ -> (* other types (TVoid, TInt, TFloat, TEnum, and TBuiltin_va_list)
- don't contain nested types, but they do have attributes. *)
- let a = typeAttrs t in
- let a' = fAttr a in
- if a' != a then setTypeAttrs t a' else t
-
-
-(* for declarations, we visit the types inside; but for uses, *)
-(* we just visit the varinfo node *)
-and visitCilVarDecl (vis : cilVisitor) (v : varinfo) : varinfo =
- doVisit vis vis#vvdec childrenVarDecl v
-and childrenVarDecl (vis : cilVisitor) (v : varinfo) : varinfo =
- v.vtype <- visitCilType vis v.vtype;
- v.vattr <- visitCilAttributes vis v.vattr;
- v
-
-and visitCilAttributes (vis: cilVisitor) (al: attribute list) : attribute list=
- let al' =
- mapNoCopyList (doVisitList vis vis#vattr childrenAttribute) al in
- if al' != al then
- (* Must re-sort *)
- addAttributes al' []
- else
- al
-and childrenAttribute (vis: cilVisitor) (a: attribute) : attribute =
- let fAttrP a = visitCilAttrParams vis a in
- match a with
- Attr (n, args) ->
- let args' = mapNoCopy fAttrP args in
- if args' != args then Attr(n, args') else a
-
-
-and visitCilAttrParams (vis: cilVisitor) (a: attrparam) : attrparam =
- doVisit vis vis#vattrparam childrenAttrparam a
-and childrenAttrparam (vis: cilVisitor) (aa: attrparam) : attrparam =
- let fTyp t = visitCilType vis t in
- let fAttrP a = visitCilAttrParams vis a in
- match aa with
- AInt _ | AStr _ -> aa
- | ACons(n, args) ->
- let args' = mapNoCopy fAttrP args in
- if args' != args then ACons(n, args') else aa
- | ASizeOf t ->
- let t' = fTyp t in
- if t' != t then ASizeOf t' else aa
- | ASizeOfE e ->
- let e' = fAttrP e in
- if e' != e then ASizeOfE e' else aa
- | AAlignOf t ->
- let t' = fTyp t in
- if t' != t then AAlignOf t' else aa
- | AAlignOfE e ->
- let e' = fAttrP e in
- if e' != e then AAlignOfE e' else aa
- | ASizeOfS _ | AAlignOfS _ ->
- ignore (warn "Visitor inside of a type signature.");
- aa
- | AUnOp (uo, e1) ->
- let e1' = fAttrP e1 in
- if e1' != e1 then AUnOp (uo, e1') else aa
- | ABinOp (bo, e1, e2) ->
- let e1' = fAttrP e1 in
- let e2' = fAttrP e2 in
- if e1' != e1 || e2' != e2 then ABinOp (bo, e1', e2') else aa
- | ADot (ap, s) ->
- let ap' = fAttrP ap in
- if ap' != ap then ADot (ap', s) else aa
-
-
-let rec visitCilFunction (vis : cilVisitor) (f : fundec) : fundec =
- if debugVisit then ignore (E.log "Visiting function %s\n" f.svar.vname);
- assertEmptyQueue vis;
- let f = doVisit vis vis#vfunc childrenFunction f in
-
- let toPrepend = vis#unqueueInstr () in
- if toPrepend <> [] then
- f.sbody.bstmts <- mkStmt (Instr toPrepend) :: f.sbody.bstmts;
- f
-
-and childrenFunction (vis : cilVisitor) (f : fundec) : fundec =
- f.svar <- visitCilVarDecl vis f.svar; (* hit the function name *)
- (* visit local declarations *)
- f.slocals <- mapNoCopy (visitCilVarDecl vis) f.slocals;
- (* visit the formals *)
- let newformals = mapNoCopy (visitCilVarDecl vis) f.sformals in
- (* Make sure the type reflects the formals *)
- setFormals f newformals;
- (* Remember any new instructions that were generated while visiting
- variable declarations. *)
- let toPrepend = vis#unqueueInstr () in
-
- f.sbody <- visitCilBlock vis f.sbody; (* visit the body *)
- if toPrepend <> [] then
- f.sbody.bstmts <- mkStmt (Instr toPrepend) :: f.sbody.bstmts;
- f
-
-let rec visitCilGlobal (vis: cilVisitor) (g: global) : global list =
- (*(trace "visit" (dprintf "visitCilGlobal\n"));*)
- let oldloc = !currentLoc in
- currentLoc := (get_globalLoc g) ;
- currentGlobal := g;
- let res = doVisitList vis vis#vglob childrenGlobal g in
- currentLoc := oldloc;
- res
-and childrenGlobal (vis: cilVisitor) (g: global) : global =
- match g with
- | GFun (f, l) ->
- let f' = visitCilFunction vis f in
- if f' != f then GFun (f', l) else g
- | GType(t, l) ->
- t.ttype <- visitCilType vis t.ttype;
- g
-
- | GEnumTagDecl _ | GCompTagDecl _ -> g (* Nothing to visit *)
- | GEnumTag (enum, _) ->
- (trace "visit" (dprintf "visiting global enum %s\n" enum.ename));
- (* Do the values and attributes of the enumerated items *)
- let itemVisit (name, exp, loc) = (name, visitCilExpr vis exp, loc) in
- enum.eitems <- mapNoCopy itemVisit enum.eitems;
- enum.eattr <- visitCilAttributes vis enum.eattr;
- g
-
- | GCompTag (comp, _) ->
- (trace "visit" (dprintf "visiting global comp %s\n" comp.cname));
- (* Do the types and attirbutes of the fields *)
- let fieldVisit = fun fi ->
- fi.ftype <- visitCilType vis fi.ftype;
- fi.fattr <- visitCilAttributes vis fi.fattr
- in
- List.iter fieldVisit comp.cfields;
- comp.cattr <- visitCilAttributes vis comp.cattr;
- g
-
- | GVarDecl(v, l) ->
- let v' = visitCilVarDecl vis v in
- if v' != v then GVarDecl (v', l) else g
- | GVar (v, inito, l) ->
- let v' = visitCilVarDecl vis v in
- (match inito.init with
- None -> ()
- | Some i -> let i' = visitCilInit vis i in
- if i' != i then inito.init <- Some i');
-
- if v' != v then GVar (v', inito, l) else g
-
- | GPragma (a, l) -> begin
- match visitCilAttributes vis [a] with
- [a'] -> if a' != a then GPragma (a', l) else g
- | _ -> E.s (E.unimp "visitCilAttributes returns more than one attribute")
- end
- | _ -> g
-
-
-(** A visitor that does constant folding. If "machdep" is true then we do
- * machine dependent simplification (e.g., sizeof) *)
-class constFoldVisitorClass (machdep: bool) : cilVisitor = object
- inherit nopCilVisitor
-
- method vinst i =
- match i with
- (* Skip two functions to which we add Sizeof to the type arguments.
- See the comments for these above. *)
- Call(_,(Lval (Var vi,NoOffset)),_,_)
- when ((vi.vname = "__builtin_va_arg")
- || (vi.vname = "__builtin_types_compatible_p")) ->
- SkipChildren
- | _ -> DoChildren
- method vexpr (e: exp) =
- (* Do it bottom up *)
- ChangeDoChildrenPost (e, constFold machdep)
-
-end
-let constFoldVisitor (machdep: bool) = new constFoldVisitorClass machdep
-
-(* Iterate over all globals, including the global initializer *)
-let iterGlobals (fl: file)
- (doone: global -> unit) : unit =
- let doone' g =
- currentLoc := get_globalLoc g;
- doone g
- in
- List.iter doone' fl.globals;
- (match fl.globinit with
- None -> ()
- | Some g -> doone' (GFun(g, locUnknown)))
-
-(* Fold over all globals, including the global initializer *)
-let foldGlobals (fl: file)
- (doone: 'a -> global -> 'a)
- (acc: 'a) : 'a =
- let doone' acc g =
- currentLoc := get_globalLoc g;
- doone acc g
- in
- let acc' = List.fold_left doone' acc fl.globals in
- (match fl.globinit with
- None -> acc'
- | Some g -> doone' acc' (GFun(g, locUnknown)))
-
-
-(* A visitor for the whole file that does not change the globals *)
-let visitCilFileSameGlobals (vis : cilVisitor) (f : file) : unit =
- let fGlob g = visitCilGlobal vis g in
- iterGlobals f (fun g ->
- match fGlob g with
- [g'] when g' == g || Util.equals g' g -> () (* Try to do the pointer check first *)
- | gl ->
- ignore (E.log "You used visitCilFilSameGlobals but the global got changed:\n %a\nchanged to %a\n" d_global g (docList ~sep:line (d_global ())) gl);
- ())
-
-(* Be careful with visiting the whole file because it might be huge. *)
-let visitCilFile (vis : cilVisitor) (f : file) : unit =
- let fGlob g = visitCilGlobal vis g in
- (* Scan the globals. Make sure this is tail recursive. *)
- let rec loop (acc: global list) = function
- [] -> f.globals <- List.rev acc
- | g :: restg ->
- loop ((List.rev (fGlob g)) @ acc) restg
- in
- loop [] f.globals;
- (* the global initializer *)
- (match f.globinit with
- None -> ()
- | Some g -> f.globinit <- Some (visitCilFunction vis g))
-
-
-
-(** Create or fetch the global initializer. Tries to put a call to in the the
- * function with the main_name *)
-let getGlobInit ?(main_name="main") (fl: file) =
- match fl.globinit with
- Some f -> f
- | None -> begin
- (* Sadly, we cannot use the Filename library because it does not like
- * function names with multiple . in them *)
- let f =
- let len = String.length fl.fileName in
- (* Find the last path separator and record the first . that we see,
- * going backwards *)
- let lastDot = ref len in
- let rec findLastPathSep i =
- if i < 0 then -1 else
- let c = String.get fl.fileName i in
- if c = '/' || c = '\\' then i
- else begin
- if c = '.' && !lastDot = len then
- lastDot := i;
- findLastPathSep (i - 1)
- end
- in
- let lastPathSep = findLastPathSep (len - 1) in
- let basenoext =
- String.sub fl.fileName (lastPathSep + 1) (!lastDot - lastPathSep - 1)
- in
- emptyFunction
- (makeValidSymbolName ("__globinit_" ^ basenoext))
- in
- fl.globinit <- Some f;
- (* Now try to add a call to the global initialized at the beginning of
- * main *)
- let inserted = ref false in
- List.iter
- (fun g ->
- match g with
- GFun(m, lm) when m.svar.vname = main_name ->
- (* Prepend a prototype to the global initializer *)
- fl.globals <- GVarDecl (f.svar, lm) :: fl.globals;
- m.sbody.bstmts <-
- compactStmts (mkStmt (Instr [Call(None,
- Lval(var f.svar),
- [], locUnknown)])
- :: m.sbody.bstmts);
- inserted := true;
- if !E.verboseFlag then
- ignore (E.log "Inserted the globinit\n");
- fl.globinitcalled <- true;
- | _ -> ())
- fl.globals;
-
- if not !inserted then
- ignore (E.warn "Cannot find %s to add global initializer %s"
- main_name f.svar.vname);
-
- f
- end
-
-
-
-(* Fold over all globals, including the global initializer *)
-let mapGlobals (fl: file)
- (doone: global -> global) : unit =
- fl.globals <- List.map doone fl.globals;
- (match fl.globinit with
- None -> ()
- | Some g -> begin
- match doone (GFun(g, locUnknown)) with
- GFun(g', _) -> fl.globinit <- Some g'
- | _ -> E.s (E.bug "mapGlobals: globinit is not a function")
- end)
-
-
-
-let dumpFile (pp: cilPrinter) (out : out_channel) (outfile: string) file =
- printDepth := 99999; (* We don't want ... in the output *)
- (* If we are in RELEASE mode then we do not print indentation *)
-
- Pretty.fastMode := true;
-
- if !E.verboseFlag then
- ignore (E.log "printing file %s\n" outfile);
- let print x = fprint out 78 x in
- print (text ("/* Generated by CIL v. " ^ cilVersion ^ " */\n" ^
- (* sm: I want to easily tell whether the generated output
- * is with print_CIL_Input or not *)
- "/* print_CIL_Input is " ^ (if !print_CIL_Input then "true" else "false") ^ " */\n\n"));
- iterGlobals file (fun g -> dumpGlobal pp out g);
-
- (* sm: we have to flush the output channel; if we don't then under *)
- (* some circumstances (I haven't figure out exactly when, but it happens *)
- (* more often with big inputs), we get a truncated output file *)
- flush out
-
-
-
-(******************
- ******************
- ******************)
-
-
-
-(******************** OPTIMIZATIONS *****)
-let rec peepHole1 (* Process one statement and possibly replace it *)
- (doone: instr -> instr list option)
- (* Scan a block and recurse inside nested blocks *)
- (ss: stmt list) : unit =
- let rec doInstrList (il: instr list) : instr list =
- match il with
- [] -> []
- | i :: rest -> begin
- match doone i with
- None -> i :: doInstrList rest
- | Some sl -> doInstrList (sl @ rest)
- end
- in
-
- List.iter
- (fun s ->
- match s.skind with
- Instr il -> s.skind <- Instr (doInstrList il)
- | If (e, tb, eb, _) ->
- peepHole1 doone tb.bstmts;
- peepHole1 doone eb.bstmts
- | Switch (e, b, _, _) -> peepHole1 doone b.bstmts
-(*
- | Loop (b, l, _, _) -> peepHole1 doone b.bstmts
-*)
- | While (_, b, _) -> peepHole1 doone b.bstmts
- | DoWhile (_, b, _) -> peepHole1 doone b.bstmts
- | For (bInit, _, bIter, b, _) ->
- peepHole1 doone bInit.bstmts;
- peepHole1 doone bIter.bstmts;
- peepHole1 doone b.bstmts
- | Block b -> peepHole1 doone b.bstmts
- | TryFinally (b, h, l) ->
- peepHole1 doone b.bstmts;
- peepHole1 doone h.bstmts
- | TryExcept (b, (il, e), h, l) ->
- peepHole1 doone b.bstmts;
- peepHole1 doone h.bstmts;
- s.skind <- TryExcept(b, (doInstrList il, e), h, l);
- | Return _ | Goto _ | Break _ | Continue _ -> ())
- ss
-
-let rec peepHole2 (* Process two statements and possibly replace them both *)
- (dotwo: instr * instr -> instr list option)
- (ss: stmt list) : unit =
- let rec doInstrList (il: instr list) : instr list =
- match il with
- [] -> []
- | [i] -> [i]
- | (i1 :: ((i2 :: rest) as rest2)) ->
- begin
- match dotwo (i1,i2) with
- None -> i1 :: doInstrList rest2
- | Some sl -> doInstrList (sl @ rest)
- end
- in
- List.iter
- (fun s ->
- match s.skind with
- Instr il -> s.skind <- Instr (doInstrList il)
- | If (e, tb, eb, _) ->
- peepHole2 dotwo tb.bstmts;
- peepHole2 dotwo eb.bstmts
- | Switch (e, b, _, _) -> peepHole2 dotwo b.bstmts
-(*
- | Loop (b, l, _, _) -> peepHole2 dotwo b.bstmts
-*)
- | While (_, b, _) -> peepHole2 dotwo b.bstmts
- | DoWhile (_, b, _) -> peepHole2 dotwo b.bstmts
- | For (bInit, _, bIter, b, _) ->
- peepHole2 dotwo bInit.bstmts;
- peepHole2 dotwo bIter.bstmts;
- peepHole2 dotwo b.bstmts
- | Block b -> peepHole2 dotwo b.bstmts
- | TryFinally (b, h, l) -> peepHole2 dotwo b.bstmts;
- peepHole2 dotwo h.bstmts
- | TryExcept (b, (il, e), h, l) ->
- peepHole2 dotwo b.bstmts;
- peepHole2 dotwo h.bstmts;
- s.skind <- TryExcept (b, (doInstrList il, e), h, l)
-
- | Return _ | Goto _ | Break _ | Continue _ -> ())
- ss
-
-
-
-
-(*** Type signatures ***)
-
-(* Helper class for typeSig: replace any types in attributes with typsigs *)
-class typeSigVisitor(typeSigConverter: typ->typsig) = object
- inherit nopCilVisitor
- method vattrparam ap =
- match ap with
- | ASizeOf t -> ChangeTo (ASizeOfS (typeSigConverter t))
- | AAlignOf t -> ChangeTo (AAlignOfS (typeSigConverter t))
- | _ -> DoChildren
-end
-
-let typeSigAddAttrs a0 t =
- if a0 == [] then t else
- match t with
- TSBase t -> TSBase (typeAddAttributes a0 t)
- | TSPtr (ts, a) -> TSPtr (ts, addAttributes a0 a)
- | TSArray (ts, l, a) -> TSArray(ts, l, addAttributes a0 a)
- | TSComp (iss, n, a) -> TSComp (iss, n, addAttributes a0 a)
- | TSEnum (n, a) -> TSEnum (n, addAttributes a0 a)
- | TSFun(ts, tsargs, isva, a) -> TSFun(ts, tsargs, isva, addAttributes a0 a)
-
-(* Compute a type signature.
- Use ~ignoreSign:true to convert all signed integer types to unsigned,
- so that signed and unsigned will compare the same. *)
-let rec typeSigWithAttrs ?(ignoreSign=false) doattr t =
- let typeSig = typeSigWithAttrs ~ignoreSign doattr in
- let attrVisitor = new typeSigVisitor typeSig in
- let doattr al = visitCilAttributes attrVisitor (doattr al) in
- match t with
- | TInt (ik, al) ->
- let ik' = if ignoreSign then begin
- match ik with
- | ISChar | IChar -> IUChar
- | IShort -> IUShort
- | IInt -> IUInt
- | ILong -> IULong
- | ILongLong -> IULongLong
- | _ -> ik
- end else
- ik
- in
- TSBase (TInt (ik', doattr al))
- | TFloat (fk, al) -> TSBase (TFloat (fk, doattr al))
- | TVoid al -> TSBase (TVoid (doattr al))
- | TEnum (enum, a) -> TSEnum (enum.ename, doattr a)
- | TPtr (t, a) -> TSPtr (typeSig t, doattr a)
- | TArray (t,l,a) -> (* We do not want fancy expressions in array lengths.
- * So constant fold the lengths *)
- let l' =
- match l with
- Some l -> begin
- match constFold true l with
- Const(CInt64(i, _, _)) -> Some i
- | e -> E.s (E.bug "Invalid length in array type: %a\n"
- (!pd_exp) e)
- end
- | None -> None
- in
- TSArray(typeSig t, l', doattr a)
-
- | TComp (comp, a) ->
- TSComp (comp.cstruct, comp.cname, doattr (addAttributes comp.cattr a))
- | TFun(rt,args,isva,a) ->
- TSFun(typeSig rt,
- List.map (fun (_, atype, _) -> (typeSig atype)) (argsToList args),
- isva, doattr a)
- | TNamed(t, a) -> typeSigAddAttrs (doattr a) (typeSig t.ttype)
- | TBuiltin_va_list al -> TSBase (TBuiltin_va_list (doattr al))
-
-let typeSig t =
- typeSigWithAttrs (fun al -> al) t
-
-let _ = pTypeSig := typeSig
-
-(* Remove the attribute from the top-level of the type signature *)
-let setTypeSigAttrs (a: attribute list) = function
- TSBase t -> TSBase (setTypeAttrs t a)
- | TSPtr (ts, _) -> TSPtr (ts, a)
- | TSArray (ts, l, _) -> TSArray(ts, l, a)
- | TSComp (iss, n, _) -> TSComp (iss, n, a)
- | TSEnum (n, _) -> TSEnum (n, a)
- | TSFun (ts, tsargs, isva, _) -> TSFun (ts, tsargs, isva, a)
-
-
-let typeSigAttrs = function
- TSBase t -> typeAttrs t
- | TSPtr (ts, a) -> a
- | TSArray (ts, l, a) -> a
- | TSComp (iss, n, a) -> a
- | TSEnum (n, a) -> a
- | TSFun (ts, tsargs, isva, a) -> a
-
-
-
-let dExp: doc -> exp =
- fun d -> Const(CStr(sprint !lineLength d))
-
-let dInstr: doc -> location -> instr =
- fun d l -> Asm([], [sprint !lineLength d], [], [], [], l)
-
-let dGlobal: doc -> location -> global =
- fun d l -> GAsm(sprint !lineLength d, l)
-
-let rec addOffset (toadd: offset) (off: offset) : offset =
- match off with
- NoOffset -> toadd
- | Field(fid', offset) -> Field(fid', addOffset toadd offset)
- | Index(e, offset) -> Index(e, addOffset toadd offset)
-
- (* Add an offset at the end of an lv *)
-let addOffsetLval toadd (b, off) : lval =
- b, addOffset toadd off
-
-let rec removeOffset (off: offset) : offset * offset =
- match off with
- NoOffset -> NoOffset, NoOffset
- | Field(f, NoOffset) -> NoOffset, off
- | Index(i, NoOffset) -> NoOffset, off
- | Field(f, restoff) ->
- let off', last = removeOffset restoff in
- Field(f, off'), last
- | Index(i, restoff) ->
- let off', last = removeOffset restoff in
- Index(i, off'), last
-
-let removeOffsetLval ((b, off): lval) : lval * offset =
- let off', last = removeOffset off in
- (b, off'), last
-
- (* Make an AddrOf. Given an lval of type T will give back an expression of
- * type ptr(T) *)
-let mkAddrOf ((b, off) as lval) : exp =
- (* Never take the address of a register variable *)
- (match lval with
- Var vi, off when vi.vstorage = Register -> vi.vstorage <- NoStorage
- | _ -> ());
- match lval with
- Mem e, NoOffset -> e
- | b, Index(z, NoOffset) when isZero z -> StartOf (b, NoOffset)(* array *)
- | _ -> AddrOf lval
-
-
-let mkAddrOrStartOf (lv: lval) : exp =
- match unrollType (typeOfLval lv) with
- TArray _ -> StartOf lv
- | _ -> mkAddrOf lv
-
-
- (* Make a Mem, while optimizing AddrOf. The type of the addr must be
- * TPtr(t) and the type of the resulting lval is t. Note that in CIL the
- * implicit conversion between a function and a pointer to a function does
- * not apply. You must do the conversion yourself using AddrOf *)
-let mkMem ~(addr: exp) ~(off: offset) : lval =
- let res =
- match addr, off with
- AddrOf lv, _ -> addOffsetLval off lv
- | StartOf lv, _ -> (* Must be an array *)
- addOffsetLval (Index(zero, off)) lv
- | _, _ -> Mem addr, off
- in
-(* ignore (E.log "memof : %a:%a\nresult = %a\n"
- d_plainexp addr d_plainoffset off d_plainexp res); *)
- res
-
-
-
-let splitFunctionType (ftype: typ)
- : typ * (string * typ * attributes) list option * bool * attributes =
- match unrollType ftype with
- TFun (rt, args, isva, a) -> rt, args, isva, a
- | _ -> E.s (bug "splitFunctionType invoked on a non function type %a"
- d_type ftype)
-
-let splitFunctionTypeVI (fvi: varinfo)
- : typ * (string * typ * attributes) list option * bool * attributes =
- match unrollType fvi.vtype with
- TFun (rt, args, isva, a) -> rt, args, isva, a
- | _ -> E.s (bug "Function %s invoked on a non function type" fvi.vname)
-
-let isArrayType t =
- match unrollType t with
- TArray _ -> true
- | _ -> false
-
-
-let rec isConstant = function
- | Const _ -> true
- | UnOp (_, e, _) -> isConstant e
- | BinOp (_, e1, e2, _) -> isConstant e1 && isConstant e2
- | Lval (Var vi, NoOffset) ->
- (vi.vglob && isArrayType vi.vtype || isFunctionType vi.vtype)
- | Lval _ -> false
- | SizeOf _ | SizeOfE _ | SizeOfStr _ | AlignOf _ | AlignOfE _ -> true
- | CastE (_, e) -> isConstant e
- | AddrOf (Var vi, off) | StartOf (Var vi, off)
- -> vi.vglob && isConstantOff off
- | AddrOf (Mem e, off) | StartOf(Mem e, off)
- -> isConstant e && isConstantOff off
-
-and isConstantOff = function
- NoOffset -> true
- | Field(fi, off) -> isConstantOff off
- | Index(e, off) -> isConstant e && isConstantOff off
-
-
-let getCompField (cinfo:compinfo) (fieldName:string) : fieldinfo =
- (List.find (fun fi -> fi.fname = fieldName) cinfo.cfields)
-
-
-let rec mkCastT ~(e: exp) ~(oldt: typ) ~(newt: typ) =
- (* Do not remove old casts because they are conversions !!! *)
- if Util.equals (typeSig oldt) (typeSig newt) then begin
- e
- end else begin
- (* Watch out for constants *)
- match newt, e with
- TInt(newik, []), Const(CInt64(i, _, _)) -> kinteger64 newik i
- | _ -> CastE(newt,e)
- end
-
-let mkCast ~(e: exp) ~(newt: typ) =
- mkCastT e (typeOf e) newt
-
-type existsAction =
- ExistsTrue (* We have found it *)
- | ExistsFalse (* Stop processing this branch *)
- | ExistsMaybe (* This node is not what we are
- * looking for but maybe its
- * successors are *)
-let existsType (f: typ -> existsAction) (t: typ) : bool =
- let memo : (int, unit) H.t = H.create 17 in (* Memo table *)
- let rec loop t =
- match f t with
- ExistsTrue -> true
- | ExistsFalse -> false
- | ExistsMaybe ->
- (match t with
- TNamed (t', _) -> loop t'.ttype
- | TComp (c, _) -> loopComp c
- | TArray (t', _, _) -> loop t'
- | TPtr (t', _) -> loop t'
- | TFun (rt, args, _, _) ->
- (loop rt || List.exists (fun (_, at, _) -> loop at)
- (argsToList args))
- | _ -> false)
- and loopComp c =
- if H.mem memo c.ckey then
- (* We are looping, the answer must be false *)
- false
- else begin
- H.add memo c.ckey ();
- List.exists (fun f -> loop f.ftype) c.cfields
- end
- in
- loop t
-
-
-(* Try to do an increment, with constant folding *)
-let increm (e: exp) (i: int) =
- let et = typeOf e in
- let bop = if isPointerType et then PlusPI else PlusA in
- constFold false (BinOp(bop, e, integer i, et))
-
-exception LenOfArray
-let lenOfArray (eo: exp option) : int =
- match eo with
- None -> raise LenOfArray
- | Some e -> begin
- match constFold true e with
- | Const(CInt64(ni, _, _)) when ni >= Int64.zero ->
- Int64.to_int ni
- | e -> raise LenOfArray
- end
-
-
-(*** Make a initializer for zeroe-ing a data type ***)
-let rec makeZeroInit (t: typ) : init =
- match unrollType t with
- TInt (ik, _) -> SingleInit (Const(CInt64(Int64.zero, ik, None)))
- | TFloat(fk, _) -> SingleInit(Const(CReal(0.0, fk, None)))
- | TEnum _ -> SingleInit zero
- | TComp (comp, _) as t' when comp.cstruct ->
- let inits =
- List.fold_right
- (fun f acc ->
- if f.fname <> missingFieldName then
- (Field(f, NoOffset), makeZeroInit f.ftype) :: acc
- else
- acc)
- comp.cfields []
- in
- CompoundInit (t', inits)
-
- | TComp (comp, _) when not comp.cstruct ->
- let fstfield, rest =
- match comp.cfields with
- f :: rest -> f, rest
- | [] -> E.s (unimp "Cannot create init for empty union")
- in
- let fieldToInit =
- if !msvcMode then
- (* ISO C99 [6.7.8.10] says that the first field of the union
- is the one we should initialize. *)
- fstfield
- else begin
- (* gcc initializes the whole union to zero. So choose the largest
- field, and set that to zero. Choose the first field if possible.
- MSVC also initializes the whole union, but use the ISO behavior
- for MSVC because it only allows compound initializers to refer
- to the first union field. *)
- let fieldSize f = try bitsSizeOf f.ftype with SizeOfError _ -> 0 in
- let widestField, widestFieldWidth =
- List.fold_left (fun acc thisField ->
- let widestField, widestFieldWidth = acc in
- let thisSize = fieldSize thisField in
- if thisSize > widestFieldWidth then
- thisField, thisSize
- else
- acc)
- (fstfield, fieldSize fstfield)
- rest
- in
- widestField
- end
- in
- CompoundInit(t, [(Field(fieldToInit, NoOffset),
- makeZeroInit fieldToInit.ftype)])
-
- | TArray(bt, Some len, _) as t' ->
- let n =
- match constFold true len with
- Const(CInt64(n, _, _)) -> Int64.to_int n
- | _ -> E.s (E.unimp "Cannot understand length of array")
- in
- let initbt = makeZeroInit bt in
- let rec loopElems acc i =
- if i < 0 then acc
- else loopElems ((Index(integer i, NoOffset), initbt) :: acc) (i - 1)
- in
- CompoundInit(t', loopElems [] (n - 1))
-
- | TArray (bt, None, at) as t' ->
- (* Unsized array, allow it and fill it in later
- * (see cabs2cil.ml, collectInitializer) *)
- CompoundInit (t', [])
-
- | TPtr _ as t -> SingleInit(CastE(t, zero))
- | x -> E.s (unimp "Cannot initialize type: %a" d_type x)
-
-
-(**** Fold over the list of initializers in a Compound. In the case of an
- * array initializer only the initializers present are scanned (a prefix of
- * all initializers) *)
-let foldLeftCompound
- ~(doinit: offset -> init -> typ -> 'a -> 'a)
- ~(ct: typ)
- ~(initl: (offset * init) list)
- ~(acc: 'a) : 'a =
- match unrollType ct with
- TArray(bt, _, _) ->
- List.fold_left (fun acc (o, i) -> doinit o i bt acc) acc initl
-
- | TComp (comp, _) ->
- let getTypeOffset = function
- Field(f, NoOffset) -> f.ftype
- | _ -> E.s (bug "foldLeftCompound: malformed initializer")
- in
- List.fold_left
- (fun acc (o, i) -> doinit o i (getTypeOffset o) acc) acc initl
-
- | _ -> E.s (unimp "Type of Compound is not array or struct or union")
-
-(**** Fold over the list of initializers in a Compound. Like foldLeftCompound
- * but scans even the zero-initializers that are missing at the end of the
- * array *)
-let foldLeftCompoundAll
- ~(doinit: offset -> init -> typ -> 'a -> 'a)
- ~(ct: typ)
- ~(initl: (offset * init) list)
- ~(acc: 'a) : 'a =
- match unrollType ct with
- TArray(bt, leno, _) -> begin
- let part =
- List.fold_left (fun acc (o, i) -> doinit o i bt acc) acc initl in
- (* See how many more we have to do *)
- match leno with
- Some lene -> begin
- match constFold true lene with
- Const(CInt64(i, _, _)) ->
- let len_array = Int64.to_int i in
- let len_init = List.length initl in
- if len_array > len_init then
- let zi = makeZeroInit bt in
- let rec loop acc i =
- if i >= len_array then acc
- else
- loop (doinit (Index(integer i, NoOffset)) zi bt acc)
- (i + 1)
- in
- loop part (len_init + 1)
- else
- part
- | _ -> E.s (unimp "foldLeftCompoundAll: array with initializer and non-constant length\n")
- end
-
- | _ -> E.s (unimp "foldLeftCompoundAll: TArray with initializer and no length")
- end
- | TComp (comp, _) ->
- let getTypeOffset = function
- Field(f, NoOffset) -> f.ftype
- | _ -> E.s (bug "foldLeftCompound: malformed initializer")
- in
- List.fold_left
- (fun acc (o, i) -> doinit o i (getTypeOffset o) acc) acc initl
-
- | _ -> E.s (E.unimp "Type of Compound is not array or struct or union")
-
-
-
-let rec isCompleteType t =
- match unrollType t with
- | TArray(t, None, _) -> false
- | TArray(t, Some z, _) when isZero z -> false
- | TComp (comp, _) -> (* Struct or union *)
- List.for_all (fun fi -> isCompleteType fi.ftype) comp.cfields
- | _ -> true
-
-
-module A = Alpha
-
-
-(** Uniquefy the variable names *)
-let uniqueVarNames (f: file) : unit =
- (* Setup the alpha conversion table for globals *)
- let gAlphaTable: (string,
- location A.alphaTableData ref) H.t = H.create 113 in
- (* Keep also track of the global names that we have used. Map them to the
- * variable ID. We do this only to check that we do not have two globals
- * with the same name. *)
- let globalNames: (string, int) H.t = H.create 113 in
- (* Scan the file and add the global names to the table *)
- iterGlobals f
- (function
- GVarDecl(vi, l)
- | GVar(vi, _, l)
- | GFun({svar = vi}, l) ->
- (* See if we have used this name already for something else *)
- (try
- let oldid = H.find globalNames vi.vname in
- if oldid <> vi.vid then
- ignore (warn "The name %s is used for two distinct globals"
- vi.vname);
- (* Here if we have used this name already. Go ahead *)
- ()
- with Not_found -> begin
- (* Here if this is the first time we define a name *)
- H.add globalNames vi.vname vi.vid;
- (* And register it *)
- A.registerAlphaName gAlphaTable None vi.vname !currentLoc;
- ()
- end)
- | _ -> ());
-
- (* Now we must scan the function bodies and rename the locals *)
- iterGlobals f
- (function
- GFun(fdec, l) -> begin
- currentLoc := l;
- (* Setup an undo list to be able to revert the changes to the
- * global alpha table *)
- let undolist = ref [] in
- (* Process one local variable *)
- let processLocal (v: varinfo) =
- let newname, oldloc =
- A.newAlphaName gAlphaTable (Some undolist) v.vname
- !currentLoc
- in
- if false && newname <> v.vname then (* Disable this warning *)
- ignore (warn "uniqueVarNames: Changing the name of local %s in %s to %s (due to duplicate at %a)\n"
- v.vname fdec.svar.vname newname d_loc oldloc);
- v.vname <- newname
- in
- (* Do the formals first *)
- List.iter processLocal fdec.sformals;
- (* Fix the type again *)
- setFormals fdec fdec.sformals;
- (* And now the locals *)
- List.iter processLocal fdec.slocals;
- (* Undo the changes to the global table *)
- A.undoAlphaChanges gAlphaTable !undolist;
- ()
- end
- | _ -> ());
- ()
-
-
-(* A visitor that makes a deep copy of a function body *)
-class copyFunctionVisitor (newname: string) = object (self)
- inherit nopCilVisitor
-
- (* Keep here a maping from locals to their copies *)
- val map : (string, varinfo) H.t = H.create 113
- (* Keep here a maping from statements to their copies *)
- val stmtmap : (int, stmt) H.t = H.create 113
- val sid = ref 0 (* Will have to assign ids to statements *)
- (* Keep here a list of statements to be patched *)
- val patches : stmt list ref = ref []
-
- val argid = ref 0
-
- (* This is the main function *)
- method vfunc (f: fundec) : fundec visitAction =
- (* We need a map from the old locals/formals to the new ones *)
- H.clear map;
- argid := 0;
- (* Make a copy of the fundec. *)
- let f' = {f with svar = f.svar} in
- let patchfunction (f' : fundec) =
- (* Change the name. Only this late to allow the visitor to copy the
- * svar *)
- f'.svar.vname <- newname;
- let findStmt (i: int) =
- try H.find stmtmap i
- with Not_found -> E.s (bug "Cannot find the copy of stmt#%d" i)
- in
- let patchstmt (s: stmt) =
- match s.skind with
- Goto (sr, l) ->
- (* Make a copy of the reference *)
- let sr' = ref (findStmt !sr.sid) in
- s.skind <- Goto (sr',l)
- | Switch (e, body, cases, l) ->
- s.skind <- Switch (e, body,
- List.map (fun cs -> findStmt cs.sid) cases, l)
- | _ -> ()
- in
- List.iter patchstmt !patches;
- f'
- in
- patches := [];
- sid := 0;
- H.clear stmtmap;
- ChangeDoChildrenPost (f', patchfunction)
-
- (* We must create a new varinfo for each declaration. Memoize to
- * maintain sharing *)
- method vvdec (v: varinfo) =
- (* Some varinfo have empty names. Give them some name *)
- if v.vname = "" then begin
- v.vname <- "arg" ^ string_of_int !argid; incr argid
- end;
- try
- ChangeTo (H.find map v.vname)
- with Not_found -> begin
- let v' = {v with vid = newVID () } in
- H.add map v.vname v';
- ChangeDoChildrenPost (v', fun x -> x)
- end
-
- (* We must replace references to local variables *)
- method vvrbl (v: varinfo) =
- if v.vglob then SkipChildren else
- try
- ChangeTo (H.find map v.vname)
- with Not_found ->
- E.s (bug "Cannot find the new copy of local variable %s" v.vname)
-
-
- (* Replace statements. *)
- method vstmt (s: stmt) : stmt visitAction =
- s.sid <- !sid; incr sid;
- let s' = {s with sid = s.sid} in
- H.add stmtmap s.sid s'; (* Remember where we copied this *)
- (* if we have a Goto or a Switch remember them to fixup at end *)
- (match s'.skind with
- (Goto _ | Switch _) -> patches := s' :: !patches
- | _ -> ());
- (* Do the children *)
- ChangeDoChildrenPost (s', fun x -> x)
-
- (* Copy blocks since they are mutable *)
- method vblock (b: block) =
- ChangeDoChildrenPost ({b with bstmts = b.bstmts}, fun x -> x)
-
-
- method vglob _ = E.s (bug "copyFunction should not be used on globals")
-end
-
-(* We need a function that copies a CIL function. *)
-let copyFunction (f: fundec) (newname: string) : fundec =
- visitCilFunction (new copyFunctionVisitor(newname)) f
-
-(********* Compute the CFG ********)
-let sid_counter = ref 0
-
-let new_sid () =
- let id = !sid_counter in
- incr sid_counter;
- id
-
-let statements : stmt list ref = ref []
-(* Clear all info about the CFG in statements *)
-class clear : cilVisitor = object
- inherit nopCilVisitor
- method vstmt s = begin
- s.sid <- !sid_counter ;
- incr sid_counter ;
- statements := s :: !statements;
- s.succs <- [] ;
- s.preds <- [] ;
- DoChildren
- end
- method vexpr _ = SkipChildren
- method vtype _ = SkipChildren
- method vinst _ = SkipChildren
-end
-
-let link source dest = begin
- if not (List.mem dest source.succs) then
- source.succs <- dest :: source.succs ;
- if not (List.mem source dest.preds) then
- dest.preds <- source :: dest.preds
-end
-let trylink source dest_option = match dest_option with
- None -> ()
-| Some(dest) -> link source dest
-
-
-(** Cmopute the successors and predecessors of a block, given a fallthrough *)
-let rec succpred_block b fallthrough =
- let rec handle sl = match sl with
- [] -> ()
- | [a] -> succpred_stmt a fallthrough
- | hd :: ((next :: _) as tl) ->
- succpred_stmt hd (Some next) ;
- handle tl
- in handle b.bstmts
-
-
-and succpred_stmt s fallthrough =
- match s.skind with
- Instr _ -> trylink s fallthrough
- | Return _ -> ()
- | Goto(dest,l) -> link s !dest
- | Break _
- | Continue _
- | Switch _ ->
- failwith "computeCFGInfo: cannot be called on functions with break, continue or switch statements. Use prepareCFG first to remove them."
-
- | If(e1,b1,b2,l) ->
- (match b1.bstmts with
- [] -> trylink s fallthrough
- | hd :: tl -> (link s hd ; succpred_block b1 fallthrough )) ;
- (match b2.bstmts with
- [] -> trylink s fallthrough
- | hd :: tl -> (link s hd ; succpred_block b2 fallthrough ))
-
-(*
- | Loop(b,l,_,_) ->
- begin match b.bstmts with
- [] -> failwith "computeCFGInfo: empty loop"
- | hd :: tl ->
- link s hd ;
- succpred_block b (Some(hd))
- end
-*)
-
- | While (e, b, l) -> begin match b.bstmts with
- | [] -> failwith "computeCFGInfo: empty loop"
- | hd :: tl -> link s hd ;
- succpred_block b (Some(hd))
- end
-
- | DoWhile (e, b, l) ->begin match b.bstmts with
- | [] -> failwith "computeCFGInfo: empty loop"
- | hd :: tl -> link s hd ;
- succpred_block b (Some(hd))
- end
-
- | For (bInit, e, bIter, b, l) ->
- (match bInit.bstmts with
- | [] -> failwith "computeCFGInfo: empty loop"
- | hd :: tl -> link s hd ;
- succpred_block bInit (Some(hd))) ;
- (match bIter.bstmts with
- | [] -> failwith "computeCFGInfo: empty loop"
- | hd :: tl -> link s hd ;
- succpred_block bIter (Some(hd))) ;
- (match b.bstmts with
- | [] -> failwith "computeCFGInfo: empty loop"
- | hd :: tl -> link s hd ;
- succpred_block b (Some(hd))) ;
-
- | Block(b) -> begin match b.bstmts with
- [] -> trylink s fallthrough
- | hd :: tl -> link s hd ;
- succpred_block b fallthrough
- end
- | TryExcept _ | TryFinally _ ->
- failwith "computeCFGInfo: structured exception handling not implemented"
-
-(* [weimer] Sun May 5 12:25:24 PDT 2002
- * This code was pulled from ext/switch.ml because it looks like we really
- * want it to be part of CIL.
- *
- * Here is the magic handling to
- * (1) replace switch statements with if/goto
- * (2) remove "break"
- * (3) remove "default"
- * (4) remove "continue"
- *)
-let is_case_label l = match l with
- | Case _ | Default _ -> true
- | _ -> false
-
-let switch_count = ref (-1)
-let get_switch_count () =
- switch_count := 1 + !switch_count ;
- !switch_count
-
-let switch_label = ref (-1)
-
-let rec xform_switch_stmt s break_dest cont_dest label_index = begin
- s.labels <- List.map (fun lab -> match lab with
- Label _ -> lab
- | Case(e,l) ->
- let suffix =
- match isInteger e with
- | Some value ->
- if value < Int64.zero then
- "neg_" ^ Int64.to_string (Int64.neg value)
- else
- Int64.to_string value
- | None ->
- incr switch_label;
- "exp_" ^ string_of_int !switch_label
- in
- let str = Pretty.sprint !lineLength
- (Pretty.dprintf "switch_%d_%s" label_index suffix) in
- (Label(str,l,false))
- | Default(l) -> (Label(Printf.sprintf
- "switch_%d_default" label_index,l,false))
- ) s.labels ;
- match s.skind with
- | Instr _ | Return _ | Goto _ -> ()
- | Break(l) -> begin try
- s.skind <- Goto(break_dest (),l)
- with e ->
- ignore (error "prepareCFG: break: %a@!" d_stmt s) ;
- raise e
- end
- | Continue(l) -> begin try
- s.skind <- Goto(cont_dest (),l)
- with e ->
- ignore (error "prepareCFG: continue: %a@!" d_stmt s) ;
- raise e
- end
- | If(e,b1,b2,l) -> xform_switch_block b1 break_dest cont_dest label_index ;
- xform_switch_block b2 break_dest cont_dest label_index
- | Switch(e,b,sl,l) -> begin
- (* change
- * switch (se) {
- * case 0: s0 ;
- * case 1: s1 ; break;
- * ...
- * }
- *
- * into:
- *
- * if (se == 0) goto label_0;
- * else if (se == 1) goto label_1;
- * ...
- * else if (0) { // body_block
- * label_0: s0;
- * label_1: s1; goto label_break;
- * ...
- * } else if (0) { // break_block
- * label_break: ; // break_stmt
- * }
- *)
- let i = get_switch_count () in
- let break_stmt = mkStmt (Instr []) in
- break_stmt.labels <-
- [Label((Printf.sprintf "switch_%d_break" i),l,false)] ;
- let break_block = mkBlock [ break_stmt ] in
- let body_block = b in
- let body_if_stmtkind = (If(zero,body_block,break_block,l)) in
-
- (* The default case, if present, must be used only if *all*
- non-default cases fail [ISO/IEC 9899:1999, §6.8.4.2, ¶5]. As a
- result, we sort the order in which we handle the labels (but not the
- order in which we print out the statements, so fall-through still
- works as expected). *)
- let compare_choices s1 s2 = match s1.labels, s2.labels with
- | (Default(_) :: _), _ -> 1
- | _, (Default(_) :: _) -> -1
- | _, _ -> 0
- in
-
- let rec handle_choices sl = match sl with
- [] -> body_if_stmtkind
- | stmt_hd :: stmt_tl -> begin
- let rec handle_labels lab_list = begin
- match lab_list with
- [] -> handle_choices stmt_tl
- | Case(ce,cl) :: lab_tl ->
- let pred = BinOp(Eq,e,ce,intType) in
- let then_block = mkBlock [ mkStmt (Goto(ref stmt_hd,cl)) ] in
- let else_block = mkBlock [ mkStmt (handle_labels lab_tl) ] in
- If(pred,then_block,else_block,cl)
- | Default(dl) :: lab_tl ->
- (* ww: before this was 'if (1) goto label', but as Ben points
- out this might confuse someone down the line who doesn't have
- special handling for if(1) into thinking that there are two
- paths here. The simpler 'goto label' is what we want. *)
- Block(mkBlock [ mkStmt (Goto(ref stmt_hd,dl)) ;
- mkStmt (handle_labels lab_tl) ])
- | Label(_,_,_) :: lab_tl -> handle_labels lab_tl
- end in
- handle_labels stmt_hd.labels
- end in
- s.skind <- handle_choices (List.sort compare_choices sl) ;
- xform_switch_block b (fun () -> ref break_stmt) cont_dest i
- end
-(*
- | Loop(b,l,_,_) ->
- let i = get_switch_count () in
- let break_stmt = mkStmt (Instr []) in
- break_stmt.labels <-
- [Label((Printf.sprintf "while_%d_break" i),l,false)] ;
- let cont_stmt = mkStmt (Instr []) in
- cont_stmt.labels <-
- [Label((Printf.sprintf "while_%d_continue" i),l,false)] ;
- b.bstmts <- cont_stmt :: b.bstmts ;
- let this_stmt = mkStmt
- (Loop(b,l,Some(cont_stmt),Some(break_stmt))) in
- let break_dest () = ref break_stmt in
- let cont_dest () = ref cont_stmt in
- xform_switch_block b break_dest cont_dest label_index ;
- break_stmt.succs <- s.succs ;
- let new_block = mkBlock [ this_stmt ; break_stmt ] in
- s.skind <- Block new_block
-*)
- | While (e, b, l) ->
- let i = get_switch_count () in
- let break_stmt = mkStmt (Instr []) in
- break_stmt.labels <-
- [Label((Printf.sprintf "while_%d_break" i),l,false)] ;
- let cont_stmt = mkStmt (Instr []) in
- cont_stmt.labels <-
- [Label((Printf.sprintf "while_%d_continue" i),l,false)] ;
- b.bstmts <- cont_stmt :: b.bstmts ;
- let this_stmt = mkStmt
- (While(e,b,l)) in
- let break_dest () = ref break_stmt in
- let cont_dest () = ref cont_stmt in
- xform_switch_block b break_dest cont_dest label_index ;
- break_stmt.succs <- s.succs ;
- let new_block = mkBlock [ this_stmt ; break_stmt ] in
- s.skind <- Block new_block
-
- | DoWhile (e, b, l) ->
- let i = get_switch_count () in
- let break_stmt = mkStmt (Instr []) in
- break_stmt.labels <-
- [Label((Printf.sprintf "while_%d_break" i),l,false)] ;
- let cont_stmt = mkStmt (Instr []) in
- cont_stmt.labels <-
- [Label((Printf.sprintf "while_%d_continue" i),l,false)] ;
- b.bstmts <- cont_stmt :: b.bstmts ;
- let this_stmt = mkStmt
- (DoWhile(e,b,l)) in
- let break_dest () = ref break_stmt in
- let cont_dest () = ref cont_stmt in
- xform_switch_block b break_dest cont_dest label_index ;
- break_stmt.succs <- s.succs ;
- let new_block = mkBlock [ this_stmt ; break_stmt ] in
- s.skind <- Block new_block
-
- | For (bInit, e, bIter , b, l) ->
- let i = get_switch_count () in
- let break_stmt = mkStmt (Instr []) in
- break_stmt.labels <-
- [Label((Printf.sprintf "while_%d_break" i),l,false)] ;
- let cont_stmt = mkStmt (Instr []) in
- cont_stmt.labels <-
- [Label((Printf.sprintf "while_%d_continue" i),l,false)] ;
- b.bstmts <- cont_stmt :: b.bstmts ;
- let this_stmt = mkStmt
- (For(bInit,e,bIter,b,l)) in
- let break_dest () = ref break_stmt in
- let cont_dest () = ref cont_stmt in
- xform_switch_block b break_dest cont_dest label_index ;
- break_stmt.succs <- s.succs ;
- let new_block = mkBlock [ this_stmt ; break_stmt ] in
- s.skind <- Block new_block
-
-
- | Block(b) -> xform_switch_block b break_dest cont_dest label_index
-
- | TryExcept _ | TryFinally _ ->
- failwith "xform_switch_statement: structured exception handling not implemented"
-
-end and xform_switch_block b break_dest cont_dest label_index =
- try
- let rec link_succs sl = match sl with
- | [] -> ()
- | hd :: tl -> (if hd.succs = [] then hd.succs <- tl) ; link_succs tl
- in
- link_succs b.bstmts ;
- List.iter (fun stmt ->
- xform_switch_stmt stmt break_dest cont_dest label_index) b.bstmts ;
- with e ->
- List.iter (fun stmt -> ignore
- (warn "prepareCFG: %a@!" d_stmt stmt)) b.bstmts ;
- raise e
-
-(* prepare a function for computeCFGInfo by removing break, continue,
- * default and switch statements/labels and replacing them with Ifs and
- * Gotos. *)
-let prepareCFG (fd : fundec) : unit =
- xform_switch_block fd.sbody
- (fun () -> failwith "prepareCFG: break with no enclosing loop")
- (fun () -> failwith "prepareCFG: continue with no enclosing loop") (-1)
-
-(* make the cfg and return a list of statements *)
-let computeCFGInfo (f : fundec) (global_numbering : bool) : unit =
- if not global_numbering then
- sid_counter := 0 ;
- statements := [];
- let clear_it = new clear in
- ignore (visitCilBlock clear_it f.sbody) ;
- f.smaxstmtid <- Some (!sid_counter) ;
- succpred_block f.sbody (None);
- let res = List.rev !statements in
- statements := [];
- f.sallstmts <- res;
- ()
-
-let initCIL () =
- if not !initCIL_called then begin
- (* Set the machine *)
- theMachine := if !msvcMode then M.msvc else M.gcc;
- (* Pick type for string literals *)
- stringLiteralType := if !theMachine.M.const_string_literals then
- charConstPtrType
- else
- charPtrType;
- (* Find the right ikind given the size *)
- let findIkind (unsigned: bool) (sz: int) : ikind =
- (* Test the most common sizes first *)
- if sz = !theMachine.M.sizeof_int then
- if unsigned then IUInt else IInt
- else if sz = !theMachine.M.sizeof_long then
- if unsigned then IULong else ILong
- else if sz = 1 then
- if unsigned then IUChar else IChar
- else if sz = !theMachine.M.sizeof_short then
- if unsigned then IUShort else IShort
- else if sz = !theMachine.M.sizeof_longlong then
- if unsigned then IULongLong else ILongLong
- else
- E.s(E.unimp "initCIL: cannot find the right ikind for size %d\n" sz)
- in
- upointType := TInt(findIkind true !theMachine.M.sizeof_ptr, []);
- kindOfSizeOf := findIkind true !theMachine.M.sizeof_sizeof;
- typeOfSizeOf := TInt(!kindOfSizeOf, []);
- H.add gccBuiltins "__builtin_memset"
- (voidPtrType, [ voidPtrType; intType; intType ], false);
- wcharKind := findIkind false !theMachine.M.sizeof_wchar;
- wcharType := TInt(!wcharKind, []);
- char_is_unsigned := !theMachine.M.char_is_unsigned;
- little_endian := !theMachine.M.little_endian;
- underscore_name := !theMachine.M.underscore_name;
- nextGlobalVID := 1;
- nextCompinfoKey := 1;
- initCIL_called := true
- end
-
-
-(* We want to bring all type declarations before the data declarations. This
- * is needed for code of the following form:
-
- int f(); // Prototype without arguments
- typedef int FOO;
- int f(FOO x) { ... }
-
- In CIL the prototype also lists the type of the argument as being FOO,
- which is undefined.
-
- There is one catch with this scheme. If the type contains an array whose
- length refers to variables then those variables must be declared before
- the type *)
-
-let pullTypesForward = true
-
-
- (* Scan a type and collect the variables that are refered *)
-class getVarsInGlobalClass (pacc: varinfo list ref) = object
- inherit nopCilVisitor
- method vvrbl (vi: varinfo) =
- pacc := vi :: !pacc;
- SkipChildren
-
- method vglob = function
- GType _ | GCompTag _ -> DoChildren
- | _ -> SkipChildren
-
-end
-
-let getVarsInGlobal (g : global) : varinfo list =
- let pacc : varinfo list ref = ref [] in
- let v : cilVisitor = new getVarsInGlobalClass pacc in
- ignore (visitCilGlobal v g);
- !pacc
-
-let hasPrefix p s =
- let pl = String.length p in
- (String.length s >= pl) && String.sub s 0 pl = p
-
-let pushGlobal (g: global)
- ~(types:global list ref)
- ~(variables: global list ref) =
- if not pullTypesForward then
- variables := g :: !variables
- else
- begin
- (* Collect a list of variables that are refered from the type. Return
- * Some if the global should go with the types and None if it should go
- * to the variables. *)
- let varsintype : (varinfo list * location) option =
- match g with
- GType (_, l) | GCompTag (_, l) -> Some (getVarsInGlobal g, l)
- | GEnumTag (_, l) | GPragma (Attr("pack", _), l)
- | GCompTagDecl (_, l) | GEnumTagDecl (_, l) -> Some ([], l)
- (** Move the warning pragmas early
- | GPragma(Attr(s, _), l) when hasPrefix "warning" s -> Some ([], l)
- *)
- | _ -> None (* Does not go with the types *)
- in
- match varsintype with
- None -> variables := g :: !variables
- | Some (vl, loc) ->
- types :=
- (* insert declarations for referred variables ('vl'), before
- * the type definition 'g' itself *)
- g :: (List.fold_left (fun acc v -> GVarDecl(v, loc) :: acc)
- !types vl)
- end
-
-
-type formatArg =
- Fe of exp
- | Feo of exp option (** For array lengths *)
- | Fu of unop
- | Fb of binop
- | Fk of ikind
- | FE of exp list (** For arguments in a function call *)
- | Ff of (string * typ * attributes) (** For a formal argument *)
- | FF of (string * typ * attributes) list (* For formal argument lists *)
- | Fva of bool (** For the ellipsis in a function type *)
- | Fv of varinfo
- | Fl of lval
- | Flo of lval option (** For the result of a function call *)
- | Fo of offset
- | Fc of compinfo
- | Fi of instr
- | FI of instr list
- | Ft of typ
- | Fd of int
- | Fg of string
- | Fs of stmt
- | FS of stmt list
- | FA of attributes
-
- | Fp of attrparam
- | FP of attrparam list
-
- | FX of string
-
-let d_formatarg () = function
- Fe e -> dprintf "Fe(%a)" d_exp e
- | Feo None -> dprintf "Feo(None)"
- | Feo (Some e) -> dprintf "Feo(%a)" d_exp e
- | FE _ -> dprintf "FE()"
- | Fk ik -> dprintf "Fk()"
- | Fva b -> dprintf "Fva(%b)" b
- | Ff (an, _, _) -> dprintf "Ff(%s)" an
- | FF _ -> dprintf "FF(...)"
- | FA _ -> dprintf "FA(...)"
- | Fu uo -> dprintf "Fu()"
- | Fb bo -> dprintf "Fb()"
- | Fv v -> dprintf "Fv(%s)" v.vname
- | Fl l -> dprintf "Fl(%a)" d_lval l
- | Flo None -> dprintf "Flo(None)"
- | Flo (Some l) -> dprintf "Flo(%a)" d_lval l
- | Fo o -> dprintf "Fo"
- | Fc ci -> dprintf "Fc(%s)" ci.cname
- | Fi i -> dprintf "Fi(...)"
- | FI i -> dprintf "FI(...)"
- | Ft t -> dprintf "Ft(%a)" d_type t
- | Fd n -> dprintf "Fd(%d)" n
- | Fg s -> dprintf "Fg(%s)" s
- | Fp _ -> dprintf "Fp(...)"
- | FP n -> dprintf "FP(...)"
- | Fs _ -> dprintf "FS"
- | FS _ -> dprintf "FS"
-
- | FX _ -> dprintf "FX()"
-
-
diff --git a/cil/src/cil.mli b/cil/src/cil.mli
deleted file mode 100644
index 31c4e65ca7c7ea89db54f8987e579373f3e871ee..0000000000000000000000000000000000000000
--- a/cil/src/cil.mli
+++ /dev/null
@@ -1,2455 +0,0 @@
-(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(*
- * CIL: An intermediate language for analyzing C programs.
- *
- * George Necula
- *
- *)
-
-(** CIL API Documentation. An html version of this document can be found at
- * http://manju.cs.berkeley.edu/cil. *)
-
-(** Call this function to perform some initialization. Call if after you have
- * set {!Cil.msvcMode}. *)
-val initCIL: unit -> unit
-
-
-(** This are the CIL version numbers. A CIL version is a number of the form
- * M.m.r (major, minor and release) *)
-val cilVersion: string
-val cilVersionMajor: int
-val cilVersionMinor: int
-val cilVersionRevision: int
-
-(** This module defines the abstract syntax of CIL. It also provides utility
- * functions for traversing the CIL data structures, and pretty-printing
- * them. The parser for both the GCC and MSVC front-ends can be invoked as
- * [Frontc.parse: string -> unit ->] {!Cil.file}. This function must be given
- * the name of a preprocessed C file and will return the top-level data
- * structure that describes a whole source file. By default the parsing and
- * elaboration into CIL is done as for GCC source. If you want to use MSVC
- * source you must set the {!Cil.msvcMode} to [true] and must also invoke the
- * function [Frontc.setMSVCMode: unit -> unit]. *)
-
-
-(** {b The Abstract Syntax of CIL} *)
-
-
-(** The top-level representation of a CIL source file (and the result of the
- * parsing and elaboration). Its main contents is the list of global
- * declarations and definitions. You can iterate over the globals in a
- * {!Cil.file} using the following iterators: {!Cil.mapGlobals},
- * {!Cil.iterGlobals} and {!Cil.foldGlobals}. You can also use the
- * {!Cil.dummyFile} when you need a {!Cil.file} as a placeholder. For each
- * global item CIL stores the source location where it appears (using the
- * type {!Cil.location}) *)
-
-type file =
- { mutable fileName: string; (** The complete file name *)
- mutable globals: global list; (** List of globals as they will appear
- in the printed file *)
- mutable globinit: fundec option;
- (** An optional global initializer function. This is a function where
- * you can put stuff that must be executed before the program is
- * started. This function, is conceptually at the end of the file,
- * although it is not part of the globals list. Use {!Cil.getGlobInit}
- * to create/get one. *)
- mutable globinitcalled: bool;
- (** Whether the global initialization function is called in main. This
- * should always be false if there is no global initializer. When you
- * create a global initialization CIL will try to insert code in main
- * to call it. This will not happen if your file does not contain a
- * function called "main" *)
- }
-(** Top-level representation of a C source file *)
-
-and comment = location * string
-
-(** {b Globals}. The main type for representing global declarations and
- * definitions. A list of these form a CIL file. The order of globals in the
- * file is generally important. *)
-
-(** A global declaration or definition *)
-and global =
- | GType of typeinfo * location
- (** A typedef. All uses of type names (through the [TNamed] constructor)
- must be preceded in the file by a definition of the name. The string
- is the defined name and always not-empty. *)
-
- | GCompTag of compinfo * location
- (** Defines a struct/union tag with some fields. There must be one of
- these for each struct/union tag that you use (through the [TComp]
- constructor) since this is the only context in which the fields are
- printed. Consequently nested structure tag definitions must be
- broken into individual definitions with the innermost structure
- defined first. *)
-
- | GCompTagDecl of compinfo * location
- (** Declares a struct/union tag. Use as a forward declaration. This is
- * printed without the fields. *)
-
- | GEnumTag of enuminfo * location
- (** Declares an enumeration tag with some fields. There must be one of
- these for each enumeration tag that you use (through the [TEnum]
- constructor) since this is the only context in which the items are
- printed. *)
-
- | GEnumTagDecl of enuminfo * location
- (** Declares an enumeration tag. Use as a forward declaration. This is
- * printed without the items. *)
-
- | GVarDecl of varinfo * location
- (** A variable declaration (not a definition). If the variable has a
- function type then this is a prototype. There can be several
- declarations and at most one definition for a given variable. If both
- forms appear then they must share the same varinfo structure. A
- prototype shares the varinfo with the fundec of the definition. Either
- has storage Extern or there must be a definition in this file *)
-
- | GVar of varinfo * initinfo * location
- (** A variable definition. Can have an initializer. The initializer is
- * updateable so that you can change it without requiring to recreate
- * the list of globals. There can be at most one definition for a
- * variable in an entire program. Cannot have storage Extern or function
- * type. *)
-
- | GFun of fundec * location
- (** A function definition. *)
-
- | GAsm of string * location (** Global asm statement. These ones
- can contain only a template *)
- | GPragma of attribute * location (** Pragmas at top level. Use the same
- syntax as attributes *)
- | GText of string (** Some text (printed verbatim) at
- top level. E.g., this way you can
- put comments in the output. *)
-
-(** {b Types}. A C type is represented in CIL using the type {!Cil.typ}.
- * Among types we differentiate the integral types (with different kinds
- * denoting the sign and precision), floating point types, enumeration types,
- * array and pointer types, and function types. Every type is associated with
- * a list of attributes, which are always kept in sorted order. Use
- * {!Cil.addAttribute} and {!Cil.addAttributes} to construct list of
- * attributes. If you want to inspect a type, you should use
- * {!Cil.unrollType} or {!Cil.unrollTypeDeep} to see through the uses of
- * named types. *)
-(** CIL is configured at build-time with the sizes and alignments of the
- * underlying compiler (GCC or MSVC). CIL contains functions that can compute
- * the size of a type (in bits) {!Cil.bitsSizeOf}, the alignment of a type
- * (in bytes) {!Cil.alignOf_int}, and can convert an offset into a start and
- * width (both in bits) using the function {!Cil.bitsOffset}. At the moment
- * these functions do not take into account the [packed] attributes and
- * pragmas. *)
-
-and typ =
- TVoid of attributes (** Void type. Also predefined as {!Cil.voidType} *)
- | TInt of ikind * attributes
- (** An integer type. The kind specifies the sign and width. Several
- * useful variants are predefined as {!Cil.intType}, {!Cil.uintType},
- * {!Cil.longType}, {!Cil.charType}. *)
-
-
- | TFloat of fkind * attributes
- (** A floating-point type. The kind specifies the precision. You can
- * also use the predefined constant {!Cil.doubleType}. *)
-
- | TPtr of typ * attributes
- (** Pointer type. Several useful variants are predefined as
- * {!Cil.charPtrType}, {!Cil.charConstPtrType} (pointer to a
- * constant character), {!Cil.voidPtrType},
- * {!Cil.intPtrType} *)
-
- | TArray of typ * exp option * attributes
- (** Array type. It indicates the base type and the array length. *)
-
- | TFun of typ * (string * typ * attributes) list option * bool * attributes
- (** Function type. Indicates the type of the result, the name, type
- * and name attributes of the formal arguments ([None] if no
- * arguments were specified, as in a function whose definition or
- * prototype we have not seen; [Some \[\]] means void). Use
- * {!Cil.argsToList} to obtain a list of arguments. The boolean
- * indicates if it is a variable-argument function. If this is the
- * type of a varinfo for which we have a function declaration then
- * the information for the formals must match that in the
- * function's sformals. Use {!Cil.setFormals}, or
- * {!Cil.setFunctionType}, or {!Cil.makeFormalVar} for this
- * purpose. *)
-
- | TNamed of typeinfo * attributes
- (* The use of a named type. Each such type name must be preceded
- * in the file by a [GType] global. This is printed as just the
- * type name. The actual referred type is not printed here and is
- * carried only to simplify processing. To see through a sequence
- * of named type references, use {!Cil.unrollType} or
- * {!Cil.unrollTypeDeep}. The attributes are in addition to those
- * given when the type name was defined. *)
-
- | TComp of compinfo * attributes
-(** The most delicate issue for C types is that recursion that is possible by
- * using structures and pointers. To address this issue we have a more
- * complex representation for structured types (struct and union). Each such
- * type is represented using the {!Cil.compinfo} type. For each composite
- * type the {!Cil.compinfo} structure must be declared at top level using
- * [GCompTag] and all references to it must share the same copy of the
- * structure. The attributes given are those pertaining to this use of the
- * type and are in addition to the attributes that were given at the
- * definition of the type and which are stored in the {!Cil.compinfo}. *)
-
- | TEnum of enuminfo * attributes
- (** A reference to an enumeration type. All such references must
- share the enuminfo among them and with a [GEnumTag] global that
- precedes all uses. The attributes refer to this use of the
- enumeration and are in addition to the attributes of the
- enumeration itself, which are stored inside the enuminfo *)
-
-
- | TBuiltin_va_list of attributes
- (** This is the same as the gcc's type with the same name *)
-
-(**
- There are a number of functions for querying the kind of a type. These are
- {!Cil.isIntegralType},
- {!Cil.isArithmeticType},
- {!Cil.isPointerType},
- {!Cil.isFunctionType},
- {!Cil.isArrayType}.
-
- There are two easy ways to scan a type. First, you can use the
-{!Cil.existsType} to return a boolean answer about a type. This function
-is controlled by a user-provided function that is queried for each type that is
-used to construct the current type. The function can specify whether to
-terminate the scan with a boolean result or to continue the scan for the
-nested types.
-
- The other method for scanning types is provided by the visitor interface (see
- {!Cil.cilVisitor}).
-
- If you want to compare types (or to use them as hash-values) then you should
-use instead type signatures (represented as {!Cil.typsig}). These
-contain the same information as types but canonicalized such that simple Ocaml
-structural equality will tell whether two types are equal. Use
-{!Cil.typeSig} to compute the signature of a type. If you want to ignore
-certain type attributes then use {!Cil.typeSigWithAttrs}.
-
-*)
-
-
-(** Various kinds of integers *)
-and ikind =
- IChar (** [char] *)
- | ISChar (** [signed char] *)
- | IUChar (** [unsigned char] *)
- | IInt (** [int] *)
- | IUInt (** [unsigned int] *)
- | IShort (** [short] *)
- | IUShort (** [unsigned short] *)
- | ILong (** [long] *)
- | IULong (** [unsigned long] *)
- | ILongLong (** [long long] (or [_int64] on Microsoft Visual C) *)
- | IULongLong (** [unsigned long long] (or [unsigned _int64] on Microsoft
- Visual C) *)
-
-(** Various kinds of floating-point numbers*)
-and fkind =
- FFloat (** [float] *)
- | FDouble (** [double] *)
- | FLongDouble (** [long double] *)
-
-
-(** {b Attributes.} *)
-
-and attribute = Attr of string * attrparam list
-(** An attribute has a name and some optional parameters. The name should not
- * start or end with underscore. When CIL parses attribute names it will
- * strip leading and ending underscores (to ensure that the multitude of GCC
- * attributes such as const, __const and __const__ all mean the same thing.) *)
-
-(** Attributes are lists sorted by the attribute name. Use the functions
- * {!Cil.addAttribute} and {!Cil.addAttributes} to insert attributes in an
- * attribute list and maintain the sortedness. *)
-and attributes = attribute list
-
-(** The type of parameters of attributes *)
-and attrparam =
- | AInt of int (** An integer constant *)
- | AStr of string (** A string constant *)
- | ACons of string * attrparam list (** Constructed attributes. These
- are printed [foo(a1,a2,...,an)].
- The list of parameters can be
- empty and in that case the
- parentheses are not printed. *)
- | ASizeOf of typ (** A way to talk about types *)
- | ASizeOfE of attrparam
- | ASizeOfS of typsig (** Replacement for ASizeOf in type
- signatures. Only used for
- attributes inside typsigs.*)
- | AAlignOf of typ
- | AAlignOfE of attrparam
- | AAlignOfS of typsig
- | AUnOp of unop * attrparam
- | ABinOp of binop * attrparam * attrparam
- | ADot of attrparam * string (** a.foo **)
-
-(** {b Structures.} The {!Cil.compinfo} describes the definition of a
- * structure or union type. Each such {!Cil.compinfo} must be defined at the
- * top-level using the [GCompTag] constructor and must be shared by all
- * references to this type (using either the [TComp] type constructor or from
- * the definition of the fields.
-
- If all you need is to scan the definition of each
- * composite type once, you can do that by scanning all top-level [GCompTag].
-
- * Constructing a {!Cil.compinfo} can be tricky since it must contain fields
- * that might refer to the host {!Cil.compinfo} and furthermore the type of
- * the field might need to refer to the {!Cil.compinfo} for recursive types.
- * Use the {!Cil.mkCompInfo} function to create a {!Cil.compinfo}. You can
- * easily fetch the {!Cil.fieldinfo} for a given field in a structure with
- * {!Cil.getCompField}. *)
-
-(** The definition of a structure or union type. Use {!Cil.mkCompInfo} to
- * make one and use {!Cil.copyCompInfo} to copy one (this ensures that a new
- * key is assigned and that the fields have the right pointers to parents.). *)
-and compinfo = {
- mutable cstruct: bool;
- (** True if struct, False if union *)
- mutable cname: string;
- (** The name. Always non-empty. Use {!Cil.compFullName} to get the full
- * name of a comp (along with the struct or union) *)
- mutable ckey: int;
- (** A unique integer. This is assigned by {!Cil.mkCompInfo} using a
- * global variable in the Cil module. Thus two identical structs in two
- * different files might have different keys. Use {!Cil.copyCompInfo} to
- * copy structures so that a new key is assigned. *)
- mutable cfields: fieldinfo list;
- (** Information about the fields. Notice that each fieldinfo has a
- * pointer back to the host compinfo. This means that you should not
- * share fieldinfo's between two compinfo's *)
- mutable cattr: attributes;
- (** The attributes that are defined at the same time as the composite
- * type. These attributes can be supplemented individually at each
- * reference to this [compinfo] using the [TComp] type constructor. *)
- mutable cdefined: bool;
- (** This boolean flag can be used to distinguish between structures
- that have not been defined and those that have been defined but have
- no fields (such things are allowed in gcc). *)
- mutable creferenced: bool;
- (** True if used. Initially set to false. *)
- }
-
-(** {b Structure fields.} The {!Cil.fieldinfo} structure is used to describe
- * a structure or union field. Fields, just like variables, can have
- * attributes associated with the field itself or associated with the type of
- * the field (stored along with the type of the field). *)
-
-(** Information about a struct/union field *)
-and fieldinfo = {
- mutable fcomp: compinfo;
- (** The host structure that contains this field. There can be only one
- * [compinfo] that contains the field. *)
- mutable fname: string;
- (** The name of the field. Might be the value of {!Cil.missingFieldName}
- * in which case it must be a bitfield and is not printed and it does not
- * participate in initialization *)
- mutable ftype: typ;
- (** The type *)
- mutable fbitfield: int option;
- (** If a bitfield then ftype should be an integer type and the width of
- * the bitfield must be 0 or a positive integer smaller or equal to the
- * width of the integer type. A field of width 0 is used in C to control
- * the alignment of fields. *)
- mutable fattr: attributes;
- (** The attributes for this field (not for its type) *)
- mutable floc: location;
- (** The location where this field is defined *)
-}
-
-
-
-(** {b Enumerations.} Information about an enumeration. This is shared by all
- * references to an enumeration. Make sure you have a [GEnumTag] for each of
- * of these. *)
-
-(** Information about an enumeration *)
-and enuminfo = {
- mutable ename: string;
- (** The name. Always non-empty. *)
- mutable eitems: (string * exp * location) list;
- (** Items with names and values. This list should be non-empty. The item
- * values must be compile-time constants. *)
- mutable eattr: attributes;
- (** The attributes that are defined at the same time as the enumeration
- * type. These attributes can be supplemented individually at each
- * reference to this [enuminfo] using the [TEnum] type constructor. *)
- mutable ereferenced: bool;
- (** True if used. Initially set to false*)
-}
-
-(** {b Enumerations.} Information about an enumeration. This is shared by all
- * references to an enumeration. Make sure you have a [GEnumTag] for each of
- * of these. *)
-
-(** Information about a defined type *)
-and typeinfo = {
- mutable tname: string;
- (** The name. Can be empty only in a [GType] when introducing a composite
- * or enumeration tag. If empty cannot be referred to from the file *)
- mutable ttype: typ;
- (** The actual type. This includes the attributes that were present in
- * the typedef *)
- mutable treferenced: bool;
- (** True if used. Initially set to false*)
-}
-
-(** {b Variables.}
- Each local or global variable is represented by a unique {!Cil.varinfo}
-structure. A global {!Cil.varinfo} can be introduced with the [GVarDecl] or
-[GVar] or [GFun] globals. A local varinfo can be introduced as part of a
-function definition {!Cil.fundec}.
-
- All references to a given global or local variable must refer to the same
-copy of the [varinfo]. Each [varinfo] has a globally unique identifier that
-can be used to index maps and hashtables (the name can also be used for this
-purpose, except for locals from different functions). This identifier is
-constructor using a global counter.
-
- It is very important that you construct [varinfo] structures using only one
- of the following functions:
-- {!Cil.makeGlobalVar} : to make a global variable
-- {!Cil.makeTempVar} : to make a temporary local variable whose name
-will be generated so that to avoid conflict with other locals.
-- {!Cil.makeLocalVar} : like {!Cil.makeTempVar} but you can specify the
-exact name to be used.
-- {!Cil.copyVarinfo}: make a shallow copy of a varinfo assigning a new name
-and a new unique identifier
-
- A [varinfo] is also used in a function type to denote the list of formals.
-
-*)
-
-(** Information about a variable. *)
-and varinfo = {
- mutable vname: string;
- (** The name of the variable. Cannot be empty. It is primarily your
- * responsibility to ensure the uniqueness of a variable name. For local
- * variables {!Cil.makeTempVar} helps you ensure that the name is unique.
- *)
-
- mutable vtype: typ;
- (** The declared type of the variable. *)
-
- mutable vattr: attributes;
- (** A list of attributes associated with the variable.*)
- mutable vstorage: storage;
- (** The storage-class *)
-
- mutable vglob: bool;
- (** True if this is a global variable*)
-
- mutable vinline: bool;
- (** Whether this varinfo is for an inline function. *)
-
- mutable vdecl: location;
- (** Location of variable declaration. *)
-
- mutable vid: int;
- (** A unique integer identifier. This field will be
- * set for you if you use one of the {!Cil.makeFormalVar},
- * {!Cil.makeLocalVar}, {!Cil.makeTempVar}, {!Cil.makeGlobalVar}, or
- * {!Cil.copyVarinfo}. *)
-
- mutable vaddrof: bool;
- (** True if the address of this variable is taken. CIL will set these
- * flags when it parses C, but you should make sure to set the flag
- * whenever your transformation create [AddrOf] expression. *)
-
- mutable vreferenced: bool;
- (** True if this variable is ever referenced. This is computed by
- * [removeUnusedVars]. It is safe to just initialize this to False *)
-}
-
-(** Storage-class information *)
-and storage =
- NoStorage (** The default storage. Nothing is printed *)
- | Static
- | Register
- | Extern
-
-
-(** {b Expressions.} The CIL expression language contains only the side-effect free expressions of
-C. They are represented as the type {!Cil.exp}. There are several
-interesting aspects of CIL expressions:
-
- Integer and floating point constants can carry their textual representation.
-This way the integer 15 can be printed as 0xF if that is how it occurred in the
-source.
-
- CIL uses 64 bits to represent the integer constants and also stores the width
-of the integer type. Care must be taken to ensure that the constant is
-representable with the given width. Use the functions {!Cil.kinteger},
-{!Cil.kinteger64} and {!Cil.integer} to construct constant
-expressions. CIL predefines the constants {!Cil.zero},
-{!Cil.one} and {!Cil.mone} (for -1).
-
- Use the functions {!Cil.isConstant} and {!Cil.isInteger} to test if
-an expression is a constant and a constant integer respectively.
-
- CIL keeps the type of all unary and binary expressions. You can think of that
-type qualifying the operator. Furthermore there are different operators for
-arithmetic and comparisons on arithmetic types and on pointers.
-
- Another unusual aspect of CIL is that the implicit conversion between an
-expression of array type and one of pointer type is made explicit, using the
-[StartOf] expression constructor (which is not printed). If you apply the
-[AddrOf}]constructor to an lvalue of type [T] then you will be getting an
-expression of type [TPtr(T)].
-
- You can find the type of an expression with {!Cil.typeOf}.
-
- You can perform constant folding on expressions using the function
-{!Cil.constFold}.
-*)
-
-(** Expressions (Side-effect free)*)
-and exp =
- Const of constant (** Constant *)
- | Lval of lval (** Lvalue *)
- | SizeOf of typ
- (** sizeof(<type>). Has [unsigned int] type (ISO 6.5.3.4). This is not
- * turned into a constant because some transformations might want to
- * change types *)
-
- | SizeOfE of exp
- (** sizeof(<expression>) *)
-
- | SizeOfStr of string
- (** sizeof(string_literal). We separate this case out because this is the
- * only instance in which a string literal should not be treated as
- * having type pointer to character. *)
-
- | AlignOf of typ
- (** This corresponds to the GCC __alignof_. Has [unsigned int] type *)
- | AlignOfE of exp
-
-
- | UnOp of unop * exp * typ
- (** Unary operation. Includes the type of the result. *)
-
- | BinOp of binop * exp * exp * typ
- (** Binary operation. Includes the type of the result. The arithmetic
- * conversions are made explicit for the arguments. *)
-
- | CastE of typ * exp
- (** Use {!Cil.mkCast} to make casts. *)
-
- | AddrOf of lval
- (** Always use {!Cil.mkAddrOf} to construct one of these. Apply to an
- * lvalue of type [T] yields an expression of type [TPtr(T)] *)
-
- | StartOf of lval
- (** Conversion from an array to a pointer to the beginning of the array.
- * Given an lval of type [TArray(T)] produces an expression of type
- * [TPtr(T)]. In C this operation is implicit, the [StartOf] operator is
- * not printed. We have it in CIL because it makes the typing rules
- * simpler. *)
-
-(** {b Constants.} *)
-
-(** Literal constants *)
-and constant =
- | CInt64 of int64 * ikind * string option
- (** Integer constant. Give the ikind (see ISO9899 6.1.3.2) and the
- * textual representation, if available. (This allows us to print a
- * constant as, for example, 0xF instead of 15.) Use {!Cil.integer} or
- * {!Cil.kinteger} to create these. Watch out for integers that cannot be
- * represented on 64 bits. OCAML does not give Overflow exceptions. *)
- | CStr of string
- (* String constant. The escape characters inside the string have been
- * already interpreted. This constant has pointer to character type! The
- * only case when you would like a string literal to have an array type
- * is when it is an argument to sizeof. In that case you should use
- * SizeOfStr. *)
- | CWStr of int64 list
- (* Wide character string constant. Note that the local interpretation
- * of such a literal depends on {!Cil.wcharType} and {!Cil.wcharKind}.
- * Such a constant has type pointer to {!Cil.wcharType}. The
- * escape characters in the string have not been "interpreted" in
- * the sense that L"A\xabcd" remains "A\xabcd" rather than being
- * represented as the wide character list with two elements: 65 and
- * 43981. That "interpretation" depends on the underlying wide
- * character type. *)
- | CChr of char
- (** Character constant. This has type int, so use charConstToInt
- * to read the value in case sign-extension is needed. *)
- | CReal of float * fkind * string option
- (** Floating point constant. Give the fkind (see ISO 6.4.4.2) and also
- * the textual representation, if available. *)
- | CEnum of exp * string * enuminfo
- (** An enumeration constant with the given value, name, from the given
- * enuminfo. This is used only if {!Cil.lowerConstants} is true
- * (default). Use {!Cil.constFoldVisitor} to replace these with integer
- * constants. *)
-
-(** Unary operators *)
-and unop =
- Neg (** Unary minus *)
- | BNot (** Bitwise complement (~) *)
- | LNot (** Logical Not (!) *)
-
-(** Binary operations *)
-and binop =
- PlusA (** arithmetic + *)
- | PlusPI (** pointer + integer *)
- | IndexPI (** pointer + integer but only when
- * it arises from an expression
- * [e\[i\]] when [e] is a pointer and
- * not an array. This is semantically
- * the same as PlusPI but CCured uses
- * this as a hint that the integer is
- * probably positive. *)
- | MinusA (** arithmetic - *)
- | MinusPI (** pointer - integer *)
- | MinusPP (** pointer - pointer *)
- | Mult (** * *)
- | Div (** / *)
- | Mod (** % *)
- | Shiftlt (** shift left *)
- | Shiftrt (** shift right *)
-
- | Lt (** < (arithmetic comparison) *)
- | Gt (** > (arithmetic comparison) *)
- | Le (** <= (arithmetic comparison) *)
- | Ge (** > (arithmetic comparison) *)
- | Eq (** == (arithmetic comparison) *)
- | Ne (** != (arithmetic comparison) *)
- | BAnd (** bitwise and *)
- | BXor (** exclusive-or *)
- | BOr (** inclusive-or *)
-
- | LAnd (** logical and. Unlike other
- * expressions this one does not
- * always evaluate both operands. If
- * you want to use these, you must
- * set {!Cil.useLogicalOperators}. *)
- | LOr (** logical or. Unlike other
- * expressions this one does not
- * always evaluate both operands. If
- * you want to use these, you must
- * set {!Cil.useLogicalOperators}. *)
-
-(** {b Lvalues.} Lvalues are the sublanguage of expressions that can appear at the left of an assignment or as operand to the address-of operator.
-In C the syntax for lvalues is not always a good indication of the meaning
-of the lvalue. For example the C value
-{v
-a[0][1][2]
- v}
- might involve 1, 2 or 3 memory reads when used in an expression context,
-depending on the declared type of the variable [a]. If [a] has type [int
-\[4\]\[4\]\[4\]] then we have one memory read from somewhere inside the area
-that stores the array [a]. On the other hand if [a] has type [int ***] then
-the expression really means [* ( * ( * (a + 0) + 1) + 2)], in which case it is
-clear that it involves three separate memory operations.
-
-An lvalue denotes the contents of a range of memory addresses. This range
-is denoted as a host object along with an offset within the object. The
-host object can be of two kinds: a local or global variable, or an object
-whose address is in a pointer expression. We distinguish the two cases so
-that we can tell quickly whether we are accessing some component of a
-variable directly or we are accessing a memory location through a pointer.
-To make it easy to
-tell what an lvalue means CIL represents lvalues as a host object and an
-offset (see {!Cil.lval}). The host object (represented as
-{!Cil.lhost}) can be a local or global variable or can be the object
-pointed-to by a pointer expression. The offset (represented as
-{!Cil.offset}) is a sequence of field or array index designators.
-
- Both the typing rules and the meaning of an lvalue is very precisely
-specified in CIL.
-
- The following are a few useful function for operating on lvalues:
-- {!Cil.mkMem} - makes an lvalue of [Mem] kind. Use this to ensure
-that certain equivalent forms of lvalues are canonized.
-For example, [*&x = x].
-- {!Cil.typeOfLval} - the type of an lvalue
-- {!Cil.typeOffset} - the type of an offset, given the type of the
-host.
-- {!Cil.addOffset} and {!Cil.addOffsetLval} - extend sequences
-of offsets.
-- {!Cil.removeOffset} and {!Cil.removeOffsetLval} - shrink sequences
-of offsets.
-
-The following equivalences hold {v
-Mem(AddrOf(Mem a, aoff)), off = Mem a, aoff + off
-Mem(AddrOf(Var v, aoff)), off = Var v, aoff + off
-AddrOf (Mem a, NoOffset) = a
- v}
-
-*)
-(** An lvalue *)
-and lval =
- lhost * offset
-
-(** The host part of an {!Cil.lval}. *)
-and lhost =
- | Var of varinfo
- (** The host is a variable. *)
-
- | Mem of exp
- (** The host is an object of type [T] when the expression has pointer
- * [TPtr(T)]. *)
-
-
-(** The offset part of an {!Cil.lval}. Each offset can be applied to certain
- * kinds of lvalues and its effect is that it advances the starting address
- * of the lvalue and changes the denoted type, essentially focusing to some
- * smaller lvalue that is contained in the original one. *)
-and offset =
- | NoOffset (** No offset. Can be applied to any lvalue and does
- * not change either the starting address or the type.
- * This is used when the lval consists of just a host
- * or as a terminator in a list of other kinds of
- * offsets. *)
-
- | Field of fieldinfo * offset
- (** A field offset. Can be applied only to an lvalue
- * that denotes a structure or a union that contains
- * the mentioned field. This advances the offset to the
- * beginning of the mentioned field and changes the
- * type to the type of the mentioned field. *)
-
- | Index of exp * offset
- (** An array index offset. Can be applied only to an
- * lvalue that denotes an array. This advances the
- * starting address of the lval to the beginning of the
- * mentioned array element and changes the denoted type
- * to be the type of the array element *)
-
-
-(** {b Initializers.}
-A special kind of expressions are those that can appear as initializers for
-global variables (initialization of local variables is turned into
-assignments). The initializers are represented as type {!Cil.init}. You
-can create initializers with {!Cil.makeZeroInit} and you can conveniently
-scan compound initializers them with {!Cil.foldLeftCompound} or with {!Cil.foldLeftCompoundAll}.
-*)
-(** Initializers for global variables. *)
-and init =
- | SingleInit of exp (** A single initializer *)
- | CompoundInit of typ * (offset * init) list
- (** Used only for initializers of structures, unions and arrays. The
- * offsets are all of the form [Field(f, NoOffset)] or [Index(i,
- * NoOffset)] and specify the field or the index being initialized. For
- * structures all fields must have an initializer (except the unnamed
- * bitfields), in the proper order. This is necessary since the offsets
- * are not printed. For unions there must be exactly one initializer. If
- * the initializer is not for the first field then a field designator is
- * printed, so you better be on GCC since MSVC does not understand this.
- * For arrays, however, we allow you to give only a prefix of the
- * initializers. You can scan an initializer list with
- * {!Cil.foldLeftCompound} or with {!Cil.foldLeftCompoundAll}. *)
-
-
-(** We want to be able to update an initializer in a global variable, so we
- * define it as a mutable field *)
-and initinfo = {
- mutable init : init option;
- }
-
-(** {b Function definitions.}
-A function definition is always introduced with a [GFun] constructor at the
-top level. All the information about the function is stored into a
-{!Cil.fundec}. Some of the information (e.g. its name, type,
-storage, attributes) is stored as a {!Cil.varinfo} that is a field of the
-[fundec]. To refer to the function from the expression language you must use
-the [varinfo].
-
- The function definition contains, in addition to the body, a list of all the
-local variables and separately a list of the formals. Both kind of variables
-can be referred to in the body of the function. The formals must also be shared
-with the formals that appear in the function type. For that reason, to
-manipulate formals you should use the provided functions
-{!Cil.makeFormalVar} and {!Cil.setFormals} and {!Cil.makeFormalVar}.
-*)
-(** Function definitions. *)
-and fundec =
- { mutable svar: varinfo;
- (** Holds the name and type as a variable, so we can refer to it
- * easily from the program. All references to this function either
- * in a function call or in a prototype must point to the same
- * [varinfo]. *)
- mutable sformals: varinfo list;
- (** Formals. These must be in the same order and with the same
- * information as the formal information in the type of the function.
- * Use {!Cil.setFormals} or
- * {!Cil.setFunctionType} or {!Cil.makeFormalVar}
- * to set these formals and ensure that they
- * are reflected in the function type. Do not make copies of these
- * because the body refers to them. *)
- mutable slocals: varinfo list;
- (** Locals. Does NOT include the sformals. Do not make copies of
- * these because the body refers to them. *)
- mutable smaxid: int; (** Max local id. Starts at 0. Used for
- * creating the names of new temporary
- * variables. Updated by
- * {!Cil.makeLocalVar} and
- * {!Cil.makeTempVar}. You can also use
- * {!Cil.setMaxId} to set it after you
- * have added the formals and locals. *)
- mutable sbody: block; (** The function body. *)
- mutable smaxstmtid: int option; (** max id of a (reachable) statement
- * in this function, if we have
- * computed it. range = 0 ...
- * (smaxstmtid-1). This is computed by
- * {!Cil.computeCFGInfo}. *)
- mutable sallstmts: stmt list; (** After you call {!Cil.computeCFGInfo}
- * this field is set to contain all
- * statements in the function *)
- }
-
-
-(** A block is a sequence of statements with the control falling through from
- one element to the next *)
-and block =
- { mutable battrs: attributes; (** Attributes for the block *)
- mutable bstmts: stmt list; (** The statements comprising the block*)
- }
-
-
-(** {b Statements}.
-CIL statements are the structural elements that make the CFG. They are
-represented using the type {!Cil.stmt}. Every
-statement has a (possibly empty) list of labels. The
-{!Cil.stmtkind} field of a statement indicates what kind of statement it
-is.
-
- Use {!Cil.mkStmt} to make a statement and the fill-in the fields.
-
-CIL also comes with support for control-flow graphs. The [sid] field in
-[stmt] can be used to give unique numbers to statements, and the [succs]
-and [preds] fields can be used to maintain a list of successors and
-predecessors for every statement. The CFG information is not computed by
-default. Instead you must explicitly use the functions
-{!Cil.prepareCFG} and {!Cil.computeCFGInfo} to do it.
-
-*)
-(** Statements. *)
-and stmt = {
- mutable labels: label list;
- (** Whether the statement starts with some labels, case statements or
- * default statements. *)
-
- mutable skind: stmtkind;
- (** The kind of statement *)
-
- mutable sid: int;
- (** A number (>= 0) that is unique in a function. Filled in only after
- * the CFG is computed. *)
- mutable succs: stmt list;
- (** The successor statements. They can always be computed from the skind
- * and the context in which this statement appears. Filled in only after
- * the CFG is computed. *)
- mutable preds: stmt list;
- (** The inverse of the succs function. *)
- }
-
-(** Labels *)
-and label =
- Label of string * location * bool
- (** A real label. If the bool is "true", the label is from the
- * input source program. If the bool is "false", the label was
- * created by CIL or some other transformation *)
- | Case of exp * location (** A case statement. This expression
- * is lowered into a constant if
- * {!Cil.lowerConstants} is set to
- * true. *)
- | Default of location (** A default statement *)
-
-
-
-(** The various kinds of control-flow statements statements *)
-and stmtkind =
- | Instr of instr list
- (** A group of instructions that do not contain control flow. Control
- * implicitly falls through. *)
-
- | Return of exp option * location
- (** The return statement. This is a leaf in the CFG. *)
-
- | Goto of stmt ref * location
- (** A goto statement. Appears from actual goto's in the code or from
- * goto's that have been inserted during elaboration. The reference
- * points to the statement that is the target of the Goto. This means that
- * you have to update the reference whenever you replace the target
- * statement. The target statement MUST have at least a label. *)
-
- | Break of location
- (** A break to the end of the nearest enclosing loop or Switch *)
-
- | Continue of location
- (** A continue to the start of the nearest enclosing loop *)
- | If of exp * block * block * location
- (** A conditional. Two successors, the "then" and the "else" branches.
- * Both branches fall-through to the successor of the If statement. *)
-
- | Switch of exp * block * (stmt list) * location
- (** A switch statement. The statements that implement the cases can be
- * reached through the provided list. For each such target you can find
- * among its labels what cases it implements. The statements that
- * implement the cases are somewhere within the provided [block]. *)
-
-(*
- | Loop of block * location * (stmt option) * (stmt option)
- (** A [while(1)] loop. The termination test is implemented in the body of
- * a loop using a [Break] statement. If prepareCFG has been called,
- * the first stmt option will point to the stmt containing the continue
- * label for this loop and the second will point to the stmt containing
- * the break label for this loop. *)
-*)
-
- | While of exp * block * location
- (** A [while] loop. *)
-
- | DoWhile of exp * block * location
- (** A [do...while] loop. *)
-
- | For of block * exp * block * block * location
- (** A [for] loop. *)
-
- | Block of block
- (** Just a block of statements. Use it as a way to keep some block
- * attributes local *)
-
- (** On MSVC we support structured exception handling. This is what you
- * might expect. Control can get into the finally block either from the
- * end of the body block, or if an exception is thrown. *)
- | TryFinally of block * block * location
-
- (** On MSVC we support structured exception handling. The try/except
- * statement is a bit tricky:
- [__try { blk }
- __except (e) {
- handler
- }]
-
- The argument to __except must be an expression. However, we keep a
- list of instructions AND an expression in case you need to make
- function calls. We'll print those as a comma expression. The control
- can get to the __except expression only if an exception is thrown.
- After that, depending on the value of the expression the control
- goes to the handler, propagates the exception, or retries the
- exception !!!
- *)
- | TryExcept of block * (instr list * exp) * block * location
-
-
-(** {b Instructions}.
- An instruction {!Cil.instr} is a statement that has no local
-(intraprocedural) control flow. It can be either an assignment,
-function call, or an inline assembly instruction. *)
-
-(** Instructions. *)
-and instr =
- Set of lval * exp * location
- (** An assignment. The type of the expression is guaranteed to be the same
- * with that of the lvalue *)
- | Call of lval option * exp * exp list * location
- (** A function call with the (optional) result placed in an lval. It is
- * possible that the returned type of the function is not identical to
- * that of the lvalue. In that case a cast is printed. The type of the
- * actual arguments are identical to those of the declared formals. The
- * number of arguments is the same as that of the declared formals, except
- * for vararg functions. This construct is also used to encode a call to
- * "__builtin_va_arg". In this case the second argument (which should be a
- * type T) is encoded SizeOf(T) *)
-
- | Asm of attributes * (* Really only const and volatile can appear
- * here *)
- string list * (* templates (CR-separated) *)
- (string * lval) list * (* outputs must be lvals with
- * constraints. I would like these
- * to be actually variables, but I
- * run into some trouble with ASMs
- * in the Linux sources *)
- (string * exp) list * (* inputs with constraints *)
- string list * (* register clobbers *)
- location
- (** There are for storing inline assembly. They follow the GCC
- * specification:
-{v
- asm [volatile] ("...template..." "..template.."
- : "c1" (o1), "c2" (o2), ..., "cN" (oN)
- : "d1" (i1), "d2" (i2), ..., "dM" (iM)
- : "r1", "r2", ..., "nL" );
- v}
-
-where the parts are
-
- - [volatile] (optional): when present, the assembler instruction
- cannot be removed, moved, or otherwise optimized
- - template: a sequence of strings, with %0, %1, %2, etc. in the string to
- refer to the input and output expressions. I think they're numbered
- consecutively, but the docs don't specify. Each string is printed on
- a separate line. This is the only part that is present for MSVC inline
- assembly.
- - "ci" (oi): pairs of constraint-string and output-lval; the
- constraint specifies that the register used must have some
- property, like being a floating-point register; the constraint
- string for outputs also has "=" to indicate it is written, or
- "+" to indicate it is both read and written; 'oi' is the
- name of a C lvalue (probably a variable name) to be used as
- the output destination
- - "dj" (ij): pairs of constraint and input expression; the constraint
- is similar to the "ci"s. the 'ij' is an arbitrary C expression
- to be loaded into the corresponding register
- - "rk": registers to be regarded as "clobbered" by the instruction;
- "memory" may be specified for arbitrary memory effects
-
-an example (from gcc manual):
-{v
- asm volatile ("movc3 %0,%1,%2"
- : /* no outputs */
- : "g" (from), "g" (to), "g" (count)
- : "r0", "r1", "r2", "r3", "r4", "r5");
- v}
-*)
-
-(** Describes a location in a source file. *)
-and location = {
- line: int; (** The line number. -1 means "do not know" *)
- file: string; (** The name of the source file*)
- byte: int; (** The byte position in the source file *)
-}
-
-
-(** Type signatures. Two types are identical iff they have identical
- * signatures. These contain the same information as types but canonicalized.
- * For example, two function types that are identical except for the name of
- * the formal arguments are given the same signature. Also, [TNamed]
- * constructors are unrolled. *)
-and typsig =
- TSArray of typsig * int64 option * attribute list
- | TSPtr of typsig * attribute list
- | TSComp of bool * string * attribute list
- | TSFun of typsig * typsig list * bool * attribute list
- | TSEnum of string * attribute list
- | TSBase of typ
-
-
-
-(** {b Lowering Options} *)
-
-val lowerConstants: bool ref
- (** Do lower constants (default true) *)
-
-val insertImplicitCasts: bool ref
- (** Do insert implicit casts (default true) *)
-
-(** To be able to add/remove features easily, each feature should be package
- * as an interface with the following interface. These features should be *)
-type featureDescr = {
- fd_enabled: bool ref;
- (** The enable flag. Set to default value *)
-
- fd_name: string;
- (** This is used to construct an option "--doxxx" and "--dontxxx" that
- * enable and disable the feature *)
-
- fd_description: string;
- (* A longer name that can be used to document the new options *)
-
- fd_extraopt: (string * Arg.spec * string) list;
- (** Additional command line options *)
-
- fd_doit: (file -> unit);
- (** This performs the transformation *)
-
- fd_post_check: bool;
- (* Whether to perform a CIL consistency checking after this stage, if
- * checking is enabled (--check is passed to cilly). Set this to true if
- * your feature makes any changes for the program. *)
-}
-
-(** Comparison function for locations.
- ** Compares first by filename, then line, then byte *)
-val compareLoc: location -> location -> int
-
-(** {b Values for manipulating globals} *)
-
-(** Make an empty function *)
-val emptyFunction: string -> fundec
-
-(** Update the formals of a [fundec] and make sure that the function type
- has the same information. Will copy the name as well into the type. *)
-val setFormals: fundec -> varinfo list -> unit
-
-(** Set the types of arguments and results as given by the function type
- * passed as the second argument. Will not copy the names from the function
- * type to the formals *)
-val setFunctionType: fundec -> typ -> unit
-
-
-(** Set the type of the function and make formal arguments for them *)
-val setFunctionTypeMakeFormals: fundec -> typ -> unit
-
-(** Update the smaxid after you have populated with locals and formals
- * (unless you constructed those using {!Cil.makeLocalVar} or
- * {!Cil.makeTempVar}. *)
-val setMaxId: fundec -> unit
-
-(** A dummy function declaration handy when you need one as a placeholder. It
- * contains inside a dummy varinfo. *)
-val dummyFunDec: fundec
-
-(** A dummy file *)
-val dummyFile: file
-
-(** Write a {!Cil.file} in binary form to the filesystem. The file can be
- * read back in later using {!Cil.loadBinaryFile}, possibly saving parsing
- * time. The second argument is the name of the file that should be
- * created. *)
-val saveBinaryFile : file -> string -> unit
-
-(** Write a {!Cil.file} in binary form to the filesystem. The file can be
- * read back in later using {!Cil.loadBinaryFile}, possibly saving parsing
- * time. Does not close the channel. *)
-val saveBinaryFileChannel : file -> out_channel -> unit
-
-(** Read a {!Cil.file} in binary form from the filesystem. The first
- * argument is the name of a file previously created by
- * {!Cil.saveBinaryFile}. *)
-val loadBinaryFile : string -> file
-
-(** Get the global initializer and create one if it does not already exist.
- * When it creates a global initializer it attempts to place a call to it in
- * the main function named by the optional argument (default "main") *)
-val getGlobInit: ?main_name:string -> file -> fundec
-
-(** Iterate over all globals, including the global initializer *)
-val iterGlobals: file -> (global -> unit) -> unit
-
-(** Fold over all globals, including the global initializer *)
-val foldGlobals: file -> ('a -> global -> 'a) -> 'a -> 'a
-
-(** Map over all globals, including the global initializer and change things
- in place *)
-val mapGlobals: file -> (global -> global) -> unit
-
-val new_sid : unit -> int
-
-(** Prepare a function for CFG information computation by
- * {!Cil.computeCFGInfo}. This function converts all [Break], [Switch],
- * [Default] and [Continue] {!Cil.stmtkind}s and {!Cil.label}s into [If]s
- * and [Goto]s, giving the function body a very CFG-like character. This
- * function modifies its argument in place. *)
-val prepareCFG: fundec -> unit
-
-(** Compute the CFG information for all statements in a fundec and return a
- * list of the statements. The input fundec cannot have [Break], [Switch],
- * [Default], or [Continue] {!Cil.stmtkind}s or {!Cil.label}s. Use
- * {!Cil.prepareCFG} to transform them away. The second argument should
- * be [true] if you wish a global statement number, [false] if you wish a
- * local (per-function) statement numbering. The list of statements is set
- * in the sallstmts field of a fundec.
- *
- * NOTE: unless you want the simpler control-flow graph provided by
- * prepareCFG, or you need the function's smaxstmtid and sallstmt fields
- * filled in, we recommend you use {!Cfg.computeFileCFG} instead of this
- * function to compute control-flow information.
- * {!Cfg.computeFileCFG} is newer and will handle switch, break, and
- * continue correctly.*)
-val computeCFGInfo: fundec -> bool -> unit
-
-
-(** Create a deep copy of a function. There should be no sharing between the
- * copy and the original function *)
-val copyFunction: fundec -> string -> fundec
-
-
-(** CIL keeps the types at the beginning of the file and the variables at the
- * end of the file. This function will take a global and add it to the
- * corresponding stack. Its operation is actually more complicated because if
- * the global declares a type that contains references to variables (e.g. in
- * sizeof in an array length) then it will also add declarations for the
- * variables to the types stack *)
-val pushGlobal: global -> types: global list ref
- -> variables: global list ref -> unit
-
-(** An empty statement. Used in pretty printing *)
-val invalidStmt: stmt
-
-(** A list of the GCC built-in functions. Maps the name to the result and
- * argument types, and whether it is vararg *)
-val gccBuiltins: (string, typ * typ list * bool) Hashtbl.t
-
-
-(** A list of the MSVC built-in functions. Maps the name to the result and
- * argument types, and whether it is vararg *)
-val msvcBuiltins: (string, typ * typ list * bool) Hashtbl.t
-
-(** {b Values for manipulating initializers} *)
-
-
-(** Make a initializer for zero-ing a data type *)
-val makeZeroInit: typ -> init
-
-
-(** Fold over the list of initializers in a Compound. [doinit] is called on
- * every present initializer, even if it is of compound type. In the case of
- * arrays there might be missing zero-initializers at the end of the list.
- * These are not scanned. This is much like [List.fold_left] except we also
- * pass the type of the initializer *)
-val foldLeftCompound:
- doinit: (offset -> init -> typ -> 'a -> 'a) ->
- ct: typ ->
- initl: (offset * init) list ->
- acc: 'a -> 'a
-
-
-(** Fold over the list of initializers in a Compound, like
- * {!Cil.foldLeftCompound} but in the case of an array it scans even missing
- * zero initializers at the end of the array *)
-val foldLeftCompoundAll:
- doinit: (offset -> init -> typ -> 'a -> 'a) ->
- ct: typ ->
- initl: (offset * init) list ->
- acc: 'a -> 'a
-
-
-
-(** {b Values for manipulating types} *)
-
-(** void *)
-val voidType: typ
-
-(* is the given type "void"? *)
-val isVoidType: typ -> bool
-
-(* is the given type "void *"? *)
-val isVoidPtrType: typ -> bool
-
-(** int *)
-val intType: typ
-
-(** unsigned int *)
-val uintType: typ
-
-(** long *)
-val longType: typ
-
-(** unsigned long *)
-val ulongType: typ
-
-(** char *)
-val charType: typ
-
-(** char * *)
-val charPtrType: typ
-
-(** wchar_t (depends on architecture) and is set when you call
- * {!Cil.initCIL}. *)
-val wcharKind: ikind ref
-val wcharType: typ ref
-
-(** char const * *)
-val charConstPtrType: typ
-
-(** void * *)
-val voidPtrType: typ
-
-(** int * *)
-val intPtrType: typ
-
-(** unsigned int * *)
-val uintPtrType: typ
-
-(** double *)
-val doubleType: typ
-
-(* An unsigned integer type that fits pointers. Depends on {!Cil.msvcMode}
- * and is set when you call {!Cil.initCIL}. *)
-val upointType: typ ref
-
-(* An unsigned integer type that is the type of sizeof. Depends on
- * {!Cil.msvcMode} and is set when you call {!Cil.initCIL}. *)
-val typeOfSizeOf: typ ref
-
-(** Returns true if and only if the given integer type is signed. *)
-val isSigned: ikind -> bool
-
-
-(** Creates a a (potentially recursive) composite type. The arguments are:
- * (1) a boolean indicating whether it is a struct or a union, (2) the name
- * (always non-empty), (3) a function that when given a representation of the
- * structure type constructs the type of the fields recursive type (the first
- * argument is only useful when some fields need to refer to the type of the
- * structure itself), and (4) a list of attributes to be associated with the
- * composite type. The resulting compinfo has the field "cdefined" only if
- * the list of fields is non-empty. *)
-val mkCompInfo: bool -> (* whether it is a struct or a union *)
- string -> (* name of the composite type; cannot be empty *)
- (compinfo ->
- (string * typ * int option * attributes * location) list) ->
- (* a function that when given a forward
- representation of the structure type constructs the type of
- the fields. The function can ignore this argument if not
- constructing a recursive type. *)
- attributes -> compinfo
-
-(** Makes a shallow copy of a {!Cil.compinfo} changing the name and the key.*)
-val copyCompInfo: compinfo -> string -> compinfo
-
-(** This is a constant used as the name of an unnamed bitfield. These fields
- do not participate in initialization and their name is not printed. *)
-val missingFieldName: string
-
-(** Get the full name of a comp *)
-val compFullName: compinfo -> string
-
-(** Returns true if this is a complete type.
- This means that sizeof(t) makes sense.
- Incomplete types are not yet defined
- structures and empty arrays. *)
-val isCompleteType: typ -> bool
-
-(** Unroll a type until it exposes a non
- * [TNamed]. Will collect all attributes appearing in [TNamed]!!! *)
-val unrollType: typ -> typ
-
-(** Unroll all the TNamed in a type (even under type constructors such as
- * [TPtr], [TFun] or [TArray]. Does not unroll the types of fields in [TComp]
- * types. Will collect all attributes *)
-val unrollTypeDeep: typ -> typ
-
-(** Separate out the storage-modifier name attributes *)
-val separateStorageModifiers: attribute list -> attribute list * attribute list
-
-(** True if the argument is an integral type (i.e. integer or enum) *)
-val isIntegralType: typ -> bool
-
-(** True if the argument is an arithmetic type (i.e. integer, enum or
- floating point *)
-val isArithmeticType: typ -> bool
-
-(**True if the argument is a pointer type *)
-val isPointerType: typ -> bool
-
-(** True if the argument is a function type *)
-val isFunctionType: typ -> bool
-
-(** Obtain the argument list ([] if None) *)
-val argsToList: (string * typ * attributes) list option
- -> (string * typ * attributes) list
-
-(** True if the argument is an array type *)
-val isArrayType: typ -> bool
-
-(** Raised when {!Cil.lenOfArray} fails either because the length is [None]
- * or because it is a non-constant expression *)
-exception LenOfArray
-
-(** Call to compute the array length as present in the array type, to an
- * integer. Raises {!Cil.LenOfArray} if not able to compute the length, such
- * as when there is no length or the length is not a constant. *)
-val lenOfArray: exp option -> int
-
-(** Return a named fieldinfo in compinfo, or raise Not_found *)
-val getCompField: compinfo -> string -> fieldinfo
-
-
-(** A datatype to be used in conjunction with [existsType] *)
-type existsAction =
- ExistsTrue (* We have found it *)
- | ExistsFalse (* Stop processing this branch *)
- | ExistsMaybe (* This node is not what we are
- * looking for but maybe its
- * successors are *)
-
-(** Scans a type by applying the function on all elements.
- When the function returns ExistsTrue, the scan stops with
- true. When the function returns ExistsFalse then the current branch is not
- scanned anymore. Care is taken to
- apply the function only once on each composite type, thus avoiding
- circularity. When the function returns ExistsMaybe then the types that
- construct the current type are scanned (e.g. the base type for TPtr and
- TArray, the type of fields for a TComp, etc). *)
-val existsType: (typ -> existsAction) -> typ -> bool
-
-
-(** Given a function type split it into return type,
- * arguments, is_vararg and attributes. An error is raised if the type is not
- * a function type *)
-val splitFunctionType:
- typ -> typ * (string * typ * attributes) list option * bool * attributes
-(** Same as {!Cil.splitFunctionType} but takes a varinfo. Prints a nicer
- * error message if the varinfo is not for a function *)
-val splitFunctionTypeVI:
- varinfo -> typ * (string * typ * attributes) list option * bool * attributes
-
-
-(** {b Type signatures} *)
-
-(** Type signatures. Two types are identical iff they have identical
- * signatures. These contain the same information as types but canonicalized.
- * For example, two function types that are identical except for the name of
- * the formal arguments are given the same signature. Also, [TNamed]
- * constructors are unrolled. You shoud use [Util.equals] to compare type
- * signatures because they might still contain circular structures (through
- * attributes, and sizeof) *)
-
-(** Print a type signature *)
-val d_typsig: unit -> typsig -> Pretty.doc
-
-(** Compute a type signature *)
-val typeSig: typ -> typsig
-
-(** Like {!Cil.typeSig} but customize the incorporation of attributes.
- Use ~ignoreSign:true to convert all signed integer types to unsigned,
- so that signed and unsigned will compare the same. *)
-val typeSigWithAttrs: ?ignoreSign:bool -> (attributes -> attributes) -> typ -> typsig
-
-(** Replace the attributes of a signature (only at top level) *)
-val setTypeSigAttrs: attributes -> typsig -> typsig
-
-(** Get the top-level attributes of a signature *)
-val typeSigAttrs: typsig -> attributes
-
-(*********************************************************)
-(** LVALUES *)
-
-(** Make a varinfo. Use this (rarely) to make a raw varinfo. Use other
- * functions to make locals ({!Cil.makeLocalVar} or {!Cil.makeFormalVar} or
- * {!Cil.makeTempVar}) and globals ({!Cil.makeGlobalVar}). Note that this
- * function will assign a new identifier. The first argument specifies
- * whether the varinfo is for a global. *)
-val makeVarinfo: bool -> string -> typ -> varinfo
-
-(** Make a formal variable for a function. Insert it in both the sformals
- and the type of the function. You can optionally specify where to insert
- this one. If where = "^" then it is inserted first. If where = "$" then
- it is inserted last. Otherwise where must be the name of a formal after
- which to insert this. By default it is inserted at the end. *)
-val makeFormalVar: fundec -> ?where:string -> string -> typ -> varinfo
-
-(** Make a local variable and add it to a function's slocals (only if insert =
- true, which is the default). Make sure you know what you are doing if you
- set insert=false. *)
-val makeLocalVar: fundec -> ?insert:bool -> string -> typ -> varinfo
-
-(** Make a temporary variable and add it to a function's slocals. The name of
- the temporary variable will be generated based on the given name hint so
- that to avoid conflicts with other locals. *)
-val makeTempVar: fundec -> ?name: string -> typ -> varinfo
-
-
-(** Make a global variable. Your responsibility to make sure that the name
- is unique *)
-val makeGlobalVar: string -> typ -> varinfo
-
-(** Make a shallow copy of a [varinfo] and assign a new identifier *)
-val copyVarinfo: varinfo -> string -> varinfo
-
-
-(** Generate a new variable ID. This will be different than any variable ID
- * that is generated by {!Cil.makeLocalVar} and friends *)
-val newVID: unit -> int
-
-(** Add an offset at the end of an lvalue. Make sure the type of the lvalue
- * and the offset are compatible. *)
-val addOffsetLval: offset -> lval -> lval
-
-(** [addOffset o1 o2] adds [o1] to the end of [o2]. *)
-val addOffset: offset -> offset -> offset
-
-(** Remove ONE offset from the end of an lvalue. Returns the lvalue with the
- * trimmed offset and the final offset. If the final offset is [NoOffset]
- * then the original [lval] did not have an offset. *)
-val removeOffsetLval: lval -> lval * offset
-
-(** Remove ONE offset from the end of an offset sequence. Returns the
- * trimmed offset and the final offset. If the final offset is [NoOffset]
- * then the original [lval] did not have an offset. *)
-val removeOffset: offset -> offset * offset
-
-(** Compute the type of an lvalue *)
-val typeOfLval: lval -> typ
-
-(** Compute the type of an offset from a base type *)
-val typeOffset: typ -> offset -> typ
-
-
-(*******************************************************)
-(** {b Values for manipulating expressions} *)
-
-
-(* Construct integer constants *)
-
-(** 0 *)
-val zero: exp
-
-(** 1 *)
-val one: exp
-
-(** -1 *)
-val mone: exp
-
-
-(** Construct an integer of a given kind, using OCaml's int64 type. If needed
- * it will truncate the integer to be within the representable range for the
- * given kind. *)
-val kinteger64: ikind -> int64 -> exp
-
-(** Construct an integer of a given kind. Converts the integer to int64 and
- * then uses kinteger64. This might truncate the value if you use a kind
- * that cannot represent the given integer. This can only happen for one of
- * the Char or Short kinds *)
-val kinteger: ikind -> int -> exp
-
-(** Construct an integer of kind IInt. You can use this always since the
- OCaml integers are 31 bits and are guaranteed to fit in an IInt *)
-val integer: int -> exp
-
-
-(** True if the given expression is a (possibly cast'ed)
- character or an integer constant *)
-val isInteger: exp -> int64 option
-
-(** True if the expression is a compile-time constant *)
-val isConstant: exp -> bool
-
-(** True if the given expression is a (possibly cast'ed) integer or character
- constant with value zero *)
-val isZero: exp -> bool
-
-(** Given the character c in a (CChr c), sign-extend it to 32 bits.
- (This is the official way of interpreting character constants, according to
- ISO C 6.4.4.4.10, which says that character constants are chars cast to ints)
- Returns CInt64(sign-extened c, IInt, None) *)
-val charConstToInt: char -> constant
-
-(** Do constant folding on an expression. If the first argument is true then
- will also compute compiler-dependent expressions such as sizeof *)
-val constFold: bool -> exp -> exp
-
-(** Do constant folding on a binary operation. The bulk of the work done by
- [constFold] is done here. If the first argument is true then
- will also compute compiler-dependent expressions such as sizeof *)
-val constFoldBinOp: bool -> binop -> exp -> exp -> typ -> exp
-
-(** Increment an expression. Can be arithmetic or pointer type *)
-val increm: exp -> int -> exp
-
-
-(** Makes an lvalue out of a given variable *)
-val var: varinfo -> lval
-
-(** Make an AddrOf. Given an lvalue of type T will give back an expression of
- type ptr(T). It optimizes somewhat expressions like "& v" and "& v[0]" *)
-val mkAddrOf: lval -> exp
-
-
-(** Like mkAddrOf except if the type of lval is an array then it uses
- StartOf. This is the right operation for getting a pointer to the start
- of the storage denoted by lval. *)
-val mkAddrOrStartOf: lval -> exp
-
-(** Make a Mem, while optimizing AddrOf. The type of the addr must be
- TPtr(t) and the type of the resulting lval is t. Note that in CIL the
- implicit conversion between an array and the pointer to the first
- element does not apply. You must do the conversion yourself using
- StartOf *)
-val mkMem: addr:exp -> off:offset -> lval
-
-(** Make an expression that is a string constant (of pointer type) *)
-val mkString: string -> exp
-
-(** Construct a cast when having the old type of the expression. If the new
- * type is the same as the old type, then no cast is added. *)
-val mkCastT: e:exp -> oldt:typ -> newt:typ -> exp
-
-(** Like {!Cil.mkCastT} but uses typeOf to get [oldt] *)
-val mkCast: e:exp -> newt:typ -> exp
-
-(** Removes casts from this expression, but ignores casts within
- other expression constructs. So we delete the (A) and (B) casts from
- "(A)(B)(x + (C)y)", but leave the (C) cast. *)
-val stripCasts: exp -> exp
-
-(** Compute the type of an expression *)
-val typeOf: exp -> typ
-
-(** Convert a string representing a C integer literal to an expression.
- * Handles the prefixes 0x and 0 and the suffixes L, U, UL, LL, ULL *)
-val parseInt: string -> exp
-
-
-(**********************************************)
-(** {b Values for manipulating statements} *)
-
-(** Construct a statement, given its kind. Initialize the [sid] field to -1,
- and [labels], [succs] and [preds] to the empty list *)
-val mkStmt: stmtkind -> stmt
-
-(** Construct a block with no attributes, given a list of statements *)
-val mkBlock: stmt list -> block
-
-(** Construct a statement consisting of just one instruction *)
-val mkStmtOneInstr: instr -> stmt
-
-(** Try to compress statements so as to get maximal basic blocks *)
-(* use this instead of List.@ because you get fewer basic blocks *)
-val compactStmts: stmt list -> stmt list
-
-(** Returns an empty statement (of kind [Instr]) *)
-val mkEmptyStmt: unit -> stmt
-
-(** A instr to serve as a placeholder *)
-val dummyInstr: instr
-
-(** A statement consisting of just [dummyInstr] *)
-val dummyStmt: stmt
-
-(** Make a while loop. Can contain Break or Continue *)
-val mkWhile: guard:exp -> body:stmt list -> stmt list
-
-(** Make a for loop for(i=start; i<past; i += incr) \{ ... \}. The body
- can contain Break but not Continue. Can be used with i a pointer
- or an integer. Start and done must have the same type but incr
- must be an integer *)
-val mkForIncr: iter:varinfo -> first:exp -> stopat:exp -> incr:exp
- -> body:stmt list -> stmt list
-
-(** Make a for loop for(start; guard; next) \{ ... \}. The body can
- contain Break but not Continue !!! *)
-val mkFor: start:stmt list -> guard:exp -> next: stmt list ->
- body: stmt list -> stmt list
-
-
-
-(**************************************************)
-(** {b Values for manipulating attributes} *)
-
-(** Various classes of attributes *)
-type attributeClass =
- AttrName of bool
- (** Attribute of a name. If argument is true and we are on MSVC then
- the attribute is printed using __declspec as part of the storage
- specifier *)
- | AttrFunType of bool
- (** Attribute of a function type. If argument is true and we are on
- MSVC then the attribute is printed just before the function name *)
- | AttrType (** Attribute of a type *)
-
-(** This table contains the mapping of predefined attributes to classes.
- Extend this table with more attributes as you need. This table is used to
- determine how to associate attributes with names or types *)
-val attributeHash: (string, attributeClass) Hashtbl.t
-
-(** Partition the attributes into classes:name attributes, function type,
- and type attributes *)
-val partitionAttributes: default:attributeClass ->
- attributes -> attribute list * (* AttrName *)
- attribute list * (* AttrFunType *)
- attribute list (* AttrType *)
-
-(** Add an attribute. Maintains the attributes in sorted order of the second
- argument *)
-val addAttribute: attribute -> attributes -> attributes
-
-(** Add a list of attributes. Maintains the attributes in sorted order. The
- second argument must be sorted, but not necessarily the first *)
-val addAttributes: attribute list -> attributes -> attributes
-
-(** Remove all attributes with the given name. Maintains the attributes in
- sorted order. *)
-val dropAttribute: string -> attributes -> attributes
-
-(** Remove all attributes with names appearing in the string list.
- * Maintains the attributes in sorted order *)
-val dropAttributes: string list -> attributes -> attributes
-
-(** Retains attributes with the given name *)
-val filterAttributes: string -> attributes -> attributes
-
-(** True if the named attribute appears in the attribute list. The list of
- attributes must be sorted. *)
-val hasAttribute: string -> attributes -> bool
-
-(** Returns all the attributes contained in a type. This requires a traversal
- of the type structure, in case of composite, enumeration and named types *)
-val typeAttrs: typ -> attribute list
-
-val setTypeAttrs: typ -> attributes -> typ (* Resets the attributes *)
-
-
-(** Add some attributes to a type *)
-val typeAddAttributes: attribute list -> typ -> typ
-
-(** Remove all attributes with the given names from a type. Note that this
- does not remove attributes from typedef and tag definitions, just from
- their uses *)
-val typeRemoveAttributes: string list -> typ -> typ
-
-
-(******************
- ****************** VISITOR
- ******************)
-(** {b The visitor} *)
-
-(** Different visiting actions. 'a will be instantiated with [exp], [instr],
- etc. *)
-type 'a visitAction =
- SkipChildren (** Do not visit the children. Return
- the node as it is. *)
- | DoChildren (** Continue with the children of this
- node. Rebuild the node on return
- if any of the children changes
- (use == test) *)
- | ChangeTo of 'a (** Replace the expression with the
- given one *)
- | ChangeDoChildrenPost of 'a * ('a -> 'a) (** First consider that the entire
- exp is replaced by the first
- parameter. Then continue with
- the children. On return rebuild
- the node if any of the children
- has changed and then apply the
- function on the node *)
-
-
-
-(** A visitor interface for traversing CIL trees. Create instantiations of
- * this type by specializing the class {!Cil.nopCilVisitor}. Each of the
- * specialized visiting functions can also call the [queueInstr] to specify
- * that some instructions should be inserted before the current instruction
- * or statement. Use syntax like [self#queueInstr] to call a method
- * associated with the current object. *)
-class type cilVisitor = object
- method vvdec: varinfo -> varinfo visitAction
- (** Invoked for each variable declaration. The subtrees to be traversed
- * are those corresponding to the type and attributes of the variable.
- * Note that variable declarations are all the [GVar], [GVarDecl], [GFun],
- * all the [varinfo] in formals of function types, and the formals and
- * locals for function definitions. This means that the list of formals
- * in a function definition will be traversed twice, once as part of the
- * function type and second as part of the formals in a function
- * definition. *)
-
- method vvrbl: varinfo -> varinfo visitAction
- (** Invoked on each variable use. Here only the [SkipChildren] and
- * [ChangeTo] actions make sense since there are no subtrees. Note that
- * the type and attributes of the variable are not traversed for a
- * variable use *)
-
- method vexpr: exp -> exp visitAction
- (** Invoked on each expression occurrence. The subtrees are the
- * subexpressions, the types (for a [Cast] or [SizeOf] expression) or the
- * variable use. *)
-
- method vlval: lval -> lval visitAction
- (** Invoked on each lvalue occurrence *)
-
- method voffs: offset -> offset visitAction
- (** Invoked on each offset occurrence that is *not* as part
- * of an initializer list specification, i.e. in an lval or
- * recursively inside an offset. *)
-
- method vinitoffs: offset -> offset visitAction
- (** Invoked on each offset appearing in the list of a
- * CompoundInit initializer. *)
-
- method vinst: instr -> instr list visitAction
- (** Invoked on each instruction occurrence. The [ChangeTo] action can
- * replace this instruction with a list of instructions *)
-
- method vstmt: stmt -> stmt visitAction
- (** Control-flow statement. The default [DoChildren] action does not
- * create a new statement when the components change. Instead it updates
- * the contents of the original statement. This is done to preserve the
- * sharing with [Goto] and [Case] statements that point to the original
- * statement. If you use the [ChangeTo] action then you should take care
- * of preserving that sharing yourself. *)
-
- method vblock: block -> block visitAction (** Block. *)
- method vfunc: fundec -> fundec visitAction (** Function definition.
- Replaced in place. *)
- method vglob: global -> global list visitAction (** Global (vars, types,
- etc.) *)
- method vinit: init -> init visitAction (** Initializers for globals *)
- method vtype: typ -> typ visitAction (** Use of some type. Note
- * that for structure/union
- * and enumeration types the
- * definition of the
- * composite type is not
- * visited. Use [vglob] to
- * visit it. *)
- method vattr: attribute -> attribute list visitAction
- (** Attribute. Each attribute can be replaced by a list *)
- method vattrparam: attrparam -> attrparam visitAction
- (** Attribute parameters. *)
-
- (** Add here instructions while visiting to queue them to preceede the
- * current statement or instruction being processed. Use this method only
- * when you are visiting an expression that is inside a function body, or
- * a statement, because otherwise there will no place for the visitor to
- * place your instructions. *)
- method queueInstr: instr list -> unit
-
- (** Gets the queue of instructions and resets the queue. This is done
- * automatically for you when you visit statments. *)
- method unqueueInstr: unit -> instr list
-
-end
-
-(** Default Visitor. Traverses the CIL tree without modifying anything *)
-class nopCilVisitor: cilVisitor
-
-(* other cil constructs *)
-
-(** Visit a file. This will will re-cons all globals TWICE (so that it is
- * tail-recursive). Use {!Cil.visitCilFileSameGlobals} if your visitor will
- * not change the list of globals. *)
-val visitCilFile: cilVisitor -> file -> unit
-
-(** A visitor for the whole file that does not change the globals (but maybe
- * changes things inside the globals). Use this function instead of
- * {!Cil.visitCilFile} whenever appropriate because it is more efficient for
- * long files. *)
-val visitCilFileSameGlobals: cilVisitor -> file -> unit
-
-(** Visit a global *)
-val visitCilGlobal: cilVisitor -> global -> global list
-
-(** Visit a function definition *)
-val visitCilFunction: cilVisitor -> fundec -> fundec
-
-(* Visit an expression *)
-val visitCilExpr: cilVisitor -> exp -> exp
-
-(** Visit an lvalue *)
-val visitCilLval: cilVisitor -> lval -> lval
-
-(** Visit an lvalue or recursive offset *)
-val visitCilOffset: cilVisitor -> offset -> offset
-
-(** Visit an initializer offset *)
-val visitCilInitOffset: cilVisitor -> offset -> offset
-
-(** Visit an instruction *)
-val visitCilInstr: cilVisitor -> instr -> instr list
-
-(** Visit a statement *)
-val visitCilStmt: cilVisitor -> stmt -> stmt
-
-(** Visit a block *)
-val visitCilBlock: cilVisitor -> block -> block
-
-(** Visit a type *)
-val visitCilType: cilVisitor -> typ -> typ
-
-(** Visit a variable declaration *)
-val visitCilVarDecl: cilVisitor -> varinfo -> varinfo
-
-(** Visit an initializer *)
-val visitCilInit: cilVisitor -> init -> init
-
-
-(** Visit a list of attributes *)
-val visitCilAttributes: cilVisitor -> attribute list -> attribute list
-
-(* And some generic visitors. The above are built with these *)
-
-
-(** {b Utility functions} *)
-
-(** Whether the pretty printer should print output for the MS VC compiler.
- Default is GCC. After you set this function you should call {!Cil.initCIL}. *)
-val msvcMode: bool ref
-
-
-(** Whether to use the logical operands LAnd and LOr. By default, do not use
- * them because they are unlike other expressions and do not evaluate both of
- * their operands *)
-val useLogicalOperators: bool ref
-
-
-(** A visitor that does constant folding. Pass as argument whether you want
- * machine specific simplifications to be done, or not. *)
-val constFoldVisitor: bool -> cilVisitor
-
-(** Styles of printing line directives *)
-type lineDirectiveStyle =
- | LineComment
- | LinePreprocessorInput
- | LinePreprocessorOutput
-
-(** How to print line directives *)
-val lineDirectiveStyle: lineDirectiveStyle option ref
-
-(** Whether we print something that will only be used as input to our own
- * parser. In that case we are a bit more liberal in what we print *)
-val print_CIL_Input: bool ref
-
-(** Whether to print the CIL as they are, without trying to be smart and
- * print nicer code. Normally this is false, in which case the pretty
- * printer will turn the while(1) loops of CIL into nicer loops, will not
- * print empty "else" blocks, etc. These is one case howewer in which if you
- * turn this on you will get code that does not compile: if you use varargs
- * the __builtin_va_arg function will be printed in its internal form. *)
-val printCilAsIs: bool ref
-
-(** The length used when wrapping output lines. Setting this variable to
- * a large integer will prevent wrapping and make #line directives more
- * accurate.
- *)
-val lineLength: int ref
-
-(** Return the string 's' if we're printing output for gcc, suppres
- * it if we're printing for CIL to parse back in. the purpose is to
- * hide things from gcc that it complains about, but still be able
- * to do lossless transformations when CIL is the consumer *)
-val forgcc: string -> string
-
-(** {b Debugging support} *)
-
-(** A reference to the current location. If you are careful to set this to
- * the current location then you can use some built-in logging functions that
- * will print the location. *)
-val currentLoc: location ref
-
-(** A reference to the current global being visited *)
-val currentGlobal: global ref
-
-
-(** CIL has a fairly easy to use mechanism for printing error messages. This
- * mechanism is built on top of the pretty-printer mechanism (see
- * {!Pretty.doc}) and the error-message modules (see {!Errormsg.error}).
-
- Here is a typical example for printing a log message: {v
-ignore (Errormsg.log "Expression %a is not positive (at %s:%i)\n"
- d_exp e loc.file loc.line)
- v}
-
- and here is an example of how you print a fatal error message that stop the
-* execution: {v
-Errormsg.s (Errormsg.bug "Why am I here?")
- v}
-
- Notice that you can use C format strings with some extension. The most
-useful extension is "%a" that means to consumer the next two argument from
-the argument list and to apply the first to [unit] and then to the second
-and to print the resulting {!Pretty.doc}. For each major type in CIL there is
-a corresponding function that pretty-prints an element of that type:
-*)
-
-
-(** Pretty-print a location *)
-val d_loc: unit -> location -> Pretty.doc
-
-(** Pretty-print the {!Cil.currentLoc} *)
-val d_thisloc: unit -> Pretty.doc
-
-(** Pretty-print an integer of a given kind *)
-val d_ikind: unit -> ikind -> Pretty.doc
-
-(** Pretty-print a floating-point kind *)
-val d_fkind: unit -> fkind -> Pretty.doc
-
-(** Pretty-print storage-class information *)
-val d_storage: unit -> storage -> Pretty.doc
-
-(** Pretty-print a constant *)
-val d_const: unit -> constant -> Pretty.doc
-
-
-val derefStarLevel: int
-val indexLevel: int
-val arrowLevel: int
-val addrOfLevel: int
-val additiveLevel: int
-val comparativeLevel: int
-val bitwiseLevel: int
-
-(** Parentheses level. An expression "a op b" is printed parenthesized if its
- * parentheses level is >= that that of its context. Identifiers have the
- * lowest level and weakly binding operators (e.g. |) have the largest level.
- * The correctness criterion is that a smaller level MUST correspond to a
- * stronger precedence!
- *)
-val getParenthLevel: exp -> int
-
-(** A printer interface for CIL trees. Create instantiations of
- * this type by specializing the class {!Cil.defaultCilPrinterClass}. *)
-class type cilPrinter = object
- method pVDecl: unit -> varinfo -> Pretty.doc
- (** Invoked for each variable declaration. Note that variable
- * declarations are all the [GVar], [GVarDecl], [GFun], all the [varinfo]
- * in formals of function types, and the formals and locals for function
- * definitions. *)
-
- method pVar: varinfo -> Pretty.doc
- (** Invoked on each variable use. *)
-
- method pLval: unit -> lval -> Pretty.doc
- (** Invoked on each lvalue occurrence *)
-
- method pOffset: Pretty.doc -> offset -> Pretty.doc
- (** Invoked on each offset occurrence. The second argument is the base. *)
-
- method pInstr: unit -> instr -> Pretty.doc
- (** Invoked on each instruction occurrence. *)
-
- method pLabel: unit -> label -> Pretty.doc
- (** Print a label. *)
-
- method pStmt: unit -> stmt -> Pretty.doc
- (** Control-flow statement. This is used by
- * {!Cil.printGlobal} and by {!Cil.dumpGlobal}. *)
-
- method dStmt: out_channel -> int -> stmt -> unit
- (** Dump a control-flow statement to a file with a given indentation.
- * This is used by {!Cil.dumpGlobal}. *)
-
- method dBlock: out_channel -> int -> block -> unit
- (** Dump a control-flow block to a file with a given indentation.
- * This is used by {!Cil.dumpGlobal}. *)
-
- method pBlock: unit -> block -> Pretty.doc
-
- method pBlock: unit -> block -> Pretty.doc
- (** Print a block. *)
-
- method pGlobal: unit -> global -> Pretty.doc
- (** Global (vars, types, etc.). This can be slow and is used only by
- * {!Cil.printGlobal} but not by {!Cil.dumpGlobal}. *)
-
- method dGlobal: out_channel -> global -> unit
- (** Dump a global to a file with a given indentation. This is used by
- * {!Cil.dumpGlobal} *)
-
- method pFieldDecl: unit -> fieldinfo -> Pretty.doc
- (** A field declaration *)
-
- method pType: Pretty.doc option -> unit -> typ -> Pretty.doc
- (* Use of some type in some declaration. The first argument is used to print
- * the declared element, or is None if we are just printing a type with no
- * name being declared. Note that for structure/union and enumeration types
- * the definition of the composite type is not visited. Use [vglob] to
- * visit it. *)
-
- method pAttr: attribute -> Pretty.doc * bool
- (** Attribute. Also return an indication whether this attribute must be
- * printed inside the __attribute__ list or not. *)
-
- method pAttrParam: unit -> attrparam -> Pretty.doc
- (** Attribute parameter *)
-
- method pAttrs: unit -> attributes -> Pretty.doc
- (** Attribute lists *)
-
- method pLineDirective: ?forcefile:bool -> location -> Pretty.doc
- (** Print a line-number. This is assumed to come always on an empty line.
- * If the forcefile argument is present and is true then the file name
- * will be printed always. Otherwise the file name is printed only if it
- * is different from the last time time this function is called. The last
- * file name is stored in a private field inside the cilPrinter object. *)
-
- method pStmtKind: stmt -> unit -> stmtkind -> Pretty.doc
- (** Print a statement kind. The code to be printed is given in the
- * {!Cil.stmtkind} argument. The initial {!Cil.stmt} argument
- * records the statement which follows the one being printed;
- * {!Cil.defaultCilPrinterClass} uses this information to prettify
- * statement printing in certain special cases. *)
-
- method pExp: unit -> exp -> Pretty.doc
- (** Print expressions *)
-
- method pInit: unit -> init -> Pretty.doc
- (** Print initializers. This can be slow and is used by
- * {!Cil.printGlobal} but not by {!Cil.dumpGlobal}. *)
-
- method dInit: out_channel -> int -> init -> unit
- (** Dump a global to a file with a given indentation. This is used by
- * {!Cil.dumpGlobal} *)
-end
-
-class defaultCilPrinterClass: cilPrinter
-val defaultCilPrinter: cilPrinter
-
-(** These are pretty-printers that will show you more details on the internal
- * CIL representation, without trying hard to make it look like C *)
-class plainCilPrinterClass: cilPrinter
-val plainCilPrinter: cilPrinter
-
-(* zra: This is the pretty printer that Maincil will use.
- by default it is set to defaultCilPrinter *)
-val printerForMaincil: cilPrinter ref
-
-(* Top-level printing functions *)
-(** Print a type given a pretty printer *)
-val printType: cilPrinter -> unit -> typ -> Pretty.doc
-
-(** Print an expression given a pretty printer *)
-val printExp: cilPrinter -> unit -> exp -> Pretty.doc
-
-(** Print an lvalue given a pretty printer *)
-val printLval: cilPrinter -> unit -> lval -> Pretty.doc
-
-(** Print a global given a pretty printer *)
-val printGlobal: cilPrinter -> unit -> global -> Pretty.doc
-
-(** Print an attribute given a pretty printer *)
-val printAttr: cilPrinter -> unit -> attribute -> Pretty.doc
-
-(** Print a set of attributes given a pretty printer *)
-val printAttrs: cilPrinter -> unit -> attributes -> Pretty.doc
-
-(** Print an instruction given a pretty printer *)
-val printInstr: cilPrinter -> unit -> instr -> Pretty.doc
-
-(** Print a statement given a pretty printer. This can take very long
- * (or even overflow the stack) for huge statements. Use {!Cil.dumpStmt}
- * instead. *)
-val printStmt: cilPrinter -> unit -> stmt -> Pretty.doc
-
-(** Print a block given a pretty printer. This can take very long
- * (or even overflow the stack) for huge block. Use {!Cil.dumpBlock}
- * instead. *)
-val printBlock: cilPrinter -> unit -> block -> Pretty.doc
-
-(** Dump a statement to a file using a given indentation. Use this instead of
- * {!Cil.printStmt} whenever possible. *)
-val dumpStmt: cilPrinter -> out_channel -> int -> stmt -> unit
-
-(** Dump a block to a file using a given indentation. Use this instead of
- * {!Cil.printBlock} whenever possible. *)
-val dumpBlock: cilPrinter -> out_channel -> int -> block -> unit
-
-(** Print an initializer given a pretty printer. This can take very long
- * (or even overflow the stack) for huge initializers. Use {!Cil.dumpInit}
- * instead. *)
-val printInit: cilPrinter -> unit -> init -> Pretty.doc
-
-(** Dump an initializer to a file using a given indentation. Use this instead of
- * {!Cil.printInit} whenever possible. *)
-val dumpInit: cilPrinter -> out_channel -> int -> init -> unit
-
-(** Pretty-print a type using {!Cil.defaultCilPrinter} *)
-val d_type: unit -> typ -> Pretty.doc
-
-(** Pretty-print an expression using {!Cil.defaultCilPrinter} *)
-val d_exp: unit -> exp -> Pretty.doc
-
-(** Pretty-print an lvalue using {!Cil.defaultCilPrinter} *)
-val d_lval: unit -> lval -> Pretty.doc
-
-(** Pretty-print an offset using {!Cil.defaultCilPrinter}, given the pretty
- * printing for the base. *)
-val d_offset: Pretty.doc -> unit -> offset -> Pretty.doc
-
-(** Pretty-print an initializer using {!Cil.defaultCilPrinter}. This can be
- * extremely slow (or even overflow the stack) for huge initializers. Use
- * {!Cil.dumpInit} instead. *)
-val d_init: unit -> init -> Pretty.doc
-
-(** Pretty-print a binary operator *)
-val d_binop: unit -> binop -> Pretty.doc
-
-(** Pretty-print a unary operator *)
-val d_unop: unit -> unop -> Pretty.doc
-
-(** Pretty-print an attribute using {!Cil.defaultCilPrinter} *)
-val d_attr: unit -> attribute -> Pretty.doc
-
-(** Pretty-print an argument of an attribute using {!Cil.defaultCilPrinter} *)
-val d_attrparam: unit -> attrparam -> Pretty.doc
-
-(** Pretty-print a list of attributes using {!Cil.defaultCilPrinter} *)
-val d_attrlist: unit -> attributes -> Pretty.doc
-
-(** Pretty-print an instruction using {!Cil.defaultCilPrinter} *)
-val d_instr: unit -> instr -> Pretty.doc
-
-(** Pretty-print a label using {!Cil.defaultCilPrinter} *)
-val d_label: unit -> label -> Pretty.doc
-
-(** Pretty-print a statement using {!Cil.defaultCilPrinter}. This can be
- * extremely slow (or even overflow the stack) for huge statements. Use
- * {!Cil.dumpStmt} instead. *)
-val d_stmt: unit -> stmt -> Pretty.doc
-
-(** Pretty-print a block using {!Cil.defaultCilPrinter}. This can be
- * extremely slow (or even overflow the stack) for huge blocks. Use
- * {!Cil.dumpBlock} instead. *)
-val d_block: unit -> block -> Pretty.doc
-
-(** Pretty-print the internal representation of a global using
- * {!Cil.defaultCilPrinter}. This can be extremely slow (or even overflow the
- * stack) for huge globals (such as arrays with lots of initializers). Use
- * {!Cil.dumpGlobal} instead. *)
-val d_global: unit -> global -> Pretty.doc
-
-
-(** Versions of the above pretty printers, that don't print #line directives *)
-val dn_exp : unit -> exp -> Pretty.doc
-val dn_lval : unit -> lval -> Pretty.doc
-(* dn_offset is missing because it has a different interface *)
-val dn_init : unit -> init -> Pretty.doc
-val dn_type : unit -> typ -> Pretty.doc
-val dn_global : unit -> global -> Pretty.doc
-val dn_attrlist : unit -> attributes -> Pretty.doc
-val dn_attr : unit -> attribute -> Pretty.doc
-val dn_attrparam : unit -> attrparam -> Pretty.doc
-val dn_stmt : unit -> stmt -> Pretty.doc
-val dn_instr : unit -> instr -> Pretty.doc
-
-
-(** Pretty-print a short description of the global. This is useful for error
- * messages *)
-val d_shortglobal: unit -> global -> Pretty.doc
-
-(** Pretty-print a global. Here you give the channel where the printout
- * should be sent. *)
-val dumpGlobal: cilPrinter -> out_channel -> global -> unit
-
-(** Pretty-print an entire file. Here you give the channel where the printout
- * should be sent. *)
-val dumpFile: cilPrinter -> out_channel -> string -> file -> unit
-
-
-(* the following error message producing functions also print a location in
- * the code. use {!Errormsg.bug} and {!Errormsg.unimp} if you do not want
- * that *)
-
-(** Like {!Errormsg.bug} except that {!Cil.currentLoc} is also printed *)
-val bug: ('a,unit,Pretty.doc) format -> 'a
-
-(** Like {!Errormsg.unimp} except that {!Cil.currentLoc}is also printed *)
-val unimp: ('a,unit,Pretty.doc) format -> 'a
-
-(** Like {!Errormsg.error} except that {!Cil.currentLoc} is also printed *)
-val error: ('a,unit,Pretty.doc) format -> 'a
-
-(** Like {!Cil.error} except that it explicitly takes a location argument,
- * instead of using the {!Cil.currentLoc} *)
-val errorLoc: location -> ('a,unit,Pretty.doc) format -> 'a
-
-(** Like {!Errormsg.warn} except that {!Cil.currentLoc} is also printed *)
-val warn: ('a,unit,Pretty.doc) format -> 'a
-
-
-(** Like {!Errormsg.warnOpt} except that {!Cil.currentLoc} is also printed.
- * This warning is printed only of {!Errormsg.warnFlag} is set. *)
-val warnOpt: ('a,unit,Pretty.doc) format -> 'a
-
-(** Like {!Errormsg.warn} except that {!Cil.currentLoc} and context
- is also printed *)
-val warnContext: ('a,unit,Pretty.doc) format -> 'a
-
-(** Like {!Errormsg.warn} except that {!Cil.currentLoc} and context is also
- * printed. This warning is printed only of {!Errormsg.warnFlag} is set. *)
-val warnContextOpt: ('a,unit,Pretty.doc) format -> 'a
-
-(** Like {!Cil.warn} except that it explicitly takes a location argument,
- * instead of using the {!Cil.currentLoc} *)
-val warnLoc: location -> ('a,unit,Pretty.doc) format -> 'a
-
-(** Sometimes you do not want to see the syntactic sugar that the above
- * pretty-printing functions add. In that case you can use the following
- * pretty-printing functions. But note that the output of these functions is
- * not valid C *)
-
-(** Pretty-print the internal representation of an expression *)
-val d_plainexp: unit -> exp -> Pretty.doc
-
-(** Pretty-print the internal representation of an integer *)
-val d_plaininit: unit -> init -> Pretty.doc
-
-(** Pretty-print the internal representation of an lvalue *)
-val d_plainlval: unit -> lval -> Pretty.doc
-
-(** Pretty-print the internal representation of an lvalue offset
-val d_plainoffset: unit -> offset -> Pretty.doc *)
-
-(** Pretty-print the internal representation of a type *)
-val d_plaintype: unit -> typ -> Pretty.doc
-
-
-
-(** {b ALPHA conversion} has been moved to the Alpha module. *)
-
-
-(** Assign unique names to local variables. This might be necessary after you
- * transformed the code and added or renamed some new variables. Names are
- * not used by CIL internally, but once you print the file out the compiler
- * downstream might be confused. You might
- * have added a new global that happens to have the same name as a local in
- * some function. Rename the local to ensure that there would never be
- * confusioin. Or, viceversa, you might have added a local with a name that
- * conflicts with a global *)
-val uniqueVarNames: file -> unit
-
-(** {b Optimization Passes} *)
-
-(** A peephole optimizer that processes two adjacent statements and possibly
- replaces them both. If some replacement happens, then the new statements
- are themselves subject to optimization *)
-val peepHole2: (instr * instr -> instr list option) -> stmt list -> unit
-
-(** Similar to [peepHole2] except that the optimization window consists of
- one statement, not two *)
-val peepHole1: (instr -> instr list option) -> stmt list -> unit
-
-(** {b Machine dependency} *)
-
-
-(** Raised when one of the bitsSizeOf functions cannot compute the size of a
- * type. This can happen because the type contains array-length expressions
- * that we don't know how to compute or because it is a type whose size is
- * not defined (e.g. TFun or an undefined compinfo). The string is an
- * explanation of the error *)
-exception SizeOfError of string * typ
-
-(** The size of a type, in bits. Trailing padding is added for structs and
- * arrays. Raises {!Cil.SizeOfError} when it cannot compute the size. This
- * function is architecture dependent, so you should only call this after you
- * call {!Cil.initCIL}. Remember that on GCC sizeof(void) is 1! *)
-val bitsSizeOf: typ -> int
-
-(* The size of a type, in bytes. Returns a constant expression or a "sizeof"
- * expression if it cannot compute the size. This function is architecture
- * dependent, so you should only call this after you call {!Cil.initCIL}. *)
-val sizeOf: typ -> exp
-
-(** The minimum alignment (in bytes) for a type. This function is
- * architecture dependent, so you should only call this after you call
- * {!Cil.initCIL}. *)
-val alignOf_int: typ -> int
-
-(** Give a type of a base and an offset, returns the number of bits from the
- * base address and the width (also expressed in bits) for the subobject
- * denoted by the offset. Raises {!Cil.SizeOfError} when it cannot compute
- * the size. This function is architecture dependent, so you should only call
- * this after you call {!Cil.initCIL}. *)
-val bitsOffset: typ -> offset -> int * int
-
-
-(** Whether "char" is unsigned. Set after you call {!Cil.initCIL} *)
-val char_is_unsigned: bool ref
-
-(** Whether the machine is little endian. Set after you call {!Cil.initCIL} *)
-val little_endian: bool ref
-
-(** Whether the compiler generates assembly labels by prepending "_" to the
- identifier. That is, will function foo() have the label "foo", or "_foo"?
- Set after you call {!Cil.initCIL} *)
-val underscore_name: bool ref
-
-(** Represents a location that cannot be determined *)
-val locUnknown: location
-
-(** Return the location of an instruction *)
-val get_instrLoc: instr -> location
-
-(** Return the location of a global, or locUnknown *)
-val get_globalLoc: global -> location
-
-(** Return the location of a statement, or locUnknown *)
-val get_stmtLoc: stmtkind -> location
-
-
-(** Generate an {!Cil.exp} to be used in case of errors. *)
-val dExp: Pretty.doc -> exp
-
-(** Generate an {!Cil.instr} to be used in case of errors. *)
-val dInstr: Pretty.doc -> location -> instr
-
-(** Generate a {!Cil.global} to be used in case of errors. *)
-val dGlobal: Pretty.doc -> location -> global
-
-(** Like map but try not to make a copy of the list *)
-val mapNoCopy: ('a -> 'a) -> 'a list -> 'a list
-
-(** Like map but each call can return a list. Try not to make a copy of the
- list *)
-val mapNoCopyList: ('a -> 'a list) -> 'a list -> 'a list
-
-(** sm: return true if the first is a prefix of the second string *)
-val startsWith: string -> string -> bool
-
-
-(** {b An Interpreter for constructing CIL constructs} *)
-
-(** The type of argument for the interpreter *)
-type formatArg =
- Fe of exp
- | Feo of exp option (** For array lengths *)
- | Fu of unop
- | Fb of binop
- | Fk of ikind
- | FE of exp list (** For arguments in a function call *)
- | Ff of (string * typ * attributes) (** For a formal argument *)
- | FF of (string * typ * attributes) list (** For formal argument lists *)
- | Fva of bool (** For the ellipsis in a function type *)
- | Fv of varinfo
- | Fl of lval
- | Flo of lval option
-
- | Fo of offset
-
- | Fc of compinfo
- | Fi of instr
- | FI of instr list
- | Ft of typ
- | Fd of int
- | Fg of string
- | Fs of stmt
- | FS of stmt list
- | FA of attributes
-
- | Fp of attrparam
- | FP of attrparam list
-
- | FX of string
-
-
-(** Pretty-prints a format arg *)
-val d_formatarg: unit -> formatArg -> Pretty.doc
-
-val lowerConstants: bool ref
- (** Do lower constant expressions into constants (default true) *)
diff --git a/cil/src/cillower.ml b/cil/src/cillower.ml
deleted file mode 100755
index 61745bf403cd9457359dd5c32eab809cc8c4baab..0000000000000000000000000000000000000000
--- a/cil/src/cillower.ml
+++ /dev/null
@@ -1,57 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2003,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * Ben Liblit <liblit@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(** A number of lowering passes over CIL *)
-open Cil
-open Pretty
-module E = Errormsg
-
-(** Lower CEnum constants *)
-class lowerEnumVisitorClass : cilVisitor = object (self)
- inherit nopCilVisitor
-
- method vexpr (e: exp) =
- match e with
- Const (CEnum(v, s, ei)) ->
- ChangeTo (visitCilExpr (self :>cilVisitor) v)
-
- | _ -> DoChildren
-
-end
-
-let lowerEnumVisitor = new lowerEnumVisitorClass
diff --git a/cil/src/cillower.mli b/cil/src/cillower.mli
deleted file mode 100755
index a62c9e3b6f61fb8b2266d4238bc77b40aea1b58d..0000000000000000000000000000000000000000
--- a/cil/src/cillower.mli
+++ /dev/null
@@ -1,42 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2003,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * Ben Liblit <liblit@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(** A number of lowering passes over CIL *)
-
-(** Replace enumeration constants with integer constants *)
-val lowerEnumVisitor : Cil.cilVisitor
diff --git a/cil/src/ciloptions.ml b/cil/src/ciloptions.ml
deleted file mode 100755
index 9a2b4bd543be33236c14188970ee63d3aaa92638..0000000000000000000000000000000000000000
--- a/cil/src/ciloptions.ml
+++ /dev/null
@@ -1,196 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2003,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * Ben Liblit <liblit@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-
-module E = Errormsg
-
-let setDebugFlag v name =
- E.debugFlag := v;
- if v then Pretty.flushOften := true
-
-type outfile =
- { fname: string;
- fchan: out_channel }
-
-let setTraceDepth n =
- Pretty.printDepth := n
-
-
- (* Processign of output file arguments *)
-let openFile (what: string) (takeit: outfile -> unit) (fl: string) =
- if !E.verboseFlag then
- ignore (Printf.printf "Setting %s to %s\n" what fl);
- (try takeit { fname = fl;
- fchan = open_out fl }
- with _ ->
- raise (Arg.Bad ("Cannot open " ^ what ^ " file " ^ fl)))
-
-
-let fileNames : string list ref = ref []
-let recordFile fname =
- fileNames := fname :: (!fileNames)
-
- (* Parsing of files with additional names *)
-let parseExtraFile (s: string) =
- try
- let sfile = open_in s in
- while true do
- let line = try input_line sfile with e -> (close_in sfile; raise e) in
- let linelen = String.length line in
- let rec scan (pos: int) (* next char to look at *)
- (start: int) : unit (* start of the word,
- or -1 if none *) =
- if pos >= linelen then
- if start >= 0 then
- recordFile (String.sub line start (pos - start))
- else
- () (* Just move on to the next line *)
- else
- let c = String.get line pos in
- match c with
- ' ' | '\n' | '\r' | '\t' ->
- (* whitespace *)
- if start >= 0 then begin
- recordFile (String.sub line start (pos - start));
- end;
- scan (pos + 1) (-1)
-
- | _ -> (* non-whitespace *)
- if start >= 0 then
- scan (pos + 1) start
- else
- scan (pos + 1) pos
- in
- scan 0 (-1)
- done
- with Sys_error _ -> E.s (E.error "Cannot find extra file: %s\n" s)
- | End_of_file -> ()
-
-
-let options : (string * Arg.spec * string) list =
- [
- (* General Options *)
- "", Arg.Unit (fun () -> ()), "\n\t\tGeneral Options\n" ;
-
- "--version", Arg.Unit
- (fun _ -> print_endline ("CIL version " ^ Cil.cilVersion ^
- "\nMore information at http://cil.sourceforge.net/\n");
- exit 0),
- "output version information and exit";
- "--verbose", Arg.Unit (fun _ -> E.verboseFlag := true),
- "Print lots of random stuff. This is passed on from cilly.";
- "--warnall", Arg.Unit (fun _ -> E.warnFlag := true), "Show all warnings";
- "--debug", Arg.String (setDebugFlag true),
- "<xxx> turns on debugging flag xxx";
- "--nodebug", Arg.String (setDebugFlag false),
- "<xxx> turns off debugging flag xxx";
-
- "--flush", Arg.Unit (fun _ -> Pretty.flushOften := true),
- "Flush the output streams often (aids debugging)" ;
- "--check", Arg.Unit (fun _ -> Cilutil.doCheck := true),
- "Run a consistency check over the CIL after every operation.";
- "--nocheck", Arg.Unit (fun _ -> Cilutil.doCheck := false),
- "turns off consistency checking of CIL";
- "--noPrintLn", Arg.Unit (fun _ -> Cil.lineDirectiveStyle := None;
- Cprint.printLn := false),
- "Don't output #line directives in the output.";
- "--commPrintLn", Arg.Unit (fun _ -> Cil.lineDirectiveStyle := Some Cil.LineComment;
- Cprint.printLnComment := true),
- "Print #line directives in the output, but put them in comments.";
- "--stats", Arg.Unit (fun _ -> Cilutil.printStats := true),
- "Print statistics about running times and memory usage.";
-
-
- "--log", Arg.String (openFile "log" (fun oc -> E.logChannel := oc.fchan)),
- "Set the name of the log file. By default stderr is used";
-
- "--MSVC", Arg.Unit (fun _ -> Cil.msvcMode := true;
- Frontc.setMSVCMode ();
- if not Machdep.hasMSVC then
- ignore (E.warn "Will work in MSVC mode but will be using machine-dependent parameters for GCC since you do not have the MSVC compiler installed\n")
- ), "Enable MSVC compatibility. Default is GNU.";
-
- "--testcil", Arg.String (fun s -> Cilutil.testcil := s),
- "test CIL using the given compiler";
-
- "--ignore-merge-conflicts",
- Arg.Unit (fun _ -> Mergecil.ignore_merge_conflicts := true),
- "ignore merging conflicts";
- "--sliceGlobal", Arg.Unit (fun _ -> Cilutil.sliceGlobal := true),
- "output is the slice of #pragma cilnoremove(sym) symbols";
-
- (* sm: some more debugging options *)
- "--tr", Arg.String Trace.traceAddMulti,
- "<sys>: subsystem to show debug printfs for";
- "--pdepth", Arg.Int setTraceDepth,
- "<n>: set max print depth (default: 5)";
-
- "--extrafiles", Arg.String parseExtraFile,
- "<filename>: the name of a file that contains a list of additional files to process, separated by whitespace of newlines";
-
- (* Lowering Options *)
- "", Arg.Unit (fun () -> ()), "\n\t\tLowering Options\n" ;
-
- "--noLowerConstants", Arg.Unit (fun _ -> Cil.lowerConstants := false),
- "do not lower constant expressions";
-
- "--noInsertImplicitCasts", Arg.Unit (fun _ -> Cil.insertImplicitCasts := false),
- "do not insert implicit casts";
-
- "--forceRLArgEval",
- Arg.Unit (fun n -> Cabs2cil.forceRLArgEval := true),
- "Forces right to left evaluation of function arguments";
- "--nocil", Arg.Int (fun n -> Cabs2cil.nocil := n),
- "Do not compile to CIL the global with the given index";
- "--disallowDuplication", Arg.Unit (fun n -> Cabs2cil.allowDuplication := false),
- "Prevent small chunks of code from being duplicated";
- "--keepunused", Arg.Set Rmtmps.keepUnused,
- "Do not remove the unused variables and types";
- "--rmUnusedInlines", Arg.Set Rmtmps.rmUnusedInlines,
- "Delete any unused inline functions. This is the default in MSVC mode";
-
-
-
- "", Arg.Unit (fun () -> ()), "\n\t\tOutput Options\n" ;
- "--printCilAsIs", Arg.Unit (fun _ -> Cil.printCilAsIs := true),
- "do not try to simplify the CIL when printing. Without this flag, CIL will attempt to produce prettier output by e.g. changing while(1) into more meaningful loops.";
- "--noWrap", Arg.Unit (fun _ -> Cil.lineLength := 100000),
- "do not wrap long lines when printing";
-
- ]
-
diff --git a/cil/src/ciloptions.mli b/cil/src/ciloptions.mli
deleted file mode 100755
index 13f65cf410e6c588f943551ce2ff280d4aac1eda..0000000000000000000000000000000000000000
--- a/cil/src/ciloptions.mli
+++ /dev/null
@@ -1,48 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2003,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * Ben Liblit <liblit@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-
-(** The command-line options for CIL *)
-val options : (string * Arg.spec * string) list
-
-
-(** The list of file names *)
-val fileNames : string list ref
-
-(** Adds the file to the start of fileNames *)
-val recordFile: string -> unit
diff --git a/cil/src/cilutil.ml b/cil/src/cilutil.ml
deleted file mode 100644
index b9a4da9834277700235bd5679f2abdff9df4eb0c..0000000000000000000000000000000000000000
--- a/cil/src/cilutil.ml
+++ /dev/null
@@ -1,72 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* Keep here the globally-visible flags *)
-let doCheck= ref false (* Whether to check CIL *)
-
-let logCalls = ref false (* Whether to produce a log with all the function
- * calls made *)
-let logWrites = ref false (* Whether to produce a log with all the mem
- * writes made *)
-let doPartial = ref false (* Whether to do partial evaluation and constant
- * folding *)
-let doSimpleMem = ref false (* reduce complex memory expressions so that
- * they contain at most one lval *)
-let doOneRet = ref false (* make a functions have at most one 'return' *)
-let doStackGuard = ref false (* instrument function calls and returns to
-maintain a separate stack for return addresses *)
-let doHeapify = ref false (* move stack-allocated arrays to the heap *)
-let makeCFG = ref false (* turn the input CIL file into something more like
- * a CFG *)
-let printStats = ref false
-
-(* when 'sliceGlobal' is set, then when 'rmtmps' runs, only globals*)
-(* marked with #pragma cilnoremove(whatever) are kept; when used with *)
-(* cilly.asm.exe, the effect is to slice the input on the noremove symbols *)
-let sliceGlobal = ref false
-
-
-let printStages = ref false
-
-
-let doCxxPP = ref false
-
-let libDir = ref ""
-
-let dumpFCG = ref false
-let testcil = ref ""
-
diff --git a/cil/src/escape.ml b/cil/src/escape.ml
deleted file mode 100644
index 198c9e5c61030edfa8f6f0566b0200d304d8d6a4..0000000000000000000000000000000000000000
--- a/cil/src/escape.ml
+++ /dev/null
@@ -1,93 +0,0 @@
-(*
- *
- * Copyright (c) 2003,
- * Ben Liblit <liblit@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-
-(** OCaml types used to represent wide characters and strings *)
-type wchar = int64
-type wstring = wchar list
-
-
-let escape_char = function
- | '\007' -> "\\a"
- | '\b' -> "\\b"
- | '\t' -> "\\t"
- | '\n' -> "\\n"
- | '\011' -> "\\v"
- | '\012' -> "\\f"
- | '\r' -> "\\r"
- | '"' -> "\\\""
- | '\'' -> "\\'"
- | '\\' -> "\\\\"
- | ' ' .. '~' as printable -> String.make 1 printable
- | unprintable -> Printf.sprintf "\\%03o" (Char.code unprintable)
-
-let escape_string str =
- let length = String.length str in
- let buffer = Buffer.create length in
- for index = 0 to length - 1 do
- Buffer.add_string buffer (escape_char (String.get str index))
- done;
- Buffer.contents buffer
-
-(* a wide char represented as an int64 *)
-let escape_wchar =
- (* limit checks whether upper > probe *)
- let limit upper probe = (Int64.to_float (Int64.sub upper probe)) > 0.5 in
- let fits_byte = limit (Int64.of_int 0x100) in
- let fits_octal_escape = limit (Int64.of_int 0o1000) in
- let fits_universal_4 = limit (Int64.of_int 0x10000) in
- let fits_universal_8 = limit (Int64.of_string "0x100000000") in
- fun charcode ->
- if fits_byte charcode then
- escape_char (Char.chr (Int64.to_int charcode))
- else if fits_octal_escape charcode then
- Printf.sprintf "\\%03Lo" charcode
- else if fits_universal_4 charcode then
- Printf.sprintf "\\u%04Lx" charcode
- else if fits_universal_8 charcode then
- Printf.sprintf "\\u%04Lx" charcode
- else
- invalid_arg "Cprint.escape_string_intlist"
-
-(* a wide string represented as a list of int64s *)
-let escape_wstring (str : int64 list) =
- let length = List.length str in
- let buffer = Buffer.create length in
- let append charcode =
- let addition = escape_wchar charcode in
- Buffer.add_string buffer addition
- in
- List.iter append str;
- Buffer.contents buffer
diff --git a/cil/src/escape.mli b/cil/src/escape.mli
deleted file mode 100644
index b932ef142546e67184c5c02ab3ca6ea60f2bb011..0000000000000000000000000000000000000000
--- a/cil/src/escape.mli
+++ /dev/null
@@ -1,48 +0,0 @@
-(*
- *
- * Copyright (c) 2003,
- * Ben Liblit <liblit@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(*
- * Character and string escaping utilities
- *)
-
-(** OCaml types used to represent wide characters and strings *)
-type wchar = int64
-type wstring = wchar list
-
-(** escape various constructs in accordance with C lexical rules *)
-val escape_char : char -> string
-val escape_string : string -> string
-val escape_wchar : wchar -> string
-val escape_wstring : wstring -> string
diff --git a/cil/src/ext/astslicer.ml b/cil/src/ext/astslicer.ml
deleted file mode 100644
index ffba48277d7732dddef70bfad3c5b725bfad4575..0000000000000000000000000000000000000000
--- a/cil/src/ext/astslicer.ml
+++ /dev/null
@@ -1,454 +0,0 @@
-(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-open Cil
-module E = Errormsg
-(*
- * Weimer: an AST Slicer for use in Daniel's Delta Debugging Algorithm.
- *)
-let debug = ref false
-
-(*
- * This type encapsulates a mapping form program locations to names
- * in our naming convention.
- *)
-type enumeration_info = {
- statements : (stmt, string) Hashtbl.t ;
- instructions : (instr, string) Hashtbl.t ;
-}
-
-(**********************************************************************
- * Enumerate 1
- *
- * Given a cil file, enumerate all of the statement names in it using
- * our naming scheme.
- **********************************************************************)
-let enumerate out (f : Cil.file) =
- let st_ht = Hashtbl.create 32767 in
- let in_ht = Hashtbl.create 32767 in
-
- let emit base i ht elt =
- let str = Printf.sprintf "%s.%d" base !i in
- Printf.fprintf out "%s\n" str ;
- Hashtbl.add ht elt str ;
- incr i
- in
- let emit_call base i str2 ht elt =
- let str = Printf.sprintf "%s.%d" base !i in
- Printf.fprintf out "%s - %s\n" str str2 ;
- Hashtbl.add ht elt str ;
- incr i
- in
- let descend base i =
- let res = (Printf.sprintf "%s.%d" base !i),(ref 0) in
- res
- in
- let rec doBlock b base i =
- doStmtList b.bstmts base i
- and doStmtList sl base i =
- List.iter (fun s -> match s.skind with
- | Instr(il) -> doIL il base i
- | Return(_,_)
- | Goto(_,_)
- | Continue(_)
- | Break(_) -> emit base i st_ht s
- | If(e,b1,b2,_) ->
- emit base i st_ht s ;
- decr i ;
- Printf.fprintf out "(\n" ;
- let base',i' = descend base i in
- doBlock b1 base' i' ;
- Printf.fprintf out ") (\n" ;
- let base'',i'' = descend base i in
- doBlock b2 base'' i'' ;
- Printf.fprintf out ")\n" ;
- incr i
- | Switch(_,b,_,_)
-(*
- | Loop(b,_,_,_)
-*)
- | While(_,b,_)
- | DoWhile(_,b,_)
- | For(_,_,_,b,_)
- | Block(b) ->
- emit base i st_ht s ;
- decr i ;
- let base',i' = descend base i in
- Printf.fprintf out "(\n" ;
- doBlock b base' i' ;
- Printf.fprintf out ")\n" ;
- incr i
- | TryExcept _ | TryFinally _ ->
- E.s (E.unimp "astslicer:enumerate")
- ) sl
- and doIL il base i =
- List.iter (fun ins -> match ins with
- | Set _
- | Asm _ -> emit base i in_ht ins
- | Call(_,(Lval(Var(vi),NoOffset)),_,_) ->
- emit_call base i vi.vname in_ht ins
- | Call(_,f,_,_) -> emit_call base i "*" in_ht ins
- ) il
- in
- let doGlobal g = match g with
- | GFun(fd,_) ->
- Printf.fprintf out "%s (\n" fd.svar.vname ;
- let cur = ref 0 in
- doBlock fd.sbody fd.svar.vname cur ;
- Printf.fprintf out ")\n" ;
- ()
- | _ -> ()
- in
- List.iter doGlobal f.globals ;
- { statements = st_ht ;
- instructions = in_ht ; }
-
-(**********************************************************************
- * Enumerate 2
- *
- * Given a cil file and some enumeration information, do a log-calls-like
- * transformation on it that prints out our names as you reach them.
- **********************************************************************)
-(*
- * This is the visitor that handles annotations
- *)
-let print_it pfun name =
- ((Call(None,Lval(Var(pfun),NoOffset),
- [mkString (name ^ "\n")],locUnknown)))
-
-class enumVisitor pfun st_ht in_ht = object
- inherit nopCilVisitor
- method vinst i =
- if Hashtbl.mem in_ht i then begin
- let name = Hashtbl.find in_ht i in
- let newinst = print_it pfun name in
- ChangeTo([newinst ; i])
- end else
- DoChildren
- method vstmt s =
- if Hashtbl.mem st_ht s then begin
- let name = Hashtbl.find st_ht s in
- let newinst = print_it pfun name in
- let newstmt = mkStmtOneInstr newinst in
- let newblock = mkBlock [newstmt ; s] in
- let replace_with = mkStmt (Block(newblock)) in
- ChangeDoChildrenPost(s,(fun i -> replace_with))
- end else
- DoChildren
- method vfunc f =
- let newinst = print_it pfun f.svar.vname in
- let newstmt = mkStmtOneInstr newinst in
- let new_f = { f with sbody = { f.sbody with
- bstmts = newstmt :: f.sbody.bstmts }} in
- ChangeDoChildrenPost(new_f,(fun i -> i))
-end
-
-let annotate (f : Cil.file) ei = begin
- (* Create a prototype for the logging function *)
- let printfFun =
- let fdec = emptyFunction "printf" in
- let argf = makeLocalVar fdec "format" charConstPtrType in
- fdec.svar.vtype <- TFun(intType, Some [ ("format", charConstPtrType, [])],
- true, []);
- fdec
- in
- let visitor = (new enumVisitor printfFun.svar ei.statements
- ei.instructions) in
- visitCilFileSameGlobals visitor f;
- f
-end
-
-(**********************************************************************
- * STAGE 2
- *
- * Perform a transitive-closure-like operation on the parts of the program
- * that the user wants to keep. We use a CIL visitor to walk around
- * and a number of hash tables to keep track of the things we want to keep.
- **********************************************************************)
-(*
- * Hashtables:
- * ws - wanted stmts
- * wi - wanted instructions
- * wt - wanted typeinfo
- * wc - wanted compinfo
- * we - wanted enuminfo
- * wv - wanted varinfo
- *)
-
-let mode = ref false (* was our parented wanted? *)
-let finished = ref true (* set to false if we update something *)
-
-(* In the given hashtable, mark the given element was "wanted" *)
-let update ht elt =
- if Hashtbl.mem ht elt && (Hashtbl.find ht elt = true) then ()
- else begin
- Hashtbl.add ht elt true ;
- finished := false
- end
-
-(* Handle a particular stage of the AST tree walk. Use "mode" (i.e.,
- * whether our parent was wanted) and the hashtable (which tells us whether
- * the user had any special instructions for this element) to determine
- * what do to. *)
-let handle ht elt rep =
- if !mode then begin
- if Hashtbl.mem ht elt && (Hashtbl.find ht elt = false) then begin
- (* our parent is Wanted but we were told to ignore this subtree,
- * so we won't be wanted. *)
- mode := false ;
- ChangeDoChildrenPost(rep,(fun elt -> mode := true ; elt))
- end else begin
- (* we were not told to ignore this subtree, and our parent is
- * Wanted, so we will be Wanted too! *)
- update ht elt ;
- DoChildren
- end
- end else if Hashtbl.mem ht elt && (Hashtbl.find ht elt = true) then begin
- (* our parent was not wanted but we were wanted, so turn the
- * mode on for now *)
- mode := true ;
- ChangeDoChildrenPost(rep,(fun elt -> mode := false ; elt))
- end else
- DoChildren
-
-let handle_no_default ht elt rep old_mode =
- if Hashtbl.mem ht elt && (Hashtbl.find ht elt = true) then begin
- (* our parent was not wanted but we were wanted, so turn the
- * mode on for now *)
- mode := true ;
- ChangeDoChildrenPost(rep,(fun elt -> mode := old_mode ; elt))
- end else begin
- mode := false ;
- ChangeDoChildrenPost(rep,(fun elt -> mode := old_mode ; elt))
- end
-
-(*
- * This is the visitor that handles elements (marks them as wanted)
- *)
-class transVisitor ws wi wt wc we wv = object
- inherit nopCilVisitor
-
- method vvdec vi = handle_no_default wv vi vi !mode
- method vvrbl vi = handle wv vi vi
- method vinst i = handle wi i [i]
- method vstmt s = handle ws s s
- method vfunc f = handle wv f.svar f
- method vglob g = begin
- match g with
- | GType(ti,_) -> handle wt ti [g]
- | GCompTag(ci,_)
- | GCompTagDecl(ci,_) -> handle wc ci [g]
- | GEnumTag(ei,_)
- | GEnumTagDecl(ei,_) -> handle we ei [g]
- | GVarDecl(vi,_)
- | GVar(vi,_,_) -> handle wv vi [g]
- | GFun(f,_) -> handle wv f.svar [g]
- | _ -> DoChildren
- end
- method vtype t = begin
- match t with
- | TNamed(ti,_) -> handle wt ti t
- | TComp(ci,_) -> handle wc ci t
- | TEnum(ei,_) -> handle we ei t
- | _ -> DoChildren
- end
-end
-
-(**********************************************************************
- * STAGE 3
- *
- * Eliminate all of the elements from the program that are not marked
- * "keep".
- **********************************************************************)
-(*
- * This is the visitor that throws away elements
- *)
-let handle ht elt keep drop =
- if (Hashtbl.mem ht elt) && (Hashtbl.find ht elt = true) then
- (* DoChildren *) ChangeDoChildrenPost(keep,(fun a -> a))
- else
- ChangeTo(drop)
-
-class dropVisitor ws wi wt wc we wv = object
- inherit nopCilVisitor
-
- method vinst i = handle wi i [i] []
- method vstmt s = handle ws s s (mkStmt (Instr([])))
- method vglob g = begin
- match g with
- | GType(ti,_) -> handle wt ti [g] []
- | GCompTag(ci,_)
- | GCompTagDecl(ci,_) -> handle wc ci [g] []
- | GEnumTag(ei,_)
- | GEnumTagDecl(ei,_) -> handle we ei [g] []
- | GVarDecl(vi,_)
- | GVar(vi,_,_) -> handle wv vi [g] []
- | GFun(f,l) ->
- let new_locals = List.filter (fun vi ->
- Hashtbl.mem wv vi && (Hashtbl.find wv vi = true)) f.slocals in
- let new_fundec = { f with slocals = new_locals} in
- handle wv f.svar [(GFun(new_fundec,l))] []
- | _ -> DoChildren
- end
-end
-
-(**********************************************************************
- * STAGE 1
- *
- * Mark up the file with user-given information about what to keep and
- * what to drop.
- **********************************************************************)
-type mark = Wanted | Unwanted | Unspecified
-(* Given a cil file and a list of strings, mark all of the given ASTSlicer
- * points as wanted or unwanted. *)
-let mark_file (f : Cil.file) (names : (string, mark) Hashtbl.t) =
- let ws = Hashtbl.create 32767 in
- let wi = Hashtbl.create 32767 in
- let wt = Hashtbl.create 32767 in
- let wc = Hashtbl.create 32767 in
- let we = Hashtbl.create 32767 in
- let wv = Hashtbl.create 32767 in
- if !debug then Printf.printf "Applying user marks to file ...\n" ;
- let descend base i =
- let res = (Printf.sprintf "%s.%d" base !i),(ref 0) in
- res
- in
- let check base i (default : mark) =
- let str = Printf.sprintf "%s.%d" base !i in
- if !debug then Printf.printf "Looking for [%s]\n" str ;
- try Hashtbl.find names str
- with _ -> default
- in
- let mark ht stmt wanted = match wanted with
- Unwanted -> Hashtbl.replace ht stmt false
- | Wanted -> Hashtbl.replace ht stmt true
- | Unspecified -> ()
- in
- let rec doBlock b base i default =
- doStmtList b.bstmts base i default
- and doStmtList sl base i default =
- List.iter (fun s -> match s.skind with
- | Instr(il) -> doIL il base i default
- | Return(_,_)
- | Goto(_,_)
- | Continue(_)
- | Break(_) ->
- mark ws s (check base i default) ; incr i
- | If(e,b1,b2,_) ->
- let inside = check base i default in
- mark ws s inside ;
- let base',i' = descend base i in
- doBlock b1 base' i' inside ;
- let base'',i'' = descend base i in
- doBlock b2 base'' i'' inside ;
- incr i
- | Switch(_,b,_,_)
-(*
- | Loop(b,_,_,_)
-*)
- | While(_,b,_)
- | DoWhile(_,b,_)
- | For(_,_,_,b,_)
- | Block(b) ->
- let inside = check base i default in
- mark ws s inside ;
- let base',i' = descend base i in
- doBlock b base' i' inside ;
- incr i
- | TryExcept _ | TryFinally _ ->
- E.s (E.unimp "astslicer: mark")
- ) sl
- and doIL il base i default =
- List.iter (fun ins -> mark wi ins (check base i default) ; incr i) il
- in
- let doGlobal g = match g with
- | GFun(fd,_) ->
- let cur = ref 0 in
- if Hashtbl.mem names fd.svar.vname then begin
- if Hashtbl.find names fd.svar.vname = Wanted then begin
- Hashtbl.replace wv fd.svar true ;
- doBlock fd.sbody fd.svar.vname cur (Wanted);
- end else begin
- Hashtbl.replace wv fd.svar false ;
- doBlock fd.sbody fd.svar.vname cur (Unspecified);
- end
- end else begin
- doBlock fd.sbody fd.svar.vname cur (Unspecified);
- end
- | _ -> ()
- in
- List.iter doGlobal f.globals ;
- if !debug then begin
- Hashtbl.iter (fun k v ->
- ignore (Pretty.printf "want-s %b %a\n" v d_stmt k)) ws ;
- Hashtbl.iter (fun k v ->
- ignore (Pretty.printf "want-i %b %a\n" v d_instr k)) wi ;
- Hashtbl.iter (fun k v ->
- ignore (Pretty.printf "want-v %b %s\n" v k.vname)) wv ;
- end ;
- (*
- * Now repeatedly mark all other things that must be kept.
- *)
- let visitor = (new transVisitor ws wi wt wc we wv) in
- finished := false ;
- if !debug then (Printf.printf "\nPerforming Transitive Closure\n\n" );
- while not !finished do
- finished := true ;
- visitCilFileSameGlobals visitor f
- done ;
- if !debug then begin
- Hashtbl.iter (fun k v ->
- if v then ignore (Pretty.printf "want-s %a\n" d_stmt k)) ws ;
- Hashtbl.iter (fun k v ->
- if v then ignore (Pretty.printf "want-i %a\n" d_instr k)) wi ;
- Hashtbl.iter (fun k v ->
- if v then ignore (Pretty.printf "want-t %s\n" k.tname)) wt ;
- Hashtbl.iter (fun k v ->
- if v then ignore (Pretty.printf "want-c %s\n" k.cname)) wc ;
- Hashtbl.iter (fun k v ->
- if v then ignore (Pretty.printf "want-e %s\n" k.ename)) we ;
- Hashtbl.iter (fun k v ->
- if v then ignore (Pretty.printf "want-v %s\n" k.vname)) wv ;
- end ;
-
- (*
- * Now drop everything we didn't need.
- *)
- if !debug then (Printf.printf "Dropping Unwanted Elements\n" );
- let visitor = (new dropVisitor ws wi wt wc we wv) in
- visitCilFile visitor f
diff --git a/cil/src/ext/availexps.ml b/cil/src/ext/availexps.ml
deleted file mode 100644
index 28c22c0e713c2b7bee51fbeb52590c9edf0f3083..0000000000000000000000000000000000000000
--- a/cil/src/ext/availexps.ml
+++ /dev/null
@@ -1,359 +0,0 @@
-(* compute available expressions, although in a somewhat
- non-traditional way. the abstract state is a mapping from
- variable ids to expressions as opposed to a set of
- expressions *)
-
-open Cil
-open Pretty
-
-module E = Errormsg
-module DF = Dataflow
-module UD = Usedef
-module IH = Inthash
-module U = Util
-module S = Stats
-
-let debug = ref false
-
-(* exp IH.t -> exp IH.t -> bool *)
-let eh_equals eh1 eh2 =
- if not(IH.length eh1 = IH.length eh2)
- then false
- else IH.fold (fun vid e b ->
- if not b then b else
- try let e2 = IH.find eh2 vid in
- if not(Util.equals e e2)
- then false
- else true
- with Not_found -> false)
- eh1 true
-
-let eh_pretty () eh = line ++ seq line (fun (vid,e) ->
- text "AE:vid:" ++ num vid ++ text ": " ++
- (d_exp () e)) (IH.tolist eh)
-
-(* the result must be the intersection of eh1 and eh2 *)
-(* exp IH.t -> exp IH.t -> exp IH.t *)
-let eh_combine eh1 eh2 =
- if !debug then ignore(E.log "eh_combine: combining %a\n and\n %a\n"
- eh_pretty eh1 eh_pretty eh2);
- let eh' = IH.copy eh1 in (* eh' gets all of eh1 *)
- IH.iter (fun vid e1 ->
- try let e2l = IH.find_all eh2 vid in
- if not(List.exists (fun e2 -> Util.equals e1 e2) e2l)
- (* remove things from eh' that eh2 doesn't have *)
- then let e1l = IH.find_all eh' vid in
- let e1l' = List.filter (fun e -> not(Util.equals e e1)) e1l in
- IH.remove_all eh' vid;
- List.iter (fun e -> IH.add eh' vid e) e1l'
- with Not_found ->
- IH.remove_all eh' vid) eh1;
- if !debug then ignore(E.log "with result %a\n"
- eh_pretty eh');
- eh'
-
-(* On a memory write, kill expressions containing memory writes
- * or variables whose address has been taken. *)
-let exp_ok = ref false
-class memReadOrAddrOfFinderClass = object(self)
- inherit nopCilVisitor
-
- method vexpr e = match e with
- Lval(Mem _, _) ->
- exp_ok := true;
- SkipChildren
- | _ -> DoChildren
-
- method vvrbl vi =
- if vi.vaddrof then
- (exp_ok := true;
- SkipChildren)
- else DoChildren
-
-end
-
-let memReadOrAddrOfFinder = new memReadOrAddrOfFinderClass
-
-(* exp -> bool *)
-let exp_has_mem_read e =
- exp_ok := false;
- ignore(visitCilExpr memReadOrAddrOfFinder e);
- !exp_ok
-
-let eh_kill_mem eh =
- IH.iter (fun vid e ->
- if exp_has_mem_read e
- then IH.remove eh vid)
- eh
-
-(* need to kill exps containing a particular vi sometimes *)
-let has_vi = ref false
-class viFinderClass vi = object(self)
- inherit nopCilVisitor
-
- method vvrbl vi' =
- if vi.vid = vi'.vid
- then (has_vi := true; SkipChildren)
- else DoChildren
-
-end
-
-let exp_has_vi e vi =
- let vis = new viFinderClass vi in
- has_vi := false;
- ignore(visitCilExpr vis e);
- !has_vi
-
-let eh_kill_vi eh vi =
- IH.iter (fun vid e ->
- if exp_has_vi e vi
- then IH.remove eh vid)
- eh
-
-let varHash = IH.create 32
-
-let eh_kill_addrof_or_global eh =
- if !debug then ignore(E.log "eh_kill: in eh_kill\n");
- IH.iter (fun vid e ->
- try let vi = IH.find varHash vid in
- if vi.vaddrof
- then begin
- if !debug then ignore(E.log "eh_kill: %s has its address taken\n"
- vi.vname);
- IH.remove eh vid
- end
- else if vi.vglob
- then begin
- if !debug then ignore(E.log "eh_kill: %s is global\n"
- vi.vname);
- IH.remove eh vid
- end
- with Not_found -> ()) eh
-
-let eh_handle_inst i eh = match i with
- (* if a pointer write, kill things with read in them.
- also kill mappings from vars that have had their address taken,
- and globals.
- otherwise kill things with lv in them and add e *)
- Set(lv,e,_) -> (match lv with
- (Mem _, _) ->
- (eh_kill_mem eh;
- eh_kill_addrof_or_global eh;
- eh)
- | (Var vi, NoOffset) ->
- (match e with
- Lval(Var vi', NoOffset) -> (* ignore x = x *)
- if vi'.vid = vi.vid then eh else
- (IH.replace eh vi.vid e;
- eh_kill_vi eh vi;
- eh)
- | _ ->
- (IH.replace eh vi.vid e;
- eh_kill_vi eh vi;
- eh))
- | _ -> eh) (* do nothing for now. *)
-| Call(Some(Var vi,NoOffset),_,_,_) ->
- (IH.remove eh vi.vid;
- eh_kill_vi eh vi;
- eh_kill_mem eh;
- eh_kill_addrof_or_global eh;
- eh)
-| Call(_,_,_,_) ->
- (eh_kill_mem eh;
- eh_kill_addrof_or_global eh;
- eh)
-| Asm(_,_,_,_,_,_) ->
- let _,d = UD.computeUseDefInstr i in
- (UD.VS.iter (fun vi ->
- eh_kill_vi eh vi) d;
- eh)
-
-let allExpHash = IH.create 128
-
-module AvailableExps =
- struct
-
- let name = "Available Expressions"
-
- let debug = debug
-
- (* mapping from var id to expression *)
- type t = exp IH.t
-
- let copy = IH.copy
-
- let stmtStartData = IH.create 64
-
- let pretty = eh_pretty
-
- let computeFirstPredecessor stm eh =
- eh_combine (IH.copy allExpHash) eh
-
- let combinePredecessors (stm:stmt) ~(old:t) (eh:t) =
- if S.time "eh_equals" (eh_equals old) eh then None else
- Some(S.time "eh_combine" (eh_combine old) eh)
-
- let doInstr i eh =
- let action = eh_handle_inst i in
- DF.Post(action)
-
- let doStmt stm astate = DF.SDefault
-
- let doGuard c astate = DF.GDefault
-
- let filterStmt stm = true
-
- end
-
-module AE = DF.ForwardsDataFlow(AvailableExps)
-
-(* make an exp IH.t with everything in it,
- * also, fill in varHash while we're here.
- *)
-class expCollectorClass = object(self)
- inherit nopCilVisitor
-
- method vinst i = match i with
- Set((Var vi,NoOffset),e,_) ->
- let e2l = IH.find_all allExpHash vi.vid in
- if not(List.exists (fun e2 -> Util.equals e e2) e2l)
- then IH.add allExpHash vi.vid e;
- DoChildren
- | _ -> DoChildren
-
- method vvrbl vi =
- (if not(IH.mem varHash vi.vid)
- then
- (if !debug && vi.vglob then ignore(E.log "%s is global\n" vi.vname);
- if !debug && not(vi.vglob) then ignore(E.log "%s is not global\n" vi.vname);
- IH.add varHash vi.vid vi));
- DoChildren
-
-end
-
-let expCollector = new expCollectorClass
-
-let make_all_exps fd =
- IH.clear allExpHash;
- IH.clear varHash;
- ignore(visitCilFunction expCollector fd)
-
-
-
-(* set all statement data to allExpHash, make
- * a list of statements
- *)
-let all_stmts = ref []
-class allExpSetterClass = object(self)
- inherit nopCilVisitor
-
- method vstmt s =
- all_stmts := s :: (!all_stmts);
- IH.add AvailableExps.stmtStartData s.sid (IH.copy allExpHash);
- DoChildren
-
-end
-
-let allExpSetter = new allExpSetterClass
-
-let set_all_exps fd =
- IH.clear AvailableExps.stmtStartData;
- ignore(visitCilFunction allExpSetter fd)
-
-(*
- * Computes AEs for function fd.
- *
- *
- *)
-(*let iAEsHtbl = Hashtbl.create 128*)
-let computeAEs fd =
- try let slst = fd.sbody.bstmts in
- let first_stm = List.hd slst in
- S.time "make_all_exps" make_all_exps fd;
- all_stmts := [];
- (*S.time "set_all_exps" set_all_exps fd;*)
- (*Hashtbl.clear iAEsHtbl;*)
- (*IH.clear (IH.find AvailableExps.stmtStartData first_stm.sid);*)
- IH.add AvailableExps.stmtStartData first_stm.sid (IH.create 4);
- S.time "compute" AE.compute [first_stm](*(List.rev !all_stmts)*)
- with Failure "hd" -> if !debug then ignore(E.log "fn w/ no stmts?\n")
- | Not_found -> if !debug then ignore(E.log "no data for first_stm?\n")
-
-
-(* get the AE data for a statement *)
-let getAEs sid =
- try Some(IH.find AvailableExps.stmtStartData sid)
- with Not_found -> None
-
-(* get the AE data for an instruction list *)
-let instrAEs il sid eh out =
- (*if Hashtbl.mem iAEsHtbl (sid,out)
- then Hashtbl.find iAEsHtbl (sid,out)
- else*)
- let proc_one hil i =
- match hil with
- [] -> let eh' = IH.copy eh in
- let eh'' = eh_handle_inst i eh' in
- (*if !debug then ignore(E.log "instrAEs: proc_one []: for %a\n data is %a\n"
- d_instr i eh_pretty eh'');*)
- eh''::hil
- | eh'::ehrst as l ->
- let eh' = IH.copy eh' in
- let eh'' = eh_handle_inst i eh' in
- (*if !debug then ignore(E.log "instrAEs: proc_one: for %a\n data is %a\n"
- d_instr i eh_pretty eh'');*)
- eh''::l
- in
- let folded = List.fold_left proc_one [eh] il in
- (*let foldedout = List.tl (List.rev folded) in*)
- let foldednotout = List.rev (List.tl folded) in
- (*Hashtbl.add iAEsHtbl (sid,true) foldedout;
- Hashtbl.add iAEsHtbl (sid,false) foldednotout;*)
- (*if out then foldedout else*) foldednotout
-
-class aeVisitorClass = object(self)
- inherit nopCilVisitor
-
- val mutable sid = -1
-
- val mutable ae_dat_lst = []
-
- val mutable cur_ae_dat = None
-
- method vstmt stm =
- sid <- stm.sid;
- match getAEs sid with
- None ->
- if !debug then ignore(E.log "aeVis: stm %d has no data\n" sid);
- cur_ae_dat <- None;
- DoChildren
- | Some eh ->
- match stm.skind with
- Instr il ->
- if !debug then ignore(E.log "aeVist: visit il\n");
- ae_dat_lst <- S.time "instrAEs" (instrAEs il stm.sid eh) false;
- DoChildren
- | _ ->
- if !debug then ignore(E.log "aeVisit: visit non-il\n");
- cur_ae_dat <- None;
- DoChildren
-
- method vinst i =
- if !debug then ignore(E.log "aeVist: before %a, ae_dat_lst is %d long\n"
- d_instr i (List.length ae_dat_lst));
- try
- let data = List.hd ae_dat_lst in
- cur_ae_dat <- Some(data);
- ae_dat_lst <- List.tl ae_dat_lst;
- if !debug then ignore(E.log "aeVisit: data is %a\n" eh_pretty data);
- DoChildren
- with Failure "hd" ->
- if !debug then ignore(E.log "aeVis: il ae_dat_lst mismatch\n");
- DoChildren
-
- method get_cur_eh () =
- match cur_ae_dat with
- None -> getAEs sid
- | Some eh -> Some eh
-
-end
diff --git a/cil/src/ext/bitmap.ml b/cil/src/ext/bitmap.ml
deleted file mode 100644
index da1f8b99c24cf799c8b5a84dca321843885f997e..0000000000000000000000000000000000000000
--- a/cil/src/ext/bitmap.ml
+++ /dev/null
@@ -1,224 +0,0 @@
-
- (* Imperative bitmaps *)
-type t = { mutable nrWords : int;
- mutable nrBits : int; (* This is 31 * nrWords *)
- mutable bitmap : int array }
-
-
- (* Enlarge a bitmap to contain at
- * least newBits *)
-let enlarge b newWords =
- let newbitmap =
- if newWords > b.nrWords then
- let a = Array.create newWords 0 in
- Array.blit b.bitmap 0 a 0 b.nrWords;
- a
- else
- b.bitmap in
- b.nrWords <- newWords;
- b.nrBits <- (newWords lsl 5) - newWords;
- b.bitmap <- newbitmap
-
-
- (* Create a new empty bitmap *)
-let make size =
- let wrd = (size + 30) / 31 in
- { nrWords = wrd;
- nrBits = (wrd lsl 5) - wrd;
- bitmap = Array.make wrd 0
- }
-
-let size t = t.nrBits
- (* Make an initialized array *)
-let init size how =
- let wrd = (size + 30) / 31 in
- let how' w =
- let first = (w lsl 5) - w in
- let last = min size (first + 31) in
- let rec loop i acc =
- if i >= last then acc
- else
- let acc' = acc lsl 1 in
- if how i then loop (i + 1) (acc' lor 1)
- else loop (i + 1) acc'
- in
- loop first 0
- in
- { nrWords = wrd;
- nrBits = (wrd lsl 5) - wrd;
- bitmap = Array.init wrd how'
- }
-
-let clone b =
- { nrWords = b.nrWords;
- nrBits = b.nrBits;
- bitmap = Array.copy b.bitmap;
- }
-
-let cloneEmpty b =
- { nrWords = b.nrWords;
- nrBits = b.nrBits;
- bitmap = Array.make b.nrWords 0;
- }
-
-let union b1 b2 =
- begin
- let n = b2.nrWords in
- if b1.nrWords < n then enlarge b1 n else ();
- let a1 = b1.bitmap in
- let a2 = b2.bitmap in
- let changed = ref false in
- for i=0 to n - 1 do
- begin
- let t = a1.(i) in
- let upd = t lor a2.(i) in
- let _ = if upd <> t then changed := true else () in
- Array.unsafe_set a1 i upd
- end
- done;
- ! changed
- end
- (* lin += (lout - def) *)
-let accLive lin lout def =
- begin (* Need to enlarge def to lout *)
- let n = lout.nrWords in
- if def.nrWords < n then enlarge def n else ();
- (* Need to enlarge lin to lout *)
- if lin.nrWords < n then enlarge lin n else ();
- let changed = ref false in
- let alin = lin.bitmap in
- let alout = lout.bitmap in
- let adef = def.bitmap in
- for i=0 to n - 1 do
- begin
- let old = alin.(i) in
- let nw = old lor (alout.(i) land (lnot adef.(i))) in
- alin.(i) <- nw;
- changed := (old <> nw) || (!changed)
- end
- done;
- !changed
- end
-
- (* b1 *= b2 *)
-let inters b1 b2 =
- begin
- let n = min b1.nrWords b2.nrWords in
- let a1 = b1.bitmap in
- let a2 = b2.bitmap in
- for i=0 to n - 1 do
- begin
- a1.(i) <- a1.(i) land a2.(i)
- end
- done;
- if n < b1.nrWords then
- Array.fill a1 n (b1.nrWords - n) 0
- else
- ()
- end
-
-let emptyInt b start =
- let n = b.nrWords in
- let a = b.bitmap in
- let rec loop i = i >= n || (a.(i) = 0 && loop (i + 1))
- in
- loop start
-
-let empty b = emptyInt b 0
-
- (* b1 =? b2 *)
-let equal b1 b2 =
- begin
- let n = min b1.nrWords b2.nrWords in
- let a1 = b1.bitmap in
- let a2 = b2.bitmap in
- let res = ref true in
- for i=0 to n - 1 do
- begin
- if a1.(i) != a2.(i) then res := false else ()
- end
- done;
- if !res then
- if b1.nrWords > n then
- emptyInt b1 n
- else if b2.nrWords > n then
- emptyInt b2 n
- else
- true
- else
- false
- end
-
-let assign b1 b2 =
- begin
- let n = b2.nrWords in
- if b1.nrWords < n then enlarge b1 n else ();
- let a1 = b1.bitmap in
- let a2 = b2.bitmap in
- Array.blit a2 0 a1 0 n
- end
-
- (* b1 -= b2 *)
-let diff b1 b2 =
- begin
- let n = min b1.nrWords b2.nrWords in
- let a1 = b1.bitmap in
- let a2 = b2.bitmap in
- for i=0 to n - 1 do
- a1.(i) <- a1.(i) land (lnot a2.(i))
- done;
- if n < b1.nrWords then
- Array.fill a1 n (b1.nrWords - n) 0
- else
- ()
- end
-
-
-
-
-let get bmp i =
- assert (i >= 0);
- if i >= bmp.nrBits then enlarge bmp (i / 31 + 1) else ();
- let wrd = i / 31 in
- let msk = 1 lsl (i + wrd - (wrd lsl 5)) in
- bmp.bitmap.(wrd) land msk != 0
-
-
-let set bmp i tv =
- assert(i >= 0);
- let wrd = i / 31 in
- let msk = 1 lsl (i + wrd - (wrd lsl 5)) in
- if i >= bmp.nrBits then enlarge bmp (wrd + 1) else ();
- if tv then
- bmp.bitmap.(wrd) <- bmp.bitmap.(wrd) lor msk
- else
- bmp.bitmap.(wrd) <- bmp.bitmap.(wrd) land (lnot msk)
-
-
-
- (* Iterate over all elements in a
- * bitmap *)
-let fold f bmp arg =
- let a = bmp.bitmap in
- let n = bmp.nrWords in
- let rec allWords i bit arg =
- if i >= n then
- arg
- else
- let rec allBits msk bit left arg =
- if left = 0 then
- allWords (i + 1) bit arg
- else
- allBits ((lsr) msk 1) (bit + 1) (left - 1)
- (if (land) msk 1 != 0 then f arg bit else arg)
- in
- allBits a.(i) bit 31 arg
- in
- allWords 0 0 arg
-
-
-let iter f t = fold (fun x y -> f y) t ()
-
-let toList bmp = fold (fun acc i -> i :: acc) bmp []
-
-let card bmp = fold (fun acc _ -> acc + 1) bmp 0
diff --git a/cil/src/ext/bitmap.mli b/cil/src/ext/bitmap.mli
deleted file mode 100644
index 5247e35d31374b99a1093ec9170ddb25ee15246e..0000000000000000000000000000000000000000
--- a/cil/src/ext/bitmap.mli
+++ /dev/null
@@ -1,50 +0,0 @@
-
- (* Imperative bitmaps *)
-
-type t
- (* Create a bitmap given the number
- * of bits *)
-val make : int -> t
-val init : int -> (int -> bool) -> t (* Also initialize it *)
-
-val size : t -> int (* How much space it is reserved *)
-
- (* The cardinality of a set *)
-val card : t -> int
-
- (* Make a copy of a bitmap *)
-val clone : t -> t
-
-val cloneEmpty : t -> t (* An empty set with the same
- * dimentions *)
-
-val set : t -> int -> bool -> unit
-val get : t -> int -> bool
- (* destructive union. The first
- * element is updated. Returns true
- * if any change was actually
- * necessary *)
-val union : t -> t -> bool
-
- (* accLive livein liveout def. Does
- * liveIn += (liveout - def) *)
-val accLive : t -> t -> t -> bool
-
- (* Copy the second argument onto the
- * first *)
-val assign : t -> t -> unit
-
-
-val inters : t -> t -> unit
-val diff : t -> t -> unit
-
-
-val empty : t -> bool
-
-val equal : t -> t -> bool
-
-val toList : t -> int list
-
-val iter : (int -> unit) -> t -> unit
-val fold : ('a -> int -> 'a) -> t -> 'a -> 'a
-
diff --git a/cil/src/ext/blockinggraph.ml b/cil/src/ext/blockinggraph.ml
deleted file mode 100644
index 281678ae04fccd9f7ae6ce7d0699ccb391c8baf8..0000000000000000000000000000000000000000
--- a/cil/src/ext/blockinggraph.ml
+++ /dev/null
@@ -1,769 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-open Cil
-open Pretty
-module E = Errormsg
-
-let debug = false
-
-let fingerprintAll = true
-
-
-type blockkind =
- NoBlock
- | BlockTrans
- | BlockPoint
- | EndPoint
-
-(* For each function we have a node *)
-type node =
-{
- nodeid: int;
- name: string;
- mutable scanned: bool;
- mutable expand: bool;
- mutable fptr: bool;
- mutable stacksize: int;
- mutable fds: fundec option;
- mutable bkind: blockkind;
- mutable origkind: blockkind;
- mutable preds: node list;
- mutable succs: node list;
- mutable predstmts: (stmt * node) list;
-}
-
-type blockpt =
-{
- id: int;
- point: stmt;
- callfun: string;
- infun: string;
- mutable leadsto: blockpt list;
-}
-
-
-(* Fresh ids for each node. *)
-let curNodeNum : int ref = ref 0
-let getFreshNodeNum () : int =
- let num = !curNodeNum in
- incr curNodeNum;
- num
-
-(* Initialize a node. *)
-let newNode (name: string) (fptr: bool) (mangle: bool) : node =
- let id = getFreshNodeNum () in
- { nodeid = id; name = if mangle then name ^ (string_of_int id) else name;
- scanned = false; expand = false;
- fptr = fptr; stacksize = 0; fds = None;
- bkind = NoBlock; origkind = NoBlock;
- preds = []; succs = []; predstmts = []; }
-
-
-(* My type signature ignores attributes and function pointers. *)
-let myTypeSig (t: typ) : typsig =
- let rec removeFunPtrs (ts: typsig) : typsig =
- match ts with
- TSPtr (TSFun _, a) ->
- TSPtr (TSBase voidType, a)
- | TSPtr (base, a) ->
- TSPtr (removeFunPtrs base, a)
- | TSArray (base, e, a) ->
- TSArray (removeFunPtrs base, e, a)
- | TSFun (ret, args, v, a) ->
- TSFun (removeFunPtrs ret, List.map removeFunPtrs args, v, a)
- | _ -> ts
- in
- removeFunPtrs (typeSigWithAttrs (fun _ -> []) t)
-
-
-(* We add a dummy function whose name is "@@functionPointer@@" that is called
- * at all invocations of function pointers and itself calls all functions
- * whose address is taken. *)
-let functionPointerName = "@@functionPointer@@"
-
-(* We map names to nodes *)
-let functionNodes: (string, node) Hashtbl.t = Hashtbl.create 113
-let getFunctionNode (n: string) : node =
- Util.memoize
- functionNodes
- n
- (fun _ -> newNode n false false)
-
-(* We map types to nodes for function pointers *)
-let functionPtrNodes: (typsig, node) Hashtbl.t = Hashtbl.create 113
-let getFunctionPtrNode (t: typ) : node =
- Util.memoize
- functionPtrNodes
- (myTypeSig t)
- (fun _ -> newNode functionPointerName true true)
-
-let startNode: node = newNode "@@startNode@@" true false
-
-
-(*
-(** Dump the function call graph. *)
-let dumpFunctionCallGraph (start: node) =
- Hashtbl.iter (fun _ x -> x.scanned <- false) functionNodes;
- let rec dumpOneNode (ind: int) (n: node) : unit =
- output_string !E.logChannel "\n";
- for i = 0 to ind do
- output_string !E.logChannel " "
- done;
- output_string !E.logChannel (n.name ^ " ");
- begin
- match n.bkind with
- NoBlock -> ()
- | BlockTrans -> output_string !E.logChannel " <blocks>"
- | BlockPoint -> output_string !E.logChannel " <blockpt>"
- | EndPoint -> output_string !E.logChannel " <endpt>"
- end;
- if n.scanned then (* Already dumped *)
- output_string !E.logChannel " <rec> "
- else begin
- n.scanned <- true;
- List.iter (fun n -> if n.bkind <> EndPoint then dumpOneNode (ind + 1) n)
- n.succs
- end
- in
- dumpOneNode 0 start;
- output_string !E.logChannel "\n\n"
-*)
-
-let dumpFunctionCallGraphToFile () =
- let channel = open_out "graph" in
- let dumpNode _ (n: node) : unit =
- let first = ref true in
- let dumpSucc (n: node) : unit =
- if !first then
- first := false
- else
- output_string channel ",";
- output_string channel n.name
- in
- output_string channel (string_of_int n.nodeid);
- output_string channel ":";
- output_string channel (string_of_int n.stacksize);
- output_string channel ":";
- if n.fds = None && not n.fptr then
- output_string channel "x";
- output_string channel ":";
- output_string channel n.name;
- output_string channel ":";
- List.iter dumpSucc n.succs;
- output_string channel "\n";
- in
- dumpNode () startNode;
- Hashtbl.iter dumpNode functionNodes;
- Hashtbl.iter dumpNode functionPtrNodes;
- close_out channel
-
-
-let addCall (callerNode: node) (calleeNode: node) (sopt: stmt option) =
- if not (List.exists (fun n -> n.name = calleeNode.name)
- callerNode.succs) then begin
- if debug then
- ignore (E.log "found call from %s to %s\n"
- callerNode.name calleeNode.name);
- callerNode.succs <- calleeNode :: callerNode.succs;
- calleeNode.preds <- callerNode :: calleeNode.preds;
- end;
- match sopt with
- Some s ->
- if not (List.exists (fun (s', _) -> s' = s) calleeNode.predstmts) then
- calleeNode.predstmts <- (s, callerNode) :: calleeNode.predstmts
- | None -> ()
-
-
-class findCallsVisitor (host: node) : cilVisitor = object
- inherit nopCilVisitor
-
- val mutable curStmt : stmt ref = ref (mkEmptyStmt ())
-
- method vstmt s =
- curStmt := s;
- DoChildren
-
- method vinst i =
- match i with
- | Call(_,Lval(Var(vi),NoOffset),args,l) ->
- addCall host (getFunctionNode vi.vname) (Some !curStmt);
- SkipChildren
-
- | Call(_,e,_,l) -> (* Calling a function pointer *)
- addCall host (getFunctionPtrNode (typeOf e)) (Some !curStmt);
- SkipChildren
-
- | _ -> SkipChildren (* No calls in other instructions *)
-
- (* There are no calls in expressions and types *)
- method vexpr e = SkipChildren
- method vtype t = SkipChildren
-
-end
-
-
-let endPt = { id = 0; point = mkEmptyStmt (); callfun = "end"; infun = "end";
- leadsto = []; }
-
-(* These values will be initialized for real in makeBlockingGraph. *)
-let curId : int ref = ref 1
-let startName : string ref = ref ""
-let blockingPoints : blockpt list ref = ref []
-let blockingPointsNew : blockpt Queue.t = Queue.create ()
-let blockingPointsHash : (int, blockpt) Hashtbl.t = Hashtbl.create 113
-
-let getFreshNum () : int =
- let num = !curId in
- curId := !curId + 1;
- num
-
-let getBlockPt (s: stmt) (cfun: string) (ifun: string) : blockpt =
- try
- Hashtbl.find blockingPointsHash s.sid
- with Not_found ->
- let num = getFreshNum () in
- let bpt = { id = num; point = s; callfun = cfun; infun = ifun;
- leadsto = []; } in
- Hashtbl.add blockingPointsHash s.sid bpt;
- blockingPoints := bpt :: !blockingPoints;
- Queue.add bpt blockingPointsNew;
- bpt
-
-
-type action =
- Process of stmt * node
- | Next of stmt * node
- | Return of node
-
-let getStmtNode (s: stmt) : node option =
- match s.skind with
- Instr instrs -> begin
- let len = List.length instrs in
- if len > 0 then
- match List.nth instrs (len - 1) with
- Call (_, Lval (Var vi, NoOffset), args, _) ->
- Some (getFunctionNode vi.vname)
- | Call (_, e, _, _) -> (* Calling a function pointer *)
- Some (getFunctionPtrNode (typeOf e))
- | _ ->
- None
- else
- None
- end
- | _ -> None
-
-let addBlockingPointEdge (bptFrom: blockpt) (bptTo: blockpt) : unit =
- if not (List.exists (fun bpt -> bpt = bptTo) bptFrom.leadsto) then
- bptFrom.leadsto <- bptTo :: bptFrom.leadsto
-
-let findBlockingPointEdges (bpt: blockpt) : unit =
- let seenStmts = Hashtbl.create 117 in
- let worklist = Queue.create () in
- Queue.add (Next (bpt.point, getFunctionNode bpt.infun)) worklist;
- while Queue.length worklist > 0 do
- let act = Queue.take worklist in
- match act with
- Process (curStmt, curNode) -> begin
- Hashtbl.add seenStmts curStmt.sid ();
- match getStmtNode curStmt with
- Some node -> begin
- if debug then
- ignore (E.log "processing node %s\n" node.name);
- match node.bkind with
- NoBlock ->
- Queue.add (Next (curStmt, curNode)) worklist
- | BlockTrans -> begin
- let processFundec (fd: fundec) : unit =
- let s = List.hd fd.sbody.bstmts in
- if not (Hashtbl.mem seenStmts s.sid) then
- let n = getFunctionNode fd.svar.vname in
- Queue.add (Process (s, n)) worklist
- in
- match node.fds with
- Some fd ->
- processFundec fd
- | None ->
- List.iter
- (fun n ->
- match n.fds with
- Some fd -> processFundec fd
- | None -> E.s (bug "expected fundec"))
- node.succs
- end
- | BlockPoint ->
- addBlockingPointEdge bpt
- (getBlockPt curStmt node.name curNode.name)
- | EndPoint ->
- addBlockingPointEdge bpt endPt
- end
- | _ ->
- Queue.add (Next (curStmt, curNode)) worklist
- end
- | Next (curStmt, curNode) -> begin
- match curStmt.Cil.succs with
- [] ->
- if debug then
- ignore (E.log "hit end of %s\n" curNode.name);
- Queue.add (Return curNode) worklist
- | _ ->
- List.iter (fun s ->
- if not (Hashtbl.mem seenStmts s.sid) then
- Queue.add (Process (s, curNode)) worklist)
- curStmt.Cil.succs
- end
- | Return curNode when curNode.bkind = NoBlock ->
- ()
- | Return curNode when curNode.name = !startName ->
- addBlockingPointEdge bpt endPt
- | Return curNode ->
- List.iter (fun (s, n) -> if n.bkind <> NoBlock then
- Queue.add (Next (s, n)) worklist)
- curNode.predstmts;
- List.iter (fun n -> if n.fptr then
- Queue.add (Return n) worklist)
- curNode.preds
- done
-
-let markYieldPoints (n: node) : unit =
- let rec markNode (n: node) : unit =
- if n.bkind = NoBlock then
- match n.origkind with
- BlockTrans ->
- if n.expand || n.fptr then begin
- n.bkind <- BlockTrans;
- List.iter markNode n.succs
- end else begin
- n.bkind <- BlockPoint
- end
- | _ ->
- n.bkind <- n.origkind
- in
- Hashtbl.iter (fun _ n -> n.bkind <- NoBlock) functionNodes;
- Hashtbl.iter (fun _ n -> n.bkind <- NoBlock) functionPtrNodes;
- markNode n
-
-let makeBlockingGraph (start: node) =
- let startStmt =
- match start.fds with
- Some fd -> List.hd fd.sbody.bstmts
- | None -> E.s (bug "expected fundec")
- in
- curId := 1;
- startName := start.name;
- blockingPoints := [endPt];
- Queue.clear blockingPointsNew;
- Hashtbl.clear blockingPointsHash;
- ignore (getBlockPt startStmt start.name start.name);
- while Queue.length blockingPointsNew > 0 do
- let bpt = Queue.take blockingPointsNew in
- findBlockingPointEdges bpt;
- done
-
-let dumpBlockingGraph () =
- List.iter
- (fun bpt ->
- if bpt.id < 2 then begin
- ignore (E.log "bpt %d (%s): " bpt.id bpt.callfun)
- end else begin
- ignore (E.log "bpt %d (%s in %s): " bpt.id bpt.callfun bpt.infun)
- end;
- List.iter (fun bpt -> ignore (E.log "%d " bpt.id)) bpt.leadsto;
- ignore (E.log "\n"))
- !blockingPoints;
- ignore (E.log "\n")
-
-let beforeFun =
- makeGlobalVar "before_bg_node"
- (TFun (voidType, Some [("node_idx", intType, []);
- ("num_edges", intType, [])],
- false, []))
-
-let initFun =
- makeGlobalVar "init_blocking_graph"
- (TFun (voidType, Some [("num_nodes", intType, [])],
- false, []))
-
-let fingerprintVar =
- let vi = makeGlobalVar "stack_fingerprint" intType in
- vi.vstorage <- Extern;
- vi
-
-let startNodeAddrs =
- let vi = makeGlobalVar "start_node_addrs" (TPtr (voidPtrType, [])) in
- vi.vstorage <- Extern;
- vi
-
-let startNodeStacks =
- let vi = makeGlobalVar "start_node_stacks" (TPtr (intType, [])) in
- vi.vstorage <- Extern;
- vi
-
-let startNodeAddrsArray =
- makeGlobalVar "start_node_addrs_array" (TArray (voidPtrType, None, []))
-
-let startNodeStacksArray =
- makeGlobalVar "start_node_stacks_array" (TArray (intType, None, []))
-
-let insertInstr (newInstr: instr) (s: stmt) : unit =
- match s.skind with
- Instr instrs ->
- let rec insert (instrs: instr list) : instr list =
- match instrs with
- [] -> E.s (bug "instr list does not end with call\n")
- | [Call _] -> newInstr :: instrs
- | i :: rest -> i :: (insert rest)
- in
- s.skind <- Instr (insert instrs)
- | _ ->
- E.s (bug "instr stmt expected\n")
-
-let instrumentBlockingPoints () =
- List.iter
- (fun bpt ->
- if bpt.id > 1 then
- let arg1 = integer bpt.id in
- let arg2 = integer (List.length bpt.leadsto) in
- let call = Call (None, Lval (var beforeFun),
- [arg1; arg2], locUnknown) in
- insertInstr call bpt.point;
- addCall (getFunctionNode bpt.infun)
- (getFunctionNode beforeFun.vname) None)
- !blockingPoints
-
-
-let startNodes : node list ref = ref []
-
-let makeAndDumpBlockingGraphs () : unit =
- if List.length !startNodes > 1 then
- E.s (unimp "We can't handle more than one start node right now.\n");
- List.iter
- (fun n ->
- markYieldPoints n;
- (*dumpFunctionCallGraph n;*)
- makeBlockingGraph n;
- dumpBlockingGraph ();
- instrumentBlockingPoints ())
- !startNodes
-
-
-let pragmas : (string, int) Hashtbl.t = Hashtbl.create 13
-
-let gatherPragmas (f: file) : unit =
- List.iter
- (function
- GPragma (Attr ("stacksize", [AStr s; AInt n]), _) ->
- Hashtbl.add pragmas s n
- | _ -> ())
- f.globals
-
-
-let blockingNodes : node list ref = ref []
-
-let markBlockingFunctions () : unit =
- let rec markFunction (n: node) : unit =
- if debug then
- ignore (E.log "marking %s\n" n.name);
- if n.origkind = NoBlock then begin
- n.origkind <- BlockTrans;
- List.iter markFunction n.preds;
- end
- in
- List.iter (fun n -> List.iter markFunction n.preds) !blockingNodes
-
-let hasFunctionTypeAttribute (n: string) (t: typ) : bool =
- let _, _, _, a = splitFunctionType t in
- hasAttribute n a
-
-let markVar (vi: varinfo) : unit =
- let node = getFunctionNode vi.vname in
- if node.origkind = NoBlock then begin
- if hasAttribute "yield" vi.vattr then begin
- node.origkind <- BlockPoint;
- blockingNodes := node :: !blockingNodes;
- end else if hasFunctionTypeAttribute "noreturn" vi.vtype then begin
- node.origkind <- EndPoint;
- end else if hasAttribute "expand" vi.vattr then begin
- node.expand <- true;
- end
- end;
- begin
- try
- node.stacksize <- Hashtbl.find pragmas node.name
- with Not_found -> begin
- match filterAttributes "stacksize" vi.vattr with
- (Attr (_, [AInt n])) :: _ when n > node.stacksize ->
- node.stacksize <- n
- | _ -> ()
- end
- end
-
-let makeFunctionCallGraph (f: Cil.file) : unit =
- Hashtbl.clear functionNodes;
- (* Scan the file and construct the control-flow graph *)
- List.iter
- (function
- GFun(fdec, _) ->
- let curNode = getFunctionNode fdec.svar.vname in
- if fdec.svar.vaddrof then begin
- addCall (getFunctionPtrNode fdec.svar.vtype)
- curNode None;
- end;
- if hasAttribute "start" fdec.svar.vattr then begin
- startNodes := curNode :: !startNodes;
- end;
- markVar fdec.svar;
- curNode.fds <- Some fdec;
- let vis = new findCallsVisitor curNode in
- ignore (visitCilBlock vis fdec.sbody)
-
- | GVarDecl(vi, _) when isFunctionType vi.vtype ->
- (* TODO: what if we take the addr of an extern? *)
- markVar vi
-
- | _ -> ())
- f.globals
-
-let makeStartNodeLinks () : unit =
- addCall startNode (getFunctionNode "main") None;
- List.iter (fun n -> addCall startNode n None) !startNodes
-
-let funType (ret_t: typ) (args: (string * typ) list) =
- TFun(ret_t,
- Some (List.map (fun (n,t) -> (n, t, [])) args),
- false, [])
-
-class instrumentClass = object
- inherit nopCilVisitor
-
- val mutable curNode : node ref = ref (getFunctionNode "main")
- val mutable seenRet : bool ref = ref false
-
- val mutable funId : int ref = ref 0
-
- method vfunc (fdec: fundec) : fundec visitAction = begin
- (* Remember the current function. *)
- curNode := getFunctionNode fdec.svar.vname;
- seenRet := false;
- funId := Random.bits ();
- (* Add useful locals. *)
- ignore (makeLocalVar fdec "savesp" voidPtrType);
- ignore (makeLocalVar fdec "savechunk" voidPtrType);
- ignore (makeLocalVar fdec "savebottom" voidPtrType);
- (* Add macro for function entry when we're done. *)
- let addEntryNode (fdec: fundec) : fundec =
- if not !seenRet then E.s (bug "didn't find a return statement");
- let node = getFunctionNode fdec.svar.vname in
- if fingerprintAll || node.origkind <> NoBlock then begin
- let fingerprintSet =
- Set (var fingerprintVar, BinOp (BXor, Lval (var fingerprintVar),
- integer !funId, intType),
- locUnknown)
- in
- fdec.sbody.bstmts <- mkStmtOneInstr fingerprintSet :: fdec.sbody.bstmts
- end;
- let nodeFun = emptyFunction ("NODE_CALL_"^(string_of_int node.nodeid)) in
- let nodeCall = Call (None, Lval (var nodeFun.svar), [], locUnknown) in
- nodeFun.svar.vtype <- funType voidType [];
- nodeFun.svar.vstorage <- Static;
- fdec.sbody.bstmts <- mkStmtOneInstr nodeCall :: fdec.sbody.bstmts;
- fdec
- in
- ChangeDoChildrenPost (fdec, addEntryNode)
- end
-
- method vstmt (s: stmt) : stmt visitAction = begin
- begin
- match s.skind with
- Instr instrs -> begin
- let instrumentNode (callNode: node) : unit =
- (* Make calls to macros. *)
- let suffix = "_" ^ (string_of_int !curNode.nodeid) ^
- "_" ^ (string_of_int callNode.nodeid)
- in
- let beforeFun = emptyFunction ("BEFORE_CALL" ^ suffix) in
- let beforeCall = Call (None, Lval (var beforeFun.svar),
- [], locUnknown) in
- beforeFun.svar.vtype <- funType voidType [];
- beforeFun.svar.vstorage <- Static;
- let afterFun = emptyFunction ("AFTER_CALL" ^ suffix) in
- let afterCall = Call (None, Lval (var afterFun.svar),
- [], locUnknown) in
- afterFun.svar.vtype <- funType voidType [];
- afterFun.svar.vstorage <- Static;
- (* Insert instrumentation around call site. *)
- let rec addCalls (is: instr list) : instr list =
- match is with
- [call] -> [beforeCall; call; afterCall]
- | cur :: rest -> cur :: addCalls rest
- | [] -> E.s (bug "expected list of non-zero length")
- in
- s.skind <- Instr (addCalls instrs)
- in
- (* If there's a call site here, instrument it. *)
- let len = List.length instrs in
- if len > 0 then begin
- match List.nth instrs (len - 1) with
- Call (_, Lval (Var vi, NoOffset), _, _) ->
- (*
- if (try String.sub vi.vname 0 10 <> "NODE_CALL_"
- with Invalid_argument _ -> true) then
-*)
- instrumentNode (getFunctionNode vi.vname)
- | Call (_, e, _, _) -> (* Calling a function pointer *)
- instrumentNode (getFunctionPtrNode (typeOf e))
- | _ -> ()
- end;
- DoChildren
- end
- | Cil.Return _ -> begin
- if !seenRet then E.s (bug "found multiple returns");
- seenRet := true;
- if fingerprintAll || !curNode.origkind <> NoBlock then begin
- let fingerprintSet =
- Set (var fingerprintVar, BinOp (BXor, Lval (var fingerprintVar),
- integer !funId, intType),
- locUnknown)
- in
- s.skind <- Block (mkBlock [mkStmtOneInstr fingerprintSet;
- mkStmt s.skind]);
- end;
- SkipChildren
- end
- | _ -> DoChildren
- end
- end
-end
-
-let makeStartNodeTable (globs: global list) : global list =
- if List.length !startNodes = 0 then
- globs
- else
- let addrInitInfo = { init = None } in
- let stackInitInfo = { init = None } in
- let rec processNode (nodes: node list) (i: int) =
- match nodes with
- node :: rest ->
- let curGlobs, addrInit, stackInit = processNode rest (i + 1) in
- let fd =
- match node.fds with
- Some fd -> fd
- | None -> E.s (bug "expected fundec")
- in
- let stack =
- makeGlobalVar ("NODE_STACK_" ^ (string_of_int node.nodeid)) intType
- in
- GVarDecl (fd.svar, locUnknown) :: curGlobs,
- ((Index (integer i, NoOffset), SingleInit (mkAddrOf (var fd.svar))) ::
- addrInit),
- ((Index (integer i, NoOffset), SingleInit (Lval (var stack))) ::
- stackInit)
- | [] -> (GVarDecl (startNodeAddrs, locUnknown) ::
- GVarDecl (startNodeStacks, locUnknown) ::
- GVar (startNodeAddrsArray, addrInitInfo, locUnknown) ::
- GVar (startNodeStacksArray, stackInitInfo, locUnknown) ::
- []),
- [Index (integer i, NoOffset), SingleInit zero],
- [Index (integer i, NoOffset), SingleInit zero]
- in
- let newGlobs, addrInit, stackInit = processNode !startNodes 0 in
- addrInitInfo.init <-
- Some (CompoundInit (TArray (voidPtrType, None, []), addrInit));
- stackInitInfo.init <-
- Some (CompoundInit (TArray (intType, None, []), stackInit));
- let file = { fileName = "startnode.h"; globals = newGlobs;
- globinit = None; globinitcalled = false; } in
- let channel = open_out file.fileName in
- dumpFile defaultCilPrinter channel file;
- close_out channel;
- GText ("#include \"" ^ file.fileName ^ "\"") :: globs
-
-let instrumentProgram (f: file) : unit =
- (* Add function prototypes. *)
- f.globals <- makeStartNodeTable f.globals;
- f.globals <- GText ("#include \"stack.h\"") ::
- GVarDecl (initFun, locUnknown) ::
- GVarDecl (beforeFun, locUnknown) ::
- GVarDecl (fingerprintVar, locUnknown) ::
- f.globals;
- (* Add instrumentation to call sites. *)
- visitCilFile ((new instrumentClass) :> cilVisitor) f;
- (* Force creation of this node. *)
- ignore (getFunctionNode beforeFun.vname);
- (* Add initialization call to main(). *)
- let mainNode = getFunctionNode "main" in
- match mainNode.fds with
- Some fdec ->
- let arg1 = integer (List.length !blockingPoints) in
- let initInstr = Call (None, Lval (var initFun), [arg1], locUnknown) in
- let addrsInstr =
- Set (var startNodeAddrs, StartOf (var startNodeAddrsArray),
- locUnknown)
- in
- let stacksInstr =
- Set (var startNodeStacks, StartOf (var startNodeStacksArray),
- locUnknown)
- in
- let newStmt =
- if List.length !startNodes = 0 then
- mkStmtOneInstr initInstr
- else
- mkStmt (Instr [addrsInstr; stacksInstr; initInstr])
- in
- fdec.sbody.bstmts <- newStmt :: fdec.sbody.bstmts;
- addCall mainNode (getFunctionNode initFun.vname) None
- | None ->
- E.s (bug "expected main fundec")
-
-
-
-let feature : featureDescr =
- { fd_name = "FCG";
- fd_enabled = ref false;
- fd_description = "computing and printing a static call graph";
- fd_extraopt = [];
- fd_doit =
- (function (f : file) ->
- Random.init 0; (* Use the same seed so that results are predictable. *)
- gatherPragmas f;
- makeFunctionCallGraph f;
- makeStartNodeLinks ();
- markBlockingFunctions ();
- (* makeAndDumpBlockingGraphs (); *)
- instrumentProgram f;
- dumpFunctionCallGraphToFile ());
- fd_post_check = true;
- }
diff --git a/cil/src/ext/blockinggraph.mli b/cil/src/ext/blockinggraph.mli
deleted file mode 100644
index 72f9ba7be5dfdc6b854a7a5726365be645b21594..0000000000000000000000000000000000000000
--- a/cil/src/ext/blockinggraph.mli
+++ /dev/null
@@ -1,40 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* This module finds and analyzes yield points. *)
-
-val feature: Cil.featureDescr
diff --git a/cil/src/ext/callgraph.ml b/cil/src/ext/callgraph.ml
deleted file mode 100644
index 58472ac67d9087ba53884db5608935559573fb6f..0000000000000000000000000000000000000000
--- a/cil/src/ext/callgraph.ml
+++ /dev/null
@@ -1,250 +0,0 @@
-(* callgraph.ml *)
-(* code for callgraph.mli *)
-
-(* see copyright notice at end of this file *)
-
-open Cil
-open Trace
-open Printf
-module P = Pretty
-module IH = Inthash
-module H = Hashtbl
-module E = Errormsg
-
-(* ------------------- interface ------------------- *)
-(* a call node describes the local calling structure for a
- * single function: which functions it calls, and which
- * functions call it *)
-type callnode = {
- (* An id *)
- cnid: int;
-
- (* the function this node describes *)
- cnInfo: nodeinfo;
-
- (* set of functions this one calls, indexed by the node id *)
- cnCallees: callnode IH.t;
-
- (* set of functions that call this one , indexed by the node id *)
- cnCallers: callnode IH.t;
-}
-
-and nodeinfo =
- NIVar of varinfo * bool ref
- (* Node corresponding to a function. If the boolean
- * is true, then the function is defined, otherwise
- * it is external *)
-
- | NIIndirect of string (* Indirect nodes have a string associated to them.
- * These strings must be invalid function names *)
- * varinfo list ref
- (* A list of functions that this indirect node might
- * denote *)
-
-let nodeName (n: nodeinfo) : string =
- match n with
- NIVar (v, _) -> v.vname
- | NIIndirect (n, _) -> n
-
-(* a call graph is a hashtable, mapping a function name to
- * the node which describes that function's call structure *)
-type callgraph =
- (string, callnode) Hashtbl.t
-
-(* given the name of a function, retrieve its callnode; this will create a
- * node if one doesn't already exist. Will use the given nodeinfo only when
- * creating nodes. *)
-let nodeId = ref 0
-let getNodeByName (cg: callgraph) (ni: nodeinfo) : callnode =
- let name = nodeName ni in
- try
- H.find cg name
- with Not_found -> (
- (* make a new node *)
- let ret:callnode = {
- cnInfo = ni;
- cnid = !nodeId;
- cnCallees = IH.create 5;
- cnCallers = IH.create 5;
- }
- in
- incr nodeId;
- (* add it to the table, then return it *)
- H.add cg name ret;
- ret
- )
-
-(* Get the node for a variable *)
-let getNodeForVar (cg: callgraph) (v: varinfo) : callnode =
- getNodeByName cg (NIVar (v, ref false))
-
-let getNodeForIndirect (cg: callgraph) (e: exp) : callnode =
- getNodeByName cg (NIIndirect ("<indirect>", ref []))
-
-
-(* Find the name of an indirect node that a function whose address is taken
- * belongs *)
-let markFunctionAddrTaken (cg: callgraph) (f: varinfo) : unit =
- (*
- ignore (E.log "markFunctionAddrTaken %s\n" f.vname);
- *)
- let n = getNodeForIndirect cg (AddrOf (Var f, NoOffset)) in
- match n.cnInfo with
- NIIndirect (_, r) -> r := f :: !r
- | _ -> assert false
-
-
-
-class cgComputer (graph: callgraph) = object(self)
- inherit nopCilVisitor
-
- (* the current function we're in, so when we visit a call node
- * we know who is the caller *)
- val mutable curFunc: callnode option = None
-
-
- (* begin visiting a function definition *)
- method vfunc (f:fundec) : fundec visitAction = begin
- (trace "callgraph" (P.dprintf "entering function %s\n" f.svar.vname));
- let node = getNodeForVar graph f.svar in
- (match node.cnInfo with
- NIVar (v, r) -> r := true
- | _ -> assert false);
- curFunc <- (Some node);
- DoChildren
- end
-
- (* visit an instruction; we're only interested in calls *)
- method vinst (i:instr) : instr list visitAction = begin
- (*(trace "callgraph" (P.dprintf "visiting instruction: %a\n" dn_instr i));*)
- let caller : callnode =
- match curFunc with
- None -> assert false
- | Some c -> c
- in
- let callerName: string = nodeName caller.cnInfo in
- (match i with
- Call(_,f,_,_) -> (
- let callee: callnode =
- match f with
- | Lval(Var(vi),NoOffset) ->
- (trace "callgraph" (P.dprintf "I see a call by %s to %s\n"
- callerName vi.vname));
- getNodeForVar graph vi
-
- | _ ->
- (trace "callgraph" (P.dprintf "indirect call: %a\n"
- dn_instr i));
- getNodeForIndirect graph f
- in
-
- (* add one entry to each node's appropriate list *)
- IH.replace caller.cnCallees callee.cnid callee;
- IH.replace callee.cnCallers caller.cnid caller
- )
-
- | _ -> ()); (* ignore other kinds instructions *)
-
- DoChildren
- end
-
- method vexpr (e: exp) =
- (match e with
- AddrOf (Var fv, NoOffset) when isFunctionType fv.vtype ->
- markFunctionAddrTaken graph fv
- | _ -> ());
-
- DoChildren
-end
-
-let computeGraph (f:file) : callgraph = begin
- let graph = H.create 37 in
- let obj:cgComputer = new cgComputer graph in
-
- (* visit the whole file, computing the graph *)
- visitCilFileSameGlobals (obj :> cilVisitor) f;
-
-
- (* return the computed graph *)
- graph
-end
-
-let printGraph (out:out_channel) (g:callgraph) : unit = begin
- let printEntry _ (n:callnode) : unit =
- let name = nodeName n.cnInfo in
- (Printf.fprintf out " %s" name)
- in
-
- let printCalls (node:callnode) : unit =
- (fprintf out " calls:");
- (IH.iter printEntry node.cnCallees);
- (fprintf out "\n is called by:");
- (IH.iter printEntry node.cnCallers);
- (fprintf out "\n")
- in
-
- H.iter (fun (name: string) (node: callnode) ->
- match node.cnInfo with
- NIVar (v, def) ->
- (fprintf out "%s (%s):\n"
- v.vname (if !def then "defined" else "external"));
- printCalls node
-
- | NIIndirect (n, funcs) ->
- fprintf out "Indirect %s:\n" n;
- fprintf out " possible aliases: ";
- List.iter (fun a -> fprintf out "%s " a.vname) !funcs;
- fprintf out "\n"
-
- )
-
- g
- end
-
-let doCallGraph = ref false
-
-let feature : featureDescr =
- { fd_name = "callgraph";
- fd_enabled = doCallGraph;
- fd_description = "generation of a static call graph";
- fd_extraopt = [];
- fd_doit =
- (function (f: file) ->
- let graph:callgraph = computeGraph f in
- printGraph stdout graph);
- fd_post_check = false;
- }
-
-
-(*
- *
- * Copyright (c) 2001-2002 by
- * George C. Necula necula@cs.berkeley.edu
- * Scott McPeak smcpeak@cs.berkeley.edu
- * Wes Weimer weimer@cs.berkeley.edu
- * Ben Liblit liblit@cs.berkeley.edu
- *
- * All rights reserved. Permission to use, copy, modify and distribute
- * this software for research purposes only is hereby granted,
- * provided that the following conditions are met:
- * 1. XSRedistributions of source code must retain the above copyright notice,
- * this list of conditions and the following disclaimer.
- * 2. Redistributions in binary form must reproduce the above copyright notice,
- * this list of conditions and the following disclaimer in the documentation
- * and/or other materials provided with the distribution.
- * 3. The name of the authors may not be used to endorse or promote products
- * derived from this software without specific prior written permission.
- *
- * DISCLAIMER:
- * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
- * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
- * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
- * IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
- * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
- * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
- * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
- * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
- * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
- * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
diff --git a/cil/src/ext/callgraph.mli b/cil/src/ext/callgraph.mli
deleted file mode 100644
index bc760180ff6ead1499fa6b77ab3c3bc3d6a3debb..0000000000000000000000000000000000000000
--- a/cil/src/ext/callgraph.mli
+++ /dev/null
@@ -1,123 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-(* callgraph.mli *)
-(* compute a static call graph *)
-
-(* module maintainer: scott *)
-(* see copyright notice at end of this file *)
-
-
-(* ------------------ types ------------------- *)
-(* a call node describes the local calling structure for a
- * single function: which functions it calls, and which
- * functions call it *)
-type callnode = {
- (* An id *)
- cnid: int;
-
- (* the function this node describes *)
- cnInfo: nodeinfo;
-
- (* set of functions this one calls, indexed by the node id *)
- cnCallees: callnode Inthash.t;
-
- (* set of functions that call this one , indexed by the node id *)
- cnCallers: callnode Inthash.t;
-}
-
-and nodeinfo =
- NIVar of Cil.varinfo * bool ref
- (* Node corresponding to a function. If the boolean
- * is true, then the function is defined, otherwise
- * it is external *)
-
- | NIIndirect of string (* Indirect nodes have a string associated to them.
- * These strings must be invalid function names *)
- * Cil.varinfo list ref
- (* A list of functions that this indirect node might
- * denote *)
-
-
-val nodeName: nodeinfo -> string
-
-(* a call graph is a hashtable, mapping a function name to
- * the node which describes that function's call structure *)
-type callgraph =
- (string, callnode) Hashtbl.t
-
-
-(* ----------------- functions ------------------- *)
-(* given a CIL file, compute its static call graph *)
-val computeGraph : Cil.file -> callgraph
-
-(* print the callgraph in a human-readable format to a channel *)
-val printGraph : out_channel -> callgraph -> unit
-
-
-val feature: Cil.featureDescr
-(*
- *
- * Copyright (c) 2001-2002 by
- * George C. Necula necula@cs.berkeley.edu
- * Scott McPeak smcpeak@cs.berkeley.edu
- * Wes Weimer weimer@cs.berkeley.edu
- * Ben Liblit liblit@cs.berkeley.edu
- *
- * All rights reserved. Permission to use, copy, modify and distribute
- * this software for research purposes only is hereby granted,
- * provided that the following conditions are met:
- * 1. Redistributions of source code must retain the above copyright notice,
- * this list of conditions and the following disclaimer.
- * 2. Redistributions in binary form must reproduce the above copyright notice,
- * this list of conditions and the following disclaimer in the documentation
- * and/or other materials provided with the distribution.
- * 3. The name of the authors may not be used to endorse or promote products
- * derived from this software without specific prior written permission.
- *
- * DISCLAIMER:
- * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
- * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
- * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
- * IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
- * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
- * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
- * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
- * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
- * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
- * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
diff --git a/cil/src/ext/canonicalize.ml b/cil/src/ext/canonicalize.ml
deleted file mode 100644
index a75deeacdb66c386c61ca7625756ffcb9c632ed6..0000000000000000000000000000000000000000
--- a/cil/src/ext/canonicalize.ml
+++ /dev/null
@@ -1,292 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-
-
-(************************************************************************
- * canonicalize performs several transformations to correct differences
- * between C and C++, so that the output is (hopefully) valid C++ code.
- * This is incomplete -- certain fixes which are necessary
- * for some programs are not yet implemented.
- *
- * #1) C allows global variables to have multiple declarations and multiple
- * (equivalent) definitions. This transformation removes all but one
- * declaration and all but one definition.
- *
- * #2) Any variables that use C++ keywords as identifiers are renamed.
- *
- * #3) __inline is #defined to inline, and __restrict is #defined to nothing.
- *
- * #4) C allows function pointers with no specified arguments to be used on
- * any argument list. To make C++ accept this code, we insert a cast
- * from the function pointer to a type that matches the arguments. Of
- * course, this does nothing to guarantee that the pointer actually has
- * that type.
- *
- * #5) Makes casts from int to enum types explicit. (CIL changes enum
- * constants to int constants, but doesn't use a cast.)
- *
- ************************************************************************)
-
-open Cil
-module E = Errormsg
-module H = Hashtbl
-
-(* For transformation #1. Stores all variable definitions in the file. *)
-let varDefinitions: (varinfo, global) H.t = H.create 111
-
-
-class canonicalizeVisitor = object(self)
- inherit nopCilVisitor
- val mutable currentFunction: fundec = Cil.dummyFunDec;
-
- (* A hashtable to prevent duplicate declarations. *)
- val alreadyDeclared: (varinfo, unit) H.t = H.create 111
- val alreadyDefined: (varinfo, unit) H.t = H.create 111
-
- (* move variable declarations around *)
- method vglob g = match g with
- GVar(v, ({init = Some _} as inito), l) ->
- (* A definition. May have been moved to an earlier position. *)
- if H.mem alreadyDefined v then begin
- ignore (E.warn "Duplicate definition of %s at %a.\n"
- v.vname d_loc !currentLoc);
- ChangeTo [] (* delete from here. *)
- end else begin
- H.add alreadyDefined v ();
- if H.mem alreadyDeclared v then begin
- (* Change the earlier declaration to Extern *)
- let oldS = v.vstorage in
- ignore (E.log "changing storage of %s from %a\n"
- v.vname d_storage oldS);
- v.vstorage <- Extern;
- let newv = {v with vstorage = oldS} in
- ChangeDoChildrenPost([GVar(newv, inito, l)], (fun g -> g) )
- end else
- DoChildren
- end
- | GVar(v, {init=None}, l)
- | GVarDecl(v, l) when not (isFunctionType v.vtype) -> begin
- (* A declaration. May have been moved to an earlier position. *)
- if H.mem alreadyDefined v || H.mem alreadyDeclared v then
- ChangeTo [] (* delete from here. *)
- else begin
- H.add alreadyDeclared v ();
- DoChildren
- end
- end
- | GFun(f, l) ->
- currentFunction <- f;
- DoChildren
- | _ ->
- DoChildren
-
-(* #2. rename any identifiers whose names are C++ keywords *)
- method vvdec v =
- match v.vname with
- | "bool"
- | "catch"
- | "cdecl"
- | "class"
- | "const_cast"
- | "delete"
- | "dynamic_cast"
- | "explicit"
- | "export"
- | "false"
- | "friend"
- | "mutable"
- | "namespace"
- | "new"
- | "operator"
- | "pascal"
- | "private"
- | "protected"
- | "public"
- | "register"
- | "reinterpret_cast"
- | "static_cast"
- | "template"
- | "this"
- | "throw"
- | "true"
- | "try"
- | "typeid"
- | "typename"
- | "using"
- | "virtual"
- | "wchar_t"->
- v.vname <- v.vname ^ "__cil2cpp";
- DoChildren
- | _ -> DoChildren
-
- method vinst i =
-(* #5. If an assignment or function call uses expressions as enum values,
- add an explicit cast. *)
- match i with
- Set (dest, exp, l) -> begin
- let typeOfDest = typeOfLval dest in
- match unrollType typeOfDest with
- TEnum _ -> (* add an explicit cast *)
- let newI = Set(dest, mkCast exp typeOfDest, l) in
- ChangeTo [newI]
- | _ -> SkipChildren
- end
- | Call (dest, f, args, l) -> begin
- let rt, formals, isva, attrs = splitFunctionType (typeOf f) in
- if isva then
- SkipChildren (* ignore vararg functions *)
- else
- match formals with
- Some formals' -> begin
- let newArgs = try
- (*Iterate over the arguments, looking for formals that
- expect enum types, and insert casts where necessary. *)
- List.map2
- (fun (actual: exp) (formalName, formalType, _) ->
- match unrollType formalType with
- TEnum _ -> mkCast actual formalType
- | _ -> actual)
- args
- formals'
- with Invalid_argument _ ->
- E.s (error "Number of arguments to %a doesn't match type.\n"
- d_exp f)
- in
- let newI = Call(dest, f, newArgs, l) in
- ChangeTo [newI]
- end
- | None -> begin
- (* #4. No arguments were specified for this type. To fix this, infer the
- type from the arguments that are used n this instruction, and insert
- a cast to that type.*)
- match f with
- Lval(Mem(fp), off) ->
- let counter: int ref = ref 0 in
- let newFormals = List.map
- (fun (actual:exp) ->
- incr counter;
- let formalName = "a" ^ (string_of_int !counter) in
- (formalName, typeOf actual, []))(* (name,type,attrs) *)
- args in
- let newFuncPtrType =
- TPtr((TFun (rt, Some newFormals, false, attrs)), []) in
- let newFuncPtr = Lval(Mem(mkCast fp newFuncPtrType), off) in
- ChangeTo [Call(dest, newFuncPtr, args, l)]
- | _ ->
- ignore (warn "cppcanon: %a has no specified arguments, but it's not a function pointer." d_exp f);
- SkipChildren
- end
- end
- | _ -> SkipChildren
-
- method vinit i =
-(* #5. If an initializer uses expressions as enum values,
- add an explicit cast. *)
- match i with
- SingleInit e -> DoChildren (* we don't handle simple initializers here,
- because we don't know what type is expected.
- This should be done in vglob if needed. *)
- | CompoundInit(t, initList) ->
- let changed: bool ref = ref false in
- let initList' = List.map
- (* iterate over the list, adding casts for any expression that
- is expected to be an enum type. *)
- (function
- (Field(fi, off), SingleInit e) -> begin
- match unrollType fi.ftype with
- TEnum _ -> (* add an explicit cast *)
- let newE = mkCast e fi.ftype in
- changed := true;
- (Field(fi, off), SingleInit newE)
- | _ -> (* not enum, no cast needed *)
- (Field(fi, off), SingleInit e)
- end
- | other ->
- (* This is a more complicated initializer, and I don't think
- it can have type enum. It's children might, though. *)
- other)
- initList in
- if !changed then begin
- (* There may be other casts needed in other parts of the
- initialization, so do the children too. *)
- ChangeDoChildrenPost(CompoundInit(t, initList'), (fun x -> x))
- end else
- DoChildren
-
-
-(* #5. If a function returns an enum type, add an explicit cast to the
- return type. *)
- method vstmt stmt =
- (match stmt.skind with
- Return (Some exp, l) -> begin
- let typeOfDest, _, _, _ =
- splitFunctionType currentFunction.svar.vtype in
- match unrollType typeOfDest with
- TEnum _ ->
- stmt.skind <- Return (Some (mkCast exp typeOfDest), l)
- | _ -> ()
- end
- | _ -> ());
- DoChildren
-end (* class canonicalizeVisitor *)
-
-
-
-(* Entry point for this extension *)
-let canonicalize (f:file) =
- visitCilFile (new canonicalizeVisitor) f;
-
- (* #3. Finally, add some #defines to change C keywords to their C++
- equivalents: *)
- f.globals <-
- GText( "#ifdef __cplusplus\n"
- ^" #define __restrict\n" (* "restrict" doesn't work *)
- ^" #define __inline inline\n"
- ^"#endif")
- ::f.globals
-
-
-
-let feature : featureDescr =
- { fd_name = "canonicalize";
- fd_enabled = ref false;
- fd_description = "fixing some C-isms so that the result is C++ compliant.";
- fd_extraopt = [];
- fd_doit = canonicalize;
- fd_post_check = true;
- }
diff --git a/cil/src/ext/canonicalize.mli b/cil/src/ext/canonicalize.mli
deleted file mode 100644
index 37bc0d83f27b1fe4b8c085f5986abef61f2d263a..0000000000000000000000000000000000000000
--- a/cil/src/ext/canonicalize.mli
+++ /dev/null
@@ -1,48 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(************************************************************************
- * canonicalize performs several transformations to correct differences
- * between C and C++, so that the output is (hopefully) valid C++ code.
- * This is incomplete -- certain fixes which are necessary
- * for some programs are not yet implemented.
- *
- * See canonicalize.ml for a list of changes.
- *
- ************************************************************************)
-
-val feature: Cil.featureDescr
diff --git a/cil/src/ext/cfg.ml b/cil/src/ext/cfg.ml
deleted file mode 100644
index 8b19c797ed4e92cf14de5928ccf7249b8d530f6c..0000000000000000000000000000000000000000
--- a/cil/src/ext/cfg.ml
+++ /dev/null
@@ -1,289 +0,0 @@
-(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-
-(*
- *
- * Copyright (c) 2001-2003,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * Simon Goldsmith <sfg@cs.berkeley.edu>
- * S.P Rahul, Aman Bhargava
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* Authors: Aman Bhargava, S. P. Rahul *)
-(* sfg: this stuff was stolen from optim.ml - the code to print the cfg as
- a dot graph is mine *)
-
-open Pretty
-open Cil
-module E=Errormsg
-
-(* entry points: cfgFun, printCfgChannel, printCfgFilename *)
-
-(* known issues:
- * -sucessors of if somehow end up with two edges each
- *)
-
-(*------------------------------------------------------------*)
-(* Notes regarding CFG computation:
- 1) Initially only succs and preds are computed. sid's are filled in
- later, in whatever order is suitable (e.g. for forward problems, reverse
- depth-first postorder).
- 2) If a stmt (return, break or continue) has no successors, then
- function return must follow.
- No predecessors means it is the start of the function
- 3) We use the fact that initially all the succs and preds are assigned []
-*)
-
-(* Fill in the CFG info for the stmts in a block
- next = succ of the last stmt in this block
- break = succ of any Break in this block
- cont = succ of any Continue in this block
- None means the succ is the function return. It does not mean the break/cont
- is invalid. We assume the validity has already been checked.
-*)
-(* At the end of CFG computation,
- - numNodes = total number of CFG nodes
- - length(nodeList) = numNodes
-*)
-
-let numNodes = ref 0 (* number of nodes in the CFG *)
-let nodeList : stmt list ref = ref [] (* All the nodes in a flat list *) (* ab: Added to change dfs from quadratic to linear *)
-let start_id = ref 0 (* for unique ids across many functions *)
-
-(* entry point *)
-
-(** Compute a control flow graph for fd. Stmts in fd have preds and succs
- filled in *)
-let rec cfgFun (fd : fundec): int =
- begin
- numNodes := !start_id;
- nodeList := [];
-
- cfgBlock fd.sbody None None None;
- !numNodes - !start_id
- end
-
-
-and cfgStmts (ss: stmt list)
- (next:stmt option) (break:stmt option) (cont:stmt option) =
- match ss with
- [] -> ();
- | [s] -> cfgStmt s next break cont
- | hd::tl ->
- cfgStmt hd (Some (List.hd tl)) break cont;
- cfgStmts tl next break cont
-
-and cfgBlock (blk: block)
- (next:stmt option) (break:stmt option) (cont:stmt option) =
- cfgStmts blk.bstmts next break cont
-
-(* Fill in the CFG info for a stmt
- Meaning of next, break, cont should be clear from earlier comment
-*)
-and cfgStmt (s: stmt) (next:stmt option) (break:stmt option) (cont:stmt option) =
- incr numNodes;
- s.sid <- !numNodes;
- nodeList := s :: !nodeList; (* Future traversals can be made in linear time. e.g. *)
- if s.succs <> [] then
- E.s (bug "CFG must be cleared before being computed!");
- let addSucc (n: stmt) =
- if not (List.memq n s.succs) then
- s.succs <- n::s.succs;
- if not (List.memq s n.preds) then
- n.preds <- s::n.preds
- in
- let addOptionSucc (n: stmt option) =
- match n with
- None -> ()
- | Some n' -> addSucc n'
- in
- let addBlockSucc (b: block) =
- match b.bstmts with
- [] -> addOptionSucc next
- | hd::_ -> addSucc hd
- in
- match s.skind with
- Instr _ -> addOptionSucc next
- | Return _ -> ()
- | Goto (p,_) -> addSucc !p
- | Break _ -> addOptionSucc break
- | Continue _ -> addOptionSucc cont
- | If (_, blk1, blk2, _) ->
- (* The succs of If is [true branch;false branch] *)
- addBlockSucc blk2;
- addBlockSucc blk1;
- cfgBlock blk1 next break cont;
- cfgBlock blk2 next break cont
- | Block b ->
- addBlockSucc b;
- cfgBlock b next break cont
- | Switch(_,blk,l,_) ->
- List.iter addSucc (List.rev l); (* Add successors in order *)
- (* sfg: if there's no default, need to connect s->next *)
- if not (List.exists
- (fun stmt -> List.exists
- (function Default _ -> true | _ -> false)
- stmt.labels)
- l)
- then
- addOptionSucc next;
- cfgBlock blk next next cont
-(*
- | Loop(blk,_,_,_) ->
-*)
- | While(_,blk,_)
- | DoWhile(_,blk,_)
- | For(_,_,_,blk,_) ->
- addBlockSucc blk;
- cfgBlock blk (Some s) next (Some s)
- (* Since all loops have terminating condition true, we don't put
- any direct successor to stmt following the loop *)
- | TryExcept _ | TryFinally _ ->
- E.s (E.unimp "try/except/finally")
-
-(*------------------------------------------------------------*)
-
-(**************************************************************)
-(* do something for all stmts in a fundec *)
-
-let rec forallStmts (todo) (fd : fundec) =
- begin
- fasBlock todo fd.sbody;
- end
-
-and fasBlock (todo) (b : block) =
- List.iter (fasStmt todo) b.bstmts
-
-and fasStmt (todo) (s : stmt) =
- begin
- ignore(todo s);
- match s.skind with
- | Block b -> fasBlock todo b
- | If (_, tb, fb, _) -> (fasBlock todo tb; fasBlock todo fb)
- | Switch (_, b, _, _) -> fasBlock todo b
-(*
- | Loop (b, _, _, _) -> fasBlock todo b
-*)
- | While (_, b, _) -> fasBlock todo b
- | DoWhile (_, b, _) -> fasBlock todo b
- | For (_, _, _, b, _) -> fasBlock todo b
- | (Return _ | Break _ | Continue _ | Goto _ | Instr _) -> ()
- | TryExcept _ | TryFinally _ -> E.s (E.unimp "try/except/finally")
- end
-;;
-
-(**************************************************************)
-(* printing the control flow graph - you have to compute it first *)
-
-let d_cfgnodename () (s : stmt) =
- dprintf "%d" s.sid
-
-let d_cfgnodelabel () (s : stmt) =
- let label =
- begin
- match s.skind with
- | If (e, _, _, _) -> "if" (*sprint ~width:999 (dprintf "if %a" d_exp e)*)
-(*
- | Loop _ -> "loop"
-*)
- | While _ -> "while"
- | DoWhile _ -> "dowhile"
- | For _ -> "for"
- | Break _ -> "break"
- | Continue _ -> "continue"
- | Goto _ -> "goto"
- | Instr _ -> "instr"
- | Switch _ -> "switch"
- | Block _ -> "block"
- | Return _ -> "return"
- | TryExcept _ -> "try-except"
- | TryFinally _ -> "try-finally"
- end in
- dprintf "%d: %s" s.sid label
-
-let d_cfgedge (src) () (dest) =
- dprintf "%a -> %a"
- d_cfgnodename src
- d_cfgnodename dest
-
-let d_cfgnode () (s : stmt) =
- dprintf "%a [label=\"%a\"]\n\t%a"
- d_cfgnodename s
- d_cfgnodelabel s
- (d_list "\n\t" (d_cfgedge s)) s.succs
-
-(**********************************************************************)
-(* entry points *)
-
-(** print control flow graph (in dot form) for fundec to channel *)
-let printCfgChannel (chan : out_channel) (fd : fundec) =
- let pnode (s:stmt) = fprintf chan "%a\n" d_cfgnode s in
- begin
- ignore (fprintf chan "digraph CFG_%s {\n" fd.svar.vname);
- forallStmts pnode fd;
- ignore(fprintf chan "}\n");
- end
-
-(** Print control flow graph (in dot form) for fundec to file *)
-let printCfgFilename (filename : string) (fd : fundec) =
- let chan = open_out filename in
- begin
- printCfgChannel chan fd;
- close_out chan;
- end
-
-
-;;
-
-(**********************************************************************)
-
-let clearCFGinfo (fd : fundec) =
- let clear s =
- s.sid <- -1;
- s.succs <- [];
- s.preds <- [];
- in
- forallStmts clear fd
-
-let clearFileCFG (f : file) =
- iterGlobals f (fun g ->
- match g with GFun(fd,_) ->
- clearCFGinfo fd
- | _ -> ())
-
-let computeFileCFG (f : file) =
- iterGlobals f (fun g ->
- match g with GFun(fd,_) ->
- numNodes := cfgFun fd;
- start_id := !start_id + !numNodes
- | _ -> ())
diff --git a/cil/src/ext/cfg.mli b/cil/src/ext/cfg.mli
deleted file mode 100644
index 19c51666fb7297a121096137828e55393c493dc9..0000000000000000000000000000000000000000
--- a/cil/src/ext/cfg.mli
+++ /dev/null
@@ -1,36 +0,0 @@
-(** Code to compute the control-flow graph of a function or file.
- This will fill in the [preds] and [succs] fields of {!Cil.stmt}
-
- This is required for several other extensions, such as {!Dataflow}.
-*)
-
-open Cil
-
-
-(** Compute the CFG for an entire file, by calling cfgFun on each function. *)
-val computeFileCFG: Cil.file -> unit
-
-(** clear the sid, succs, and preds fields of each statement. *)
-val clearFileCFG: Cil.file -> unit
-
-(** Compute a control flow graph for fd. Stmts in fd have preds and succs
- filled in *)
-val cfgFun : fundec -> int
-
-(** clear the sid, succs, and preds fields of each statment in a function *)
-val clearCFGinfo: Cil.fundec -> unit
-
-(** print control flow graph (in dot form) for fundec to channel *)
-val printCfgChannel : out_channel -> fundec -> unit
-
-(** Print control flow graph (in dot form) for fundec to file *)
-val printCfgFilename : string -> fundec -> unit
-
-(** Next statement id that will be assigned. *)
-val start_id: int ref
-
-(** All of the nodes in a file. *)
-val nodeList : stmt list ref
-
-(** number of nodes in the CFG *)
-val numNodes : int ref
diff --git a/cil/src/ext/ciltools.ml b/cil/src/ext/ciltools.ml
deleted file mode 100755
index 78f1aafc362fe4d8c66e6a112518dc78bd709a56..0000000000000000000000000000000000000000
--- a/cil/src/ext/ciltools.ml
+++ /dev/null
@@ -1,228 +0,0 @@
-open Cil
-
-(* Contributed by Nathan Cooprider *)
-
-let isOne e =
- isInteger e = Some Int64.one
-
-
-(* written by Zach *)
-let is_volatile_tp tp =
- List.exists (function (Attr("volatile",_)) -> true
- | _ -> false) (typeAttrs tp)
-
-(* written by Zach *)
-let is_volatile_vi vi =
- let vi_vol =
- List.exists (function (Attr("volatile",_)) -> true
- | _ -> false) vi.vattr in
- let typ_vol = is_volatile_tp vi.vtype in
- vi_vol || typ_vol
-
-(*****************************************************************************
- * A collection of useful functions that were not already in CIL as far as I
- * could tell. However, I have been surprised before . . .
- ****************************************************************************)
-
-type sign = Signed | Unsigned
-
-exception Not_an_integer
-
-(*****************************************************************************
- * A bunch of functions for accessing integers. Originally written for
- * somebody who didn't know CIL and just wanted to mess with it at the
- * OCaml level.
- ****************************************************************************)
-
-let unbox_int_type (ye : typ) : (int * sign) =
- let tp = unrollType ye in
- let s =
- match tp with
- TInt (i, _) ->
- if (isSigned i) then
- Signed
- else
- Unsigned
- | _ -> raise Not_an_integer
- in
- (bitsSizeOf tp), s
-
-(* depricated. Use isInteger directly instead *)
-let unbox_int_exp (e : exp) : int64 =
- match isInteger e with
- None -> raise Not_an_integer
- | Some (x) -> x
-
-let box_int_to_exp (n : int64) (ye : typ) : exp =
- let tp = unrollType ye in
- match tp with
- TInt (i, _) ->
- kinteger64 i n
- | _ -> raise Not_an_integer
-
-let cil_to_ocaml_int (e : exp) : (int64 * int * sign) =
- let v, s = unbox_int_type (typeOf e) in
- unbox_int_exp (e), v, s
-
-exception Weird_bitwidth
-
-(* (int64 * int * sign) : exp *)
-let ocaml_int_to_cil v n s =
- let char_size = bitsSizeOf charType in
- let int_size = bitsSizeOf intType in
- let short_size = bitsSizeOf (TInt(IShort,[]))in
- let long_size = bitsSizeOf longType in
- let longlong_size = bitsSizeOf (TInt(ILongLong,[])) in
- let i =
- match s with
- Signed ->
- if (n = char_size) then
- ISChar
- else if (n = int_size) then
- IInt
- else if (n = short_size) then
- IShort
- else if (n = long_size) then
- ILong
- else if (n = longlong_size) then
- ILongLong
- else
- raise Weird_bitwidth
- | Unsigned ->
- if (n = char_size) then
- IUChar
- else if (n = int_size) then
- IUInt
- else if (n = short_size) then
- IUShort
- else if (n = long_size) then
- IULong
- else if (n = longlong_size) then
- IULongLong
- else
- raise Weird_bitwidth
- in
- kinteger64 i v
-
-(*****************************************************************************
- * a couple of type functions that I thought would be useful:
- ****************************************************************************)
-
-let rec isCompositeType tp =
- match tp with
- TComp _ -> true
- | TPtr(x, _) -> isCompositeType x
- | TArray(x,_,_) -> isCompositeType x
- | TFun(x,_,_,_) -> isCompositeType x
- | TNamed (x,_) -> isCompositeType x.ttype
- | _ -> false
-
-(** START OF deepHasAttribute ************************************************)
-let visited = ref []
-class attribute_checker target rflag = object (self)
- inherit nopCilVisitor
- method vtype t =
- match t with
- TComp(cinfo, a) ->
- if(not (List.exists (fun x -> cinfo.cname = x) !visited )) then begin
- visited := cinfo.cname :: !visited;
- List.iter
- (fun f ->
- if (hasAttribute target f.fattr) then
- rflag := true
- else
- ignore(visitCilType (new attribute_checker target rflag)
- f.ftype)) cinfo.cfields;
- end;
- DoChildren
- | TNamed(t1, a) ->
- if(not (List.exists (fun x -> t1.tname = x) !visited )) then begin
- visited := t1.tname :: !visited;
- ignore(visitCilType (new attribute_checker target rflag) t1.ttype);
- end;
- DoChildren
- | _ ->
- DoChildren
- method vattr (Attr(name,params)) =
- if (name = target) then rflag := true;
- DoChildren
-end
-
-let deepHasAttribute s t =
- let found = ref false in
- visited := [];
- ignore(visitCilType (new attribute_checker s found) t);
- !found
-(** END OF deepHasAttribute **************************************************)
-
-(** Stuff from ptranal, slightly modified ************************************)
-
-(*****************************************************************************
- * A transformation to make every instruction be in its own statement.
- ****************************************************************************)
-
-class callBBVisitor = object
- inherit nopCilVisitor
-
- method vstmt s =
- match s.skind with
- Instr(il) -> begin
- if (List.length il > 1) then
- let list_of_stmts = List.map (fun one_inst ->
- mkStmtOneInstr one_inst) il in
- let block = mkBlock list_of_stmts in
- s.skind <- Block block;
- ChangeTo(s)
- else
- SkipChildren
- end
- | _ -> DoChildren
-
- method vvdec _ = SkipChildren
- method vexpr _ = SkipChildren
- method vlval _ = SkipChildren
- method vtype _ = SkipChildren
-end
-
-let one_instruction_per_statement f =
- let thisVisitor = new callBBVisitor in
- visitCilFileSameGlobals thisVisitor f
-
-(*****************************************************************************
- * A transformation that gives each variable a unique identifier.
- ****************************************************************************)
-
-class vidVisitor = object
- inherit nopCilVisitor
- val count = ref 0
-
- method vvdec vi =
- vi.vid <- !count ;
- incr count ; SkipChildren
-end
-
-let globally_unique_vids f =
- let thisVisitor = new vidVisitor in
- visitCilFileSameGlobals thisVisitor f
-
-(** End of stuff from ptranal ************************************************)
-
-class sidVisitor = object
- inherit nopCilVisitor
- val count = ref 0
-
- method vstmt s =
- s.sid <- !count ;
- incr count ;
- DoChildren
-end
-
-let globally_unique_sids f =
- let thisVisitor = new sidVisitor in
- visitCilFileSameGlobals thisVisitor f
-
-(** Comparing expressions without a Out_of_memory error **********************)
-
-let compare_exp x y =
- compare x y
-
diff --git a/cil/src/ext/dataflow.ml b/cil/src/ext/dataflow.ml
deleted file mode 100755
index 7f28f841b0652e36252bd7a0935636942f72b9da..0000000000000000000000000000000000000000
--- a/cil/src/ext/dataflow.ml
+++ /dev/null
@@ -1,466 +0,0 @@
-(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-
-module IH = Inthash
-module E = Errormsg
-
-open Cil
-open Pretty
-
-(** A framework for data flow analysis for CIL code. Before using
- this framework, you must initialize the Control-flow Graph for your
- program, e.g using {!Cfg.computeFileCFG} *)
-
-type 't action =
- Default (** The default action *)
- | Done of 't (** Do not do the default action. Use this result *)
- | Post of ('t -> 't) (** The default action, followed by the given
- * transformer *)
-
-type 't stmtaction =
- SDefault (** The default action *)
- | SDone (** Do not visit this statement or its successors *)
- | SUse of 't (** Visit the instructions and successors of this statement
- as usual, but use the specified state instead of the
- one that was passed to doStmt *)
-
-(* For if statements *)
-type 't guardaction =
- GDefault (** The default state *)
- | GUse of 't (** Use this data for the branch *)
- | GUnreachable (** The branch will never be taken. *)
-
-
-(******************************************************************
- **********
- ********** FORWARDS
- **********
- ********************************************************************)
-
-module type ForwardsTransfer = sig
- val name: string (** For debugging purposes, the name of the analysis *)
-
- val debug: bool ref (** Whether to turn on debugging *)
-
- type t (** The type of the data we compute for each block start. May be
- * imperative. *)
-
- val copy: t -> t
- (** Make a deep copy of the data *)
-
-
- val stmtStartData: t Inthash.t
- (** For each statement id, the data at the start. Not found in the hash
- * table means nothing is known about the state at this point. At the end
- * of the analysis this means that the block is not reachable. *)
-
- val pretty: unit -> t -> Pretty.doc
- (** Pretty-print the state *)
-
- val computeFirstPredecessor: Cil.stmt -> t -> t
- (** Give the first value for a predecessors, compute the value to be set
- * for the block *)
-
- val combinePredecessors: Cil.stmt -> old:t -> t -> t option
- (** Take some old data for the start of a statement, and some new data for
- * the same point. Return None if the combination is identical to the old
- * data. Otherwise, compute the combination, and return it. *)
-
- val doInstr: Cil.instr -> t -> t action
- (** The (forwards) transfer function for an instruction. The
- * {!Cil.currentLoc} is set before calling this. The default action is to
- * continue with the state unchanged. *)
-
- val doStmt: Cil.stmt -> t -> t stmtaction
- (** The (forwards) transfer function for a statement. The {!Cil.currentLoc}
- * is set before calling this. The default action is to do the instructions
- * in this statement, if applicable, and continue with the successors. *)
-
- val doGuard: Cil.exp -> t -> t guardaction
- (** Generate the successor to an If statement assuming the given expression
- * is nonzero. Analyses that don't need guard information can return
- * GDefault; this is equivalent to returning GUse of the input.
- * A return value of GUnreachable indicates that this half of the branch
- * will not be taken and should not be explored. This will be called
- * twice per If, once for "then" and once for "else".
- *)
-
- val filterStmt: Cil.stmt -> bool
- (** Whether to put this statement in the worklist. This is called when a
- * block would normally be put in the worklist. *)
-
-end
-
-
-module ForwardsDataFlow =
- functor (T : ForwardsTransfer) ->
- struct
-
- (** Keep a worklist of statements to process. It is best to keep a queue,
- * because this way it is more likely that we are going to process all
- * predecessors of a statement before the statement itself. *)
- let worklist: Cil.stmt Queue.t = Queue.create ()
-
- (** We call this function when we have encountered a statement, with some
- * state. *)
- let reachedStatement (s: stmt) (d: T.t) : unit =
- (** see if we know about it already *)
- E.pushContext (fun _ -> dprintf "Reached statement %d with %a"
- s.sid T.pretty d);
- let newdata: T.t option =
- try
- let old = IH.find T.stmtStartData s.sid in
- match T.combinePredecessors s ~old:old d with
- None -> (* We are done here *)
- if !T.debug then
- ignore (E.log "FF(%s): reached stmt %d with %a\n implies the old state %a\n"
- T.name s.sid T.pretty d T.pretty old);
- None
- | Some d' -> begin
- (* We have changed the data *)
- if !T.debug then
- ignore (E.log "FF(%s): weaken data for block %d: %a\n"
- T.name s.sid T.pretty d');
- Some d'
- end
- with Not_found -> (* was bottom before *)
- let d' = T.computeFirstPredecessor s d in
- if !T.debug then
- ignore (E.log "FF(%s): set data for block %d: %a\n"
- T.name s.sid T.pretty d');
- Some d'
- in
- E.popContext ();
- match newdata with
- None -> ()
- | Some d' ->
- IH.replace T.stmtStartData s.sid d';
- if T.filterStmt s &&
- not (Queue.fold (fun exists s' -> exists || s'.sid = s.sid)
- false
- worklist) then
- Queue.add s worklist
-
-
- (** Get the two successors of an If statement *)
- let ifSuccs (s:stmt) : stmt * stmt =
- let fstStmt blk = match blk.bstmts with
- [] -> Cil.dummyStmt
- | fst::_ -> fst
- in
- match s.skind with
- If(e, b1, b2, _) ->
- let thenSucc = fstStmt b1 in
- let elseSucc = fstStmt b2 in
- let oneFallthrough () =
- let fallthrough =
- List.filter
- (fun s' -> thenSucc != s' && elseSucc != s')
- s.succs
- in
- match fallthrough with
- [] -> E.s (bug "Bad CFG: missing fallthrough for If.")
- | [s'] -> s'
- | _ -> E.s (bug "Bad CFG: multiple fallthrough for If.")
- in
- (* If thenSucc or elseSucc is Cil.dummyStmt, it's an empty block.
- So the successor is the statement after the if *)
- let stmtOrFallthrough s' =
- if s' == Cil.dummyStmt then
- oneFallthrough ()
- else
- s'
- in
- (stmtOrFallthrough thenSucc,
- stmtOrFallthrough elseSucc)
-
- | _-> E.s (bug "ifSuccs on a non-If Statement.")
-
- (** Process a statement *)
- let processStmt (s: stmt) : unit =
- currentLoc := get_stmtLoc s.skind;
- if !T.debug then
- ignore (E.log "FF(%s).stmt %d at %t\n" T.name s.sid d_thisloc);
-
- (* It must be the case that the block has some data *)
- let init: T.t =
- try T.copy (IH.find T.stmtStartData s.sid)
- with Not_found ->
- E.s (E.bug "FF(%s): processing block without data" T.name)
- in
-
- (** See what the custom says *)
- match T.doStmt s init with
- SDone -> ()
- | (SDefault | SUse _) as act -> begin
- let curr = match act with
- SDefault -> init
- | SUse d -> d
- | SDone -> E.s (bug "SDone")
- in
- (* Do the instructions in order *)
- let handleInstruction (s: T.t) (i: instr) : T.t =
- currentLoc := get_instrLoc i;
-
- (* Now handle the instruction itself *)
- let s' =
- let action = T.doInstr i s in
- match action with
- | Done s' -> s'
- | Default -> s (* do nothing *)
- | Post f -> f s
- in
- s'
- in
-
- let after: T.t =
- match s.skind with
- Instr il ->
- (* Handle instructions starting with the first one *)
- List.fold_left handleInstruction curr il
-
- | Goto _ | Break _ | Continue _ | If _
- | TryExcept _ | TryFinally _
- | Switch _ | (*Loop _*) While _ | DoWhile _ | For _
- | Return _ | Block _ -> curr
- in
- currentLoc := get_stmtLoc s.skind;
-
- (* Handle If guards *)
- let succsToReach = match s.skind with
- If (e, _, _, _) -> begin
- let not_e = UnOp(LNot, e, intType) in
- let thenGuard = T.doGuard e after in
- let elseGuard = T.doGuard not_e after in
- if thenGuard = GDefault && elseGuard = GDefault then
- (* this is the common case *)
- s.succs
- else begin
- let doBranch succ guard =
- match guard with
- GDefault -> reachedStatement succ after
- | GUse d -> reachedStatement succ d
- | GUnreachable ->
- if !T.debug then
- ignore (E.log "FF(%s): Not exploring branch to %d\n"
- T.name succ.sid);
-
- ()
- in
- let thenSucc, elseSucc = ifSuccs s in
- doBranch thenSucc thenGuard;
- doBranch elseSucc elseGuard;
- []
- end
- end
- | _ -> s.succs
- in
- (* Reach the successors *)
- List.iter (fun s' -> reachedStatement s' after) succsToReach;
-
- end
-
-
-
-
- (** Compute the data flow. Must have the CFG initialized *)
- let compute (sources: stmt list) =
- Queue.clear worklist;
- List.iter (fun s -> Queue.add s worklist) sources;
-
- (** All initial stmts must have non-bottom data *)
- List.iter (fun s ->
- if not (IH.mem T.stmtStartData s.sid) then
- E.s (E.error "FF(%s): initial stmt %d does not have data"
- T.name s.sid))
- sources;
- if !T.debug then
- ignore (E.log "\nFF(%s): processing\n"
- T.name);
- let rec fixedpoint () =
- if !T.debug && not (Queue.is_empty worklist) then
- ignore (E.log "FF(%s): worklist= %a\n"
- T.name
- (docList (fun s -> num s.sid))
- (List.rev
- (Queue.fold (fun acc s -> s :: acc) [] worklist)));
- try
- let s = Queue.take worklist in
- processStmt s;
- fixedpoint ();
- with Queue.Empty ->
- if !T.debug then
- ignore (E.log "FF(%s): done\n\n" T.name)
- in
- fixedpoint ()
-
- end
-
-
-
-(******************************************************************
- **********
- ********** BACKWARDS
- **********
- ********************************************************************)
-module type BackwardsTransfer = sig
- val name: string (* For debugging purposes, the name of the analysis *)
-
- val debug: bool ref (** Whether to turn on debugging *)
-
- type t (** The type of the data we compute for each block start. In many
- * presentations of backwards data flow analysis we maintain the
- * data at the block end. This is not easy to do with JVML because
- * a block has many exceptional ends. So we maintain the data for
- * the statement start. *)
-
- val pretty: unit -> t -> Pretty.doc (** Pretty-print the state *)
-
- val stmtStartData: t Inthash.t
- (** For each block id, the data at the start. This data structure must be
- * initialized with the initial data for each block *)
-
- val combineStmtStartData: Cil.stmt -> old:t -> t -> t option
- (** When the analysis reaches the start of a block, combine the old data
- * with the one we have just computed. Return None if the combination is
- * the same as the old data, otherwise return the combination. In the
- * latter case, the predecessors of the statement are put on the working
- * list. *)
-
-
- val combineSuccessors: t -> t -> t
- (** Take the data from two successors and combine it *)
-
-
- val doStmt: Cil.stmt -> t action
- (** The (backwards) transfer function for a branch. The {!Cil.currentLoc} is
- * set before calling this. If it returns None, then we have some default
- * handling. Otherwise, the returned data is the data before the branch
- * (not considering the exception handlers) *)
-
- val doInstr: Cil.instr -> t -> t action
- (** The (backwards) transfer function for an instruction. The
- * {!Cil.currentLoc} is set before calling this. If it returns None, then we
- * have some default handling. Otherwise, the returned data is the data
- * before the branch (not considering the exception handlers) *)
-
- val filterStmt: Cil.stmt -> Cil.stmt -> bool
- (** Whether to put this predecessor block in the worklist. We give the
- * predecessor and the block whose predecessor we are (and whose data has
- * changed) *)
-
-end
-
-module BackwardsDataFlow =
- functor (T : BackwardsTransfer) ->
- struct
-
- let getStmtStartData (s: stmt) : T.t =
- try IH.find T.stmtStartData s.sid
- with Not_found ->
- E.s (E.bug "BF(%s): stmtStartData is not initialized for %d"
- T.name s.sid)
-
- (** Process a statement and return true if the set of live return
- * addresses on its entry has changed. *)
- let processStmt (s: stmt) : bool =
- if !T.debug then
- ignore (E.log "FF(%s).stmt %d\n" T.name s.sid);
-
-
- (* Find the state before the branch *)
- currentLoc := get_stmtLoc s.skind;
- let d: T.t =
- match T.doStmt s with
- Done d -> d
- | (Default | Post _) as action -> begin
- (* Do the default one. Combine the successors *)
- let res =
- match s.succs with
- [] -> E.s (E.bug "You must doStmt for the statements with no successors")
- | fst :: rest ->
- List.fold_left (fun acc succ ->
- T.combineSuccessors acc (getStmtStartData succ))
- (getStmtStartData fst)
- rest
- in
- (* Now do the instructions *)
- let res' =
- match s.skind with
- Instr il ->
- (* Now scan the instructions in reverse order. This may
- * Stack_overflow on very long blocks ! *)
- let handleInstruction (i: instr) (s: T.t) : T.t =
- currentLoc := get_instrLoc i;
- (* First handle the instruction itself *)
- let action = T.doInstr i s in
- match action with
- | Done s' -> s'
- | Default -> s (* do nothing *)
- | Post f -> f s
- in
- (* Handle instructions starting with the last one *)
- List.fold_right handleInstruction il res
-
- | _ -> res
- in
- match action with
- Post f -> f res'
- | _ -> res'
- end
- in
-
- (* See if the state has changed. The only changes are that it may grow.*)
- let s0 = getStmtStartData s in
-
- match T.combineStmtStartData s ~old:s0 d with
- None -> (* The old data is good enough *)
- false
-
- | Some d' ->
- (* We have changed the data *)
- if !T.debug then
- ignore (E.log "BF(%s): set data for block %d: %a\n"
- T.name s.sid T.pretty d');
- IH.replace T.stmtStartData s.sid d';
- true
-
-
- (** Compute the data flow. Must have the CFG initialized *)
- let compute (sinks: stmt list) =
- let worklist: Cil.stmt Queue.t = Queue.create () in
- List.iter (fun s -> Queue.add s worklist) sinks;
- if !T.debug && not (Queue.is_empty worklist) then
- ignore (E.log "\nBF(%s): processing\n"
- T.name);
- let rec fixedpoint () =
- if !T.debug && not (Queue.is_empty worklist) then
- ignore (E.log "BF(%s): worklist= %a\n"
- T.name
- (docList (fun s -> num s.sid))
- (List.rev
- (Queue.fold (fun acc s -> s :: acc) [] worklist)));
- try
- let s = Queue.take worklist in
- let changes = processStmt s in
- if changes then begin
- (* We must add all predecessors of block b, only if not already
- * in and if the filter accepts them. *)
- List.iter
- (fun p ->
- if not (Queue.fold (fun exists s' -> exists || p.sid = s'.sid)
- false worklist) &&
- T.filterStmt p s then
- Queue.add p worklist)
- s.preds;
- end;
- fixedpoint ();
-
- with Queue.Empty ->
- if !T.debug then
- ignore (E.log "BF(%s): done\n\n" T.name)
- in
- fixedpoint ();
-
- end
-
-
diff --git a/cil/src/ext/dataflow.mli b/cil/src/ext/dataflow.mli
deleted file mode 100755
index e72c5db0196c1e84db86f64774ed4c7637d44a52..0000000000000000000000000000000000000000
--- a/cil/src/ext/dataflow.mli
+++ /dev/null
@@ -1,151 +0,0 @@
-(** A framework for data flow analysis for CIL code. Before using
- this framework, you must initialize the Control-flow Graph for your
- program, e.g using {!Cfg.computeFileCFG} *)
-
-type 't action =
- Default (** The default action *)
- | Done of 't (** Do not do the default action. Use this result *)
- | Post of ('t -> 't) (** The default action, followed by the given
- * transformer *)
-
-type 't stmtaction =
- SDefault (** The default action *)
- | SDone (** Do not visit this statement or its successors *)
- | SUse of 't (** Visit the instructions and successors of this statement
- as usual, but use the specified state instead of the
- one that was passed to doStmt *)
-
-(* For if statements *)
-type 't guardaction =
- GDefault (** The default state *)
- | GUse of 't (** Use this data for the branch *)
- | GUnreachable (** The branch will never be taken. *)
-
-
-(******************************************************************
- **********
- ********** FORWARDS
- **********
- ********************************************************************)
-
-module type ForwardsTransfer = sig
- val name: string (** For debugging purposes, the name of the analysis *)
-
- val debug: bool ref (** Whether to turn on debugging *)
-
- type t (** The type of the data we compute for each block start. May be
- * imperative. *)
-
- val copy: t -> t
- (** Make a deep copy of the data *)
-
-
- val stmtStartData: t Inthash.t
- (** For each statement id, the data at the start. Not found in the hash
- * table means nothing is known about the state at this point. At the end
- * of the analysis this means that the block is not reachable. *)
-
- val pretty: unit -> t -> Pretty.doc
- (** Pretty-print the state *)
-
- val computeFirstPredecessor: Cil.stmt -> t -> t
- (** Give the first value for a predecessors, compute the value to be set
- * for the block *)
-
- val combinePredecessors: Cil.stmt -> old:t -> t -> t option
- (** Take some old data for the start of a statement, and some new data for
- * the same point. Return None if the combination is identical to the old
- * data. Otherwise, compute the combination, and return it. *)
-
- val doInstr: Cil.instr -> t -> t action
- (** The (forwards) transfer function for an instruction. The
- * {!Cil.currentLoc} is set before calling this. The default action is to
- * continue with the state unchanged. *)
-
- val doStmt: Cil.stmt -> t -> t stmtaction
- (** The (forwards) transfer function for a statement. The {!Cil.currentLoc}
- * is set before calling this. The default action is to do the instructions
- * in this statement, if applicable, and continue with the successors. *)
-
- val doGuard: Cil.exp -> t -> t guardaction
- (** Generate the successor to an If statement assuming the given expression
- * is nonzero. Analyses that don't need guard information can return
- * GDefault; this is equivalent to returning GUse of the input.
- * A return value of GUnreachable indicates that this half of the branch
- * will not be taken and should not be explored. This will be called
- * twice per If, once for "then" and once for "else".
- *)
-
- val filterStmt: Cil.stmt -> bool
- (** Whether to put this statement in the worklist. This is called when a
- * block would normally be put in the worklist. *)
-
-end
-
-module ForwardsDataFlow (T : ForwardsTransfer) : sig
- val compute: Cil.stmt list -> unit
- (** Fill in the T.stmtStartData, given a number of initial statements to
- * start from. All of the initial statements must have some entry in
- * T.stmtStartData (i.e., the initial data should not be bottom) *)
-end
-
-(******************************************************************
- **********
- ********** BACKWARDS
- **********
- ********************************************************************)
-module type BackwardsTransfer = sig
- val name: string (** For debugging purposes, the name of the analysis *)
-
- val debug: bool ref (** Whether to turn on debugging *)
-
- type t (** The type of the data we compute for each block start. In many
- * presentations of backwards data flow analysis we maintain the
- * data at the block end. This is not easy to do with JVML because
- * a block has many exceptional ends. So we maintain the data for
- * the statement start. *)
-
- val pretty: unit -> t -> Pretty.doc (** Pretty-print the state *)
-
- val stmtStartData: t Inthash.t
- (** For each block id, the data at the start. This data structure must be
- * initialized with the initial data for each block *)
-
- val combineStmtStartData: Cil.stmt -> old:t -> t -> t option
- (** When the analysis reaches the start of a block, combine the old data
- * with the one we have just computed. Return None if the combination is
- * the same as the old data, otherwise return the combination. In the
- * latter case, the predecessors of the statement are put on the working
- * list. *)
-
-
- val combineSuccessors: t -> t -> t
- (** Take the data from two successors and combine it *)
-
-
- val doStmt: Cil.stmt -> t action
- (** The (backwards) transfer function for a branch. The {!Cil.currentLoc} is
- * set before calling this. If it returns None, then we have some default
- * handling. Otherwise, the returned data is the data before the branch
- * (not considering the exception handlers) *)
-
- val doInstr: Cil.instr -> t -> t action
- (** The (backwards) transfer function for an instruction. The
- * {!Cil.currentLoc} is set before calling this. If it returns None, then we
- * have some default handling. Otherwise, the returned data is the data
- * before the branch (not considering the exception handlers) *)
-
- val filterStmt: Cil.stmt -> Cil.stmt -> bool
- (** Whether to put this predecessor block in the worklist. We give the
- * predecessor and the block whose predecessor we are (and whose data has
- * changed) *)
-
-end
-
-module BackwardsDataFlow (T : BackwardsTransfer) : sig
- val compute: Cil.stmt list -> unit
- (** Fill in the T.stmtStartData, given a number of initial statements to
- * start from (the sinks for the backwards data flow). All of the statements
- * (not just the initial ones!) must have some entry in T.stmtStartData
- * (i.e., the initial data should not be bottom) *)
-end
diff --git a/cil/src/ext/dataslicing.ml b/cil/src/ext/dataslicing.ml
deleted file mode 100644
index 35390b40c1ed2dda289e91642462f5bf18823836..0000000000000000000000000000000000000000
--- a/cil/src/ext/dataslicing.ml
+++ /dev/null
@@ -1,462 +0,0 @@
-(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-
-(*
- *
- * Copyright (c) 2004,
- * Jeremy Condit <jcondit@cs.berkeley.edu>
- * George C. Necula <necula@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-open Cil
-open Pretty
-module E = Errormsg
-
-let debug = false
-
-let numRegions : int = 2
-
-let newGlobals : global list ref = ref []
-
-let curFundec : fundec ref = ref dummyFunDec
-let curLocation : location ref = ref locUnknown
-
-let applyOption (fn : 'a -> 'b) (ao : 'a option) : 'b option =
- match ao with
- | Some a -> Some (fn a)
- | None -> None
-
-let getRegion (attrs : attributes) : int =
- try
- match List.hd (filterAttributes "region" attrs) with
- | Attr (_, [AInt i]) -> i
- | _ -> E.s (bug "bad region attribute")
- with Failure _ ->
- 1
-
-let checkRegion (i : int) (attrs : attributes) : bool =
- (getRegion attrs) = i
-
-let regionField (i : int) : string =
- "r" ^ (string_of_int i)
-
-let regionStruct (i : int) (name : string) : string =
- name ^ "_r" ^ (string_of_int i)
-
-let foldRegions (fn : int -> 'a -> 'a) (base : 'a) : 'a =
- let rec helper (i : int) : 'a =
- if i <= numRegions then
- fn i (helper (i + 1))
- else
- base
- in
- helper 1
-
-let rec getTypeName (t : typ) : string =
- match t with
- | TVoid _ -> "void"
- | TInt _ -> "int"
- | TFloat _ -> "float"
- | TComp (cinfo, _) -> "comp_" ^ cinfo.cname
- | TNamed (tinfo, _) -> "td_" ^ tinfo.tname
- | TPtr (bt, _) -> "ptr_" ^ (getTypeName bt)
- | TArray (bt, _, _) -> "array_" ^ (getTypeName bt)
- | TFun _ -> "fn"
- | _ -> E.s (unimp "typename")
-
-let isAllocFunction (fn : exp) : bool =
- match fn with
- | Lval (Var vinfo, NoOffset) when vinfo.vname = "malloc" -> true
- | _ -> false
-
-let isExternalFunction (fn : exp) : bool =
- match fn with
- | Lval (Var vinfo, NoOffset) when vinfo.vstorage = Extern -> true
- | _ -> false
-
-let types : (int * typsig, typ) Hashtbl.t = Hashtbl.create 113
-let typeInfos : (int * string, typeinfo) Hashtbl.t = Hashtbl.create 113
-let compInfos : (int * int, compinfo) Hashtbl.t = Hashtbl.create 113
-let varTypes : (typsig, typ) Hashtbl.t = Hashtbl.create 113
-let varCompInfos : (typsig, compinfo) Hashtbl.t = Hashtbl.create 113
-
-let rec sliceCompInfo (i : int) (cinfo : compinfo) : compinfo =
- try
- Hashtbl.find compInfos (i, cinfo.ckey)
- with Not_found ->
- mkCompInfo cinfo.cstruct (regionStruct i cinfo.cname)
- (fun cinfo' ->
- Hashtbl.add compInfos (i, cinfo.ckey) cinfo';
- List.fold_right
- (fun finfo rest ->
- let t = sliceType i finfo.ftype in
- if not (isVoidType t) then
- (finfo.fname, t, finfo.fbitfield,
- finfo.fattr, finfo.floc) :: rest
- else
- rest)
- cinfo.cfields [])
- cinfo.cattr
-
-and sliceTypeInfo (i : int) (tinfo : typeinfo) : typeinfo =
- try
- Hashtbl.find typeInfos (i, tinfo.tname)
- with Not_found ->
- let result =
- { tinfo with tname = regionStruct i tinfo.tname;
- ttype = sliceType i tinfo.ttype; }
- in
- Hashtbl.add typeInfos (i, tinfo.tname) result;
- result
-
-and sliceType (i : int) (t : typ) : typ =
- let ts = typeSig t in
- try
- Hashtbl.find types (i, ts)
- with Not_found ->
- let result =
- match t with
- | TVoid _ -> t
- | TInt (_, attrs) -> if checkRegion i attrs then t else TVoid []
- | TFloat (_, attrs) -> if checkRegion i attrs then t else TVoid []
- | TComp (cinfo, attrs) -> TComp (sliceCompInfo i cinfo, attrs)
- | TNamed (tinfo, attrs) -> TNamed (sliceTypeInfo i tinfo, attrs)
- | TPtr (TVoid _, _) -> t (* Avoid discarding void*. *)
- | TPtr (bt, attrs) ->
- let bt' = sliceType i bt in
- if not (isVoidType bt') then TPtr (bt', attrs) else TVoid []
- | TArray (bt, eo, attrs) ->
- TArray (sliceType i bt, applyOption (sliceExp 1) eo, attrs)
- | TFun (ret, args, va, attrs) ->
- if checkRegion i attrs then
- TFun (sliceTypeAll ret,
- applyOption
- (List.map (fun (aname, atype, aattrs) ->
- (aname, sliceTypeAll atype, aattrs)))
- args,
- va, attrs)
- else
- TVoid []
- | TBuiltin_va_list _ -> t
- | _ -> E.s (unimp "type %a" d_type t)
- in
- Hashtbl.add types (i, ts) result;
- result
-
-and sliceTypeAll (t : typ) : typ =
- begin
- match t with
- | TComp (cinfo, _) when hasAttribute "var_type_sliced" cinfo.cattr ->
- E.s (bug "tried to slice twice")
- | _ -> ()
- end;
- let ts = typeSig t in
- try
- Hashtbl.find varTypes ts
- with Not_found ->
- let cinfo =
- let name = ("var_" ^ (getTypeName t)) in
- if debug then ignore (E.log "creating %s\n" name);
- try
- Hashtbl.find varCompInfos ts
- with Not_found ->
- mkCompInfo true name
- (fun cinfo ->
- Hashtbl.add varCompInfos ts cinfo;
- foldRegions
- (fun i rest ->
- let t' = sliceType i t in
- if not (isVoidType t') then
- (regionField i, t', None, [], !curLocation) :: rest
- else
- rest)
- [])
- [Attr ("var_type_sliced", [])]
- in
- let t' =
- if List.length cinfo.cfields > 1 then
- begin
- newGlobals := GCompTag (cinfo, !curLocation) :: !newGlobals;
- TComp (cinfo, [])
- end
- else
- t
- in
- Hashtbl.add varTypes ts t';
- t'
-
-and sliceLval (i : int) (lv : lval) : lval =
- if debug then ignore (E.log "lval %a\n" d_lval lv);
- let lh, offset = lv in
- match lh with
- | Var vinfo ->
- let t = sliceTypeAll vinfo.vtype in
- let offset' =
- match t with
- | TComp (cinfo, _) when hasAttribute "var_type_sliced" cinfo.cattr ->
- Field (getCompField cinfo (regionField i), offset)
- | _ -> offset
- in
- Var vinfo, offset'
- | Mem e ->
- Mem (sliceExp i e), offset
-
-and sliceExp (i : int) (e : exp) : exp =
- if debug then ignore (E.log "exp %a\n" d_exp e);
- match e with
- | Const c -> Const c
- | Lval lv -> Lval (sliceLval i lv)
- | UnOp (op, e1, t) -> UnOp (op, sliceExp i e1, sliceType i t)
- | BinOp (op, e1, e2, t) -> BinOp (op, sliceExp i e1, sliceExp i e2,
- sliceType i t)
- | CastE (t, e) -> sliceCast i t e
- | AddrOf lv -> AddrOf (sliceLval i lv)
- | StartOf lv -> StartOf (sliceLval i lv)
- | SizeOf t -> SizeOf (sliceTypeAll t)
- | _ -> E.s (unimp "exp %a" d_exp e)
-
-and sliceCast (i : int) (t : typ) (e : exp) : exp =
- let te = typeOf e in
- match t, te with
- | TInt (k1, _), TInt (k2, attrs2) when k1 = k2 ->
- (* Note: We strip off integer cast operations. *)
- sliceExp (getRegion attrs2) e
- | TInt (k1, _), TPtr _ ->
- (* Note: We strip off integer cast operations. *)
- sliceExp i e
- | TPtr _, _ when isZero e ->
- CastE (sliceType i t, sliceExp i e)
- | TPtr (bt1, _), TPtr (bt2, _) when (typeSig bt1) = (typeSig bt2) ->
- CastE (sliceType i t, sliceExp i e)
- | _ ->
- E.s (unimp "sketchy cast (%a) -> (%a)\n" d_type te d_type t)
-
-and sliceExpAll (e : exp) (l : location) : instr list * exp =
- let t = typeOf e in
- let t' = sliceTypeAll t in
- match t' with
- | TComp (cinfo, _) when hasAttribute "var_type_sliced" cinfo.cattr ->
- let vinfo = makeTempVar !curFundec t in
- let instrs =
- foldRegions
- (fun i rest ->
- try
- let finfo = getCompField cinfo (regionField i) in
- if not (isVoidType finfo.ftype) then
- Set ((Var vinfo, Field (finfo, NoOffset)),
- sliceExp i e, l) :: rest
- else
- rest
- with Not_found ->
- rest)
- []
- in
- instrs, Lval (var vinfo)
- | _ -> [], sliceExp 1 e
-
-let sliceVar (vinfo : varinfo) : unit =
- if hasAttribute "var_sliced" vinfo.vattr then
- E.s (bug "tried to slice a var twice");
- let t = sliceTypeAll vinfo.vtype in
- if debug then ignore (E.log "setting %s type to %a\n" vinfo.vname d_type t);
- vinfo.vattr <- addAttribute (Attr ("var_sliced", [])) vinfo.vattr;
- vinfo.vtype <- t
-
-let sliceInstr (inst : instr) : instr list =
- match inst with
- | Set (lv, e, loc) ->
- if debug then ignore (E.log "set %a %a\n" d_lval lv d_exp e);
- let t = typeOfLval lv in
- foldRegions
- (fun i rest ->
- if not (isVoidType (sliceType i t)) then
- Set (sliceLval i lv, sliceExp i e, loc) :: rest
- else
- rest)
- []
- | Call (ret, fn, args, l) when isAllocFunction fn ->
- let lv =
- match ret with
- | Some lv -> lv
- | None -> E.s (bug "malloc call has no return lval")
- in
- let t = typeOfLval lv in
- foldRegions
- (fun i rest ->
- if not (isVoidType (sliceType i t)) then
- Call (Some (sliceLval i lv), sliceExp 1 fn,
- List.map (sliceExp i) args, l) :: rest
- else
- rest)
- []
- | Call (ret, fn, args, l) when isExternalFunction fn ->
- [Call (applyOption (sliceLval 1) ret, sliceExp 1 fn,
- List.map (sliceExp 1) args, l)]
- | Call (ret, fn, args, l) ->
- let ret', set =
- match ret with
- | Some lv ->
- let vinfo = makeTempVar !curFundec (typeOfLval lv) in
- Some (var vinfo), [Set (lv, Lval (var vinfo), l)]
- | None ->
- None, []
- in
- let instrs, args' =
- List.fold_right
- (fun arg (restInstrs, restArgs) ->
- let instrs, arg' = sliceExpAll arg l in
- instrs @ restInstrs, (arg' :: restArgs))
- args ([], [])
- in
- instrs @ (Call (ret', sliceExp 1 fn, args', l) :: set)
- | _ -> E.s (unimp "inst %a" d_instr inst)
-
-let sliceReturnExp (eo : exp option) (l : location) : stmtkind =
- match eo with
- | Some e ->
- begin
- match sliceExpAll e l with
- | [], e' -> Return (Some e', l)
- | instrs, e' -> Block (mkBlock [mkStmt (Instr instrs);
- mkStmt (Return (Some e', l))])
- end
- | None -> Return (None, l)
-
-let rec sliceStmtKind (sk : stmtkind) : stmtkind =
- match sk with
- | Instr instrs -> Instr (List.flatten (List.map sliceInstr instrs))
- | Block b -> Block (sliceBlock b)
- | If (e, b1, b2, l) -> If (sliceExp 1 e, sliceBlock b1, sliceBlock b2, l)
- | Break l -> Break l
- | Continue l -> Continue l
- | Return (eo, l) -> sliceReturnExp eo l
- | Switch (e, b, sl, l) -> Switch (sliceExp 1 e, sliceBlock b,
- List.map sliceStmt sl, l)
-(*
- | Loop (b, l, so1, so2) -> Loop (sliceBlock b, l,
- applyOption sliceStmt so1,
- applyOption sliceStmt so2)
-*)
- | While (e, b, l) -> While (sliceExp 1 e, sliceBlock b, l)
- | DoWhile (e, b, l) -> DoWhile (sliceExp 1 e, sliceBlock b, l)
- | For (bInit, e, bIter, b, l) ->
- For (sliceBlock bInit, sliceExp 1e, sliceBlock bIter, sliceBlock b, l)
- | Goto _ -> sk
- | _ -> E.s (unimp "statement")
-
-and sliceStmt (s : stmt) : stmt =
- (* Note: We update statements destructively so that goto/switch work. *)
- s.skind <- sliceStmtKind s.skind;
- s
-
-and sliceBlock (b : block) : block =
- ignore (List.map sliceStmt b.bstmts);
- b
-
-let sliceFundec (fd : fundec) (l : location) : unit =
- curFundec := fd;
- curLocation := l;
- ignore (sliceBlock fd.sbody);
- curFundec := dummyFunDec;
- curLocation := locUnknown
-
-let sliceGlobal (g : global) : unit =
- match g with
- | GType (tinfo, l) ->
- newGlobals :=
- foldRegions (fun i rest -> GType (sliceTypeInfo i tinfo, l) :: rest)
- !newGlobals
- | GCompTag (cinfo, l) ->
- newGlobals :=
- foldRegions (fun i rest -> GCompTag (sliceCompInfo i cinfo, l) :: rest)
- !newGlobals
- | GCompTagDecl (cinfo, l) ->
- newGlobals :=
- foldRegions (fun i rest -> GCompTagDecl (sliceCompInfo i cinfo, l) ::
- rest)
- !newGlobals
- | GFun (fd, l) ->
- sliceFundec fd l;
- newGlobals := GFun (fd, l) :: !newGlobals
- | GVarDecl _
- | GVar _ ->
- (* Defer processing of vars until end. *)
- newGlobals := g :: !newGlobals
- | _ ->
- E.s (unimp "global %a\n" d_global g)
-
-let sliceGlobalVars (g : global) : unit =
- match g with
- | GFun (fd, l) ->
- curFundec := fd;
- curLocation := l;
- List.iter sliceVar fd.slocals;
- List.iter sliceVar fd.sformals;
- setFunctionType fd (sliceType 1 fd.svar.vtype);
- curFundec := dummyFunDec;
- curLocation := locUnknown;
- | GVar (vinfo, _, l) ->
- curLocation := l;
- sliceVar vinfo;
- curLocation := locUnknown
- | _ -> ()
-
-class dropAttrsVisitor = object
- inherit nopCilVisitor
-
- method vvrbl (vinfo : varinfo) =
- vinfo.vattr <- dropAttribute "var_sliced" vinfo.vattr;
- DoChildren
-
- method vglob (g : global) =
- begin
- match g with
- | GCompTag (cinfo, _) ->
- cinfo.cattr <- dropAttribute "var_type_sliced" cinfo.cattr;
- | _ -> ()
- end;
- DoChildren
-end
-
-let sliceFile (f : file) : unit =
- newGlobals := [];
- List.iter sliceGlobal f.globals;
- List.iter sliceGlobalVars f.globals;
- f.globals <- List.rev !newGlobals;
- visitCilFile (new dropAttrsVisitor) f
-
-let feature : featureDescr =
- { fd_name = "DataSlicing";
- fd_enabled = ref false;
- fd_description = "data slicing";
- fd_extraopt = [];
- fd_doit = sliceFile;
- fd_post_check = true;
- }
diff --git a/cil/src/ext/dataslicing.mli b/cil/src/ext/dataslicing.mli
deleted file mode 100644
index 00606484cffac41eb5b92c9188c386c1cfa998cc..0000000000000000000000000000000000000000
--- a/cil/src/ext/dataslicing.mli
+++ /dev/null
@@ -1,41 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * Jeremy Condit <jcondit@cs.berkeley.edu>
- * George C. Necula <necula@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* This feature implements data slicing. The user annotates base types
- * and function types with region(i) annotations, and this transformation
- * will separate the fields into parallel data structures accordingly. *)
-
-val feature: Cil.featureDescr
diff --git a/cil/src/ext/deadcodeelim.ml b/cil/src/ext/deadcodeelim.ml
deleted file mode 100644
index e560e01ded39a84d25d5d86189f9c654104e4309..0000000000000000000000000000000000000000
--- a/cil/src/ext/deadcodeelim.ml
+++ /dev/null
@@ -1,173 +0,0 @@
-(* Eliminate assignment instructions whose results are not
- used *)
-
-open Cil
-open Pretty
-
-module E = Errormsg
-module RD = Reachingdefs
-module UD = Usedef
-module IH = Inthash
-module S = Stats
-
-module IS = Set.Make(
- struct
- type t = int
- let compare = compare
- end)
-
-let debug = RD.debug
-
-
-let usedDefsSet = ref IS.empty
-(* put used def ids into usedDefsSet *)
-(* assumes reaching definitions have already been computed *)
-class usedDefsCollectorClass = object(self)
- inherit RD.rdVisitorClass
-
- method add_defids iosh e u =
- UD.VS.iter (fun vi ->
- if IH.mem iosh vi.vid then
- let ios = IH.find iosh vi.vid in
- if !debug then ignore(E.log "DCE: IOS size for vname=%s at stmt=%d: %d\n"
- vi.vname sid (RD.IOS.cardinal ios));
- RD.IOS.iter (function
- Some(i) ->
- if !debug then ignore(E.log "DCE: def %d used: %a\n" i d_plainexp e);
- usedDefsSet := IS.add i (!usedDefsSet)
- | None -> ()) ios
- else if !debug then ignore(E.log "DCE: vid %d:%s not in stm:%d iosh at %a\n"
- vi.vid vi.vname sid d_plainexp e)) u
-
- method vexpr e =
- let u = UD.computeUseExp e in
- match self#get_cur_iosh() with
- Some(iosh) -> self#add_defids iosh e u; DoChildren
- | None ->
- if !debug then ignore(E.log "DCE: use but no rd data: %a\n" d_plainexp e);
- DoChildren
-
- method vinst i =
- let handle_inst iosh i = match i with
- | Asm(_,_,slvl,_,_,_) -> List.iter (fun (s,lv) ->
- match lv with (Var v, off) ->
- if s.[0] = '+' then
- self#add_defids iosh (Lval(Var v, off)) (UD.VS.singleton v)
- | _ -> ()) slvl
- | _ -> ()
- in
- begin try
- cur_rd_dat <- Some(List.hd rd_dat_lst);
- rd_dat_lst <- List.tl rd_dat_lst
- with Failure "hd" -> ()
- end;
- match self#get_cur_iosh() with
- Some iosh -> handle_inst iosh i; DoChildren
- | None -> DoChildren
-
-end
-
-(***************************************************
- * Also need to find reads from volatiles
- * uses two functions I've put in ciltools which
- * are basically what Zach wrote, except one is for
- * types and one is for vars. Another difference is
- * they filter out pointers to volatiles. This
- * handles DMA
- ***************************************************)
-class hasVolatile flag = object (self)
- inherit nopCilVisitor
- method vlval l =
- let tp = typeOfLval l in
- if (Ciltools.is_volatile_tp tp) then flag := true;
- DoChildren
- method vexpr e =
- DoChildren
-end
-
-let exp_has_volatile e =
- let flag = ref false in
- ignore (visitCilExpr (new hasVolatile flag) e);
- !flag
- (***************************************************)
-
-let removedCount = ref 0
-(* Filter out instructions whose definition ids are not
- in usedDefsSet *)
-class uselessInstrElim : cilVisitor = object(self)
- inherit nopCilVisitor
-
- method vstmt stm =
-
- let test (i,(_,s,iosh)) =
- match i with
- Call _ -> true
- | Set((Var vi,NoOffset),e,_) ->
- if vi.vglob || (Ciltools.is_volatile_vi vi) || (exp_has_volatile e) then true else
- let _, defd = UD.computeUseDefInstr i in
- let rec loop n =
- if n < 0 then false else
- if IS.mem (n+s) (!usedDefsSet)
- then true
- else loop (n-1)
- in
- if loop (UD.VS.cardinal defd - 1)
- then true
- else (incr removedCount; false)
- | _ -> true
- in
-
- let filter il stmdat =
- let rd_dat_lst = RD.instrRDs il stm.sid stmdat false in
- let ildatlst = List.combine il rd_dat_lst in
- let ildatlst' = List.filter test ildatlst in
- let (newil,_) = List.split ildatlst' in
- newil
- in
-
- match RD.getRDs stm.sid with
- None -> DoChildren
- | Some(_,s,iosh) ->
- match stm.skind with
- Instr il ->
- stm.skind <- Instr(filter il ((),s,iosh));
- SkipChildren
- | _ -> DoChildren
-
-end
-
-(* until fixed point is reached *)
-let elim_dead_code_fp (fd : fundec) : fundec =
- (* fundec -> fundec *)
- let rec loop fd =
- usedDefsSet := IS.empty;
- removedCount := 0;
- S.time "reaching definitions" RD.computeRDs fd;
- ignore(visitCilFunction (new usedDefsCollectorClass :> cilVisitor) fd);
- let fd' = visitCilFunction (new uselessInstrElim) fd in
- if !removedCount = 0 then fd' else loop fd'
- in
- loop fd
-
-(* just once *)
-let elim_dead_code (fd : fundec) : fundec =
- (* fundec -> fundec *)
- usedDefsSet := IS.empty;
- removedCount := 0;
- S.time "reaching definitions" RD.computeRDs fd;
- ignore(visitCilFunction (new usedDefsCollectorClass :> cilVisitor) fd);
- let fd' = visitCilFunction (new uselessInstrElim) fd in
- fd'
-
-class deadCodeElimClass : cilVisitor = object(self)
- inherit nopCilVisitor
-
- method vfunc fd =
- let fd' = elim_dead_code fd in
- ChangeTo(fd')
-
-end
-
-let dce f =
- if !debug then ignore(E.log "DCE: starting dead code elimination\n");
- visitCilFile (new deadCodeElimClass) f
diff --git a/cil/src/ext/dominators.ml b/cil/src/ext/dominators.ml
deleted file mode 100755
index d838d23f8eb370e9cec3a003c511430023e2d36c..0000000000000000000000000000000000000000
--- a/cil/src/ext/dominators.ml
+++ /dev/null
@@ -1,241 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(** Compute dominator information for the statements in a function *)
-open Cil
-open Pretty
-module E = Errormsg
-module H = Hashtbl
-module U = Util
-module IH = Inthash
-
-module DF = Dataflow
-
-let debug = false
-
-(* For each statement we maintain a set of statements that dominate it *)
-module BS = Set.Make(struct
- type t = Cil.stmt
- let compare v1 v2 = Pervasives.compare v1.sid v2.sid
- end)
-
-
-
-
-(** Customization module for dominators *)
-module DT = struct
- let name = "dom"
-
- let debug = ref debug
-
- type t = BS.t
-
- (** For each statement in a function we keep the set of dominator blocks.
- * Indexed by statement id *)
- let stmtStartData: t IH.t = IH.create 17
-
- let copy (d: t) = d
-
- let pretty () (d: t) =
- dprintf "{%a}"
- (docList (fun s -> dprintf "%d" s.sid))
- (BS.elements d)
-
- let computeFirstPredecessor (s: stmt) (d: BS.t) : BS.t =
- (* Make sure we add this block to the set *)
- BS.add s d
-
- let combinePredecessors (s: stmt) ~(old: BS.t) (d: BS.t) : BS.t option =
- (* First, add this block to the data from the predecessor *)
- let d' = BS.add s d in
- if BS.subset old d' then
- None
- else
- Some (BS.inter old d')
-
- let doInstr (i: instr) (d: t) = DF.Default
-
- let doStmt (s: stmt) (d: t) = DF.SDefault
-
- let doGuard condition _ = DF.GDefault
-
-
- let filterStmt _ = true
-end
-
-
-
-module Dom = DF.ForwardsDataFlow(DT)
-
-let getStmtDominators (data: BS.t IH.t) (s: stmt) : BS.t =
- try IH.find data s.sid
- with Not_found -> BS.empty (* Not reachable *)
-
-
-let getIdom (idomInfo: stmt option IH.t) (s: stmt) =
- try IH.find idomInfo s.sid
- with Not_found ->
- E.s (E.bug "Immediate dominator information not set for statement %d"
- s.sid)
-
-(** Check whether one block dominates another. This assumes that the "idom"
- * field has been computed. *)
-let rec dominates (idomInfo: stmt option IH.t) (s1: stmt) (s2: stmt) =
- s1 == s2 ||
- (let s2idom = getIdom idomInfo s2 in
- match s2idom with
- None -> false
- | Some s2idom -> dominates idomInfo s1 s2idom)
-
-
-
-
-let computeIDom (f: fundec) : stmt option IH.t =
- (* We must prepare the CFG info first *)
- prepareCFG f;
- computeCFGInfo f false;
-
- IH.clear DT.stmtStartData;
- let idomData: stmt option IH.t = IH.create 13 in
-
- let _ =
- match f.sbody.bstmts with
- [] -> () (* function has no body *)
- | start :: _ -> begin
- (* We start with only the start block *)
- IH.add DT.stmtStartData start.sid (BS.singleton start);
-
- Dom.compute [start];
-
- (* Dump the dominators information *)
- if debug then
- List.iter
- (fun s ->
- let sdoms = getStmtDominators DT.stmtStartData s in
- if not (BS.mem s sdoms) then begin
- (* It can be that the block is not reachable *)
- if s.preds <> [] then
- E.s (E.bug "Statement %d is not in its list of dominators"
- s.sid);
- end;
- ignore (E.log "Dominators for %d: %a\n" s.sid
- DT.pretty (BS.remove s sdoms)))
- f.sallstmts;
-
- (* Now fill the immediate dominators for all nodes *)
- let rec fillOneIdom (s: stmt) =
- try
- ignore (IH.find idomData s.sid)
- (* Already set *)
- with Not_found -> begin
- (* Get the dominators *)
- let sdoms = getStmtDominators DT.stmtStartData s in
- (* Fill the idom for the dominators first *)
- let idom =
- BS.fold
- (fun d (sofar: stmt option) ->
- if d.sid = s.sid then
- sofar (* Ignore the block itself *)
- else begin
- (* fill the idom information recursively *)
- fillOneIdom d;
- match sofar with
- None -> Some d
- | Some sofar' ->
- (* See if d is dominated by sofar. We know that the
- * idom information has been computed for both sofar
- * and for d*)
- if dominates idomData sofar' d then
- Some d
- else
- sofar
- end)
- sdoms
- None
- in
- IH.replace idomData s.sid idom
- end
- in
- (* Scan all blocks and compute the idom *)
- List.iter fillOneIdom f.sallstmts
- end
- in
- idomData
-
-
-
-(** Compute the start of the natural loops. For each start, keep a list of
- * origin of a back edge. The loop consists of the loop start and all
- * predecessors of the origins of back edges, up to and including the loop
- * start *)
-let findNaturalLoops (f: fundec)
- (idomData: stmt option IH.t) : (stmt * stmt list) list =
- let loops =
- List.fold_left
- (fun acc b ->
- (* Iterate over all successors, and see if they are among the
- * dominators for this block *)
- List.fold_left
- (fun acc s ->
- if dominates idomData s b then
- (* s is the start of a natural loop *)
- let rec addNaturalLoop = function
- [] -> [(s, [b])]
- | (s', backs) :: rest when s'.sid = s.sid ->
- (s', b :: backs) :: rest
- | l :: rest -> l :: addNaturalLoop rest
- in
- addNaturalLoop acc
- else
- acc)
- acc
- b.succs)
- []
- f.sallstmts
- in
-
- if debug then
- ignore (E.log "Natural loops:\n%a\n"
- (docList ~sep:line
- (fun (s, backs) ->
- dprintf " Start: %d, backs:%a"
- s.sid
- (docList (fun b -> num b.sid))
- backs))
- loops);
-
- loops
diff --git a/cil/src/ext/dominators.mli b/cil/src/ext/dominators.mli
deleted file mode 100755
index 0abf82e94616a8794216cdfd7edb684862f8afe3..0000000000000000000000000000000000000000
--- a/cil/src/ext/dominators.mli
+++ /dev/null
@@ -1,29 +0,0 @@
-
-
-(** Compute dominators using data flow analysis *)
-(** Author: George Necula
- 5/28/2004
- **)
-
-(** Invoke on a code after filling in the CFG info and it computes the
- * immediate dominator information. We map each statement to its immediate
- * dominator (None for the start statement, and for the unreachable
- * statements). *)
-val computeIDom: Cil.fundec -> Cil.stmt option Inthash.t
-
-
-(** This is like Inthash.find but gives an error if the information is
- * Not_found *)
-val getIdom: Cil.stmt option Inthash.t -> Cil.stmt -> Cil.stmt option
-
-(** Check whether one statement dominates another. *)
-val dominates: Cil.stmt option Inthash.t -> Cil.stmt -> Cil.stmt -> bool
-
-
-(** Compute the start of the natural loops. This assumes that the "idom"
- * field has been computed. For each start, keep a list of origin of a back
- * edge. The loop consists of the loop start and all predecessors of the
- * origins of back edges, up to and including the loop start *)
-val findNaturalLoops: Cil.fundec ->
- Cil.stmt option Inthash.t ->
- (Cil.stmt * Cil.stmt list) list
diff --git a/cil/src/ext/epicenter.ml b/cil/src/ext/epicenter.ml
deleted file mode 100644
index a8045e855e302eda02b81666507123f0bb04ae9e..0000000000000000000000000000000000000000
--- a/cil/src/ext/epicenter.ml
+++ /dev/null
@@ -1,114 +0,0 @@
-(* epicenter.ml *)
-(* code for epicenter.mli *)
-
-(* module maintainer: scott *)
-(* see copyright at end of this file *)
-
-open Callgraph
-open Cil
-open Trace
-open Pretty
-module H = Hashtbl
-module IH = Inthash
-
-let sliceFile (f:file) (epicenter:string) (maxHops:int) : unit =
- (* compute the static call graph *)
- let graph:callgraph = (computeGraph f) in
-
- (* will accumulate here the set of names of functions already seen *)
- let seen: (string, unit) H.t = (H.create 117) in
-
- (* when removing "unused" symbols, keep all seen functions *)
- let isRoot : global -> bool = function
- | GFun ({svar = {vname = vname}}, _) ->
- H.mem seen vname
- | _ ->
- false
- in
-
- (* recursive depth-first search through the call graph, finding
- * all nodes within 'hops' hops of 'node' and marking them to
- * to be retained *)
- let rec dfs (node:callnode) (hops:int) : unit =
- (* only recurse if we haven't already marked this node *)
- if not (H.mem seen (nodeName node.cnInfo)) then
- begin
- (* add this node *)
- H.add seen (nodeName node.cnInfo) ();
- trace "epicenter" (dprintf "will keep %s\n" (nodeName node.cnInfo));
-
- (* if we cannot do any more hops, stop *)
- if (hops > 0) then
-
- (* recurse on all the node's callers and callees *)
- let recurse _ (adjacent:callnode) : unit =
- (dfs adjacent (hops - 1))
- in
- IH.iter recurse node.cnCallees;
- IH.iter recurse node.cnCallers
- end
- in
- dfs (Hashtbl.find graph epicenter) maxHops;
-
- (* finally, throw away anything we haven't decided to keep *)
- Cilutil.sliceGlobal := true;
- Rmtmps.removeUnusedTemps ~isRoot:isRoot f
-
-let doEpicenter = ref false
-let epicenterName = ref ""
-let epicenterHops = ref 0
-
-let feature : featureDescr =
- { fd_name = "epicenter";
- fd_enabled = doEpicenter;
- fd_description = "remove all functions except those within some number " ^
- "of hops (in the call graph) from a given function";
- fd_extraopt =
- [
- ("--epicenter-name",
- Arg.String (fun s -> epicenterName := s),
- "<name>: do an epicenter slice starting from function <name>");
- ("--epicenter-hops", Arg.Int (fun n -> epicenterHops := n),
- "<n>: specify max # of hops for epicenter slice");
- ];
-
- fd_doit =
- (fun f ->
- sliceFile f !epicenterName !epicenterHops);
-
- fd_post_check = true;
- }
-
-
-(*
- *
- * Copyright (c) 2001-2002 by
- * George C. Necula necula@cs.berkeley.edu
- * Scott McPeak smcpeak@cs.berkeley.edu
- * Wes Weimer weimer@cs.berkeley.edu
- * Ben Liblit liblit@cs.berkeley.edu
- *
- * All rights reserved. Permission to use, copy, modify and distribute
- * this software for research purposes only is hereby granted,
- * provided that the following conditions are met:
- * 1. XSRedistributions of source code must retain the above copyright notice,
- * this list of conditions and the following disclaimer.
- * 2. Redistributions in binary form must reproduce the above copyright notice,
- * this list of conditions and the following disclaimer in the documentation
- * and/or other materials provided with the distribution.
- * 3. The name of the authors may not be used to endorse or promote products
- * derived from this software without specific prior written permission.
- *
- * DISCLAIMER:
- * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
- * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
- * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
- * IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
- * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
- * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
- * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
- * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
- * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
- * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
diff --git a/cil/src/ext/heap.ml b/cil/src/ext/heap.ml
deleted file mode 100644
index 10f48a04534a27289178c0ac7424706bb2bd6d33..0000000000000000000000000000000000000000
--- a/cil/src/ext/heap.ml
+++ /dev/null
@@ -1,112 +0,0 @@
-(* See copyright notice at the end of the file *)
-
-(* The type of a heap (priority queue): keys are integers, data values
- * are whatever you like *)
-type ('a) t = {
- elements : (int * ('a option)) array ;
- mutable size : int ; (* current number of elements *)
- capacity : int ; (* max number of elements *)
-}
-
-let create size = {
- elements = Array.create (size+1) (max_int,None) ;
- size = 0 ;
- capacity = size ;
-}
-
-let clear heap = heap.size <- 0
-
-let is_full heap = (heap.size = heap.capacity)
-
-let is_empty heap = (heap.size = 0)
-
-let insert heap prio elt = begin
- if is_full heap then begin
- raise (Invalid_argument "Heap.insert")
- end ;
- heap.size <- heap.size + 1 ;
- let i = ref heap.size in
- while ( fst heap.elements.(!i / 2) < prio ) do
- heap.elements.(!i) <- heap.elements.(!i / 2) ;
- i := (!i / 2)
- done ;
- heap.elements.(!i) <- (prio,Some(elt))
- end
-
-let examine_max heap =
- if is_empty heap then begin
- raise (Invalid_argument "Heap.examine_max")
- end ;
- match heap.elements.(1) with
- p,Some(elt) -> p,elt
- | p,None -> failwith "Heap.examine_max"
-
-let extract_max heap = begin
- if is_empty heap then begin
- raise (Invalid_argument "Heap.extract_max")
- end ;
- let max = heap.elements.(1) in
- let last = heap.elements.(heap.size) in
- heap.size <- heap.size - 1 ;
- let i = ref 1 in
- let break = ref false in
- while (!i * 2 <= heap.size) && not !break do
- let child = ref (!i * 2) in
-
- (* find smaller child *)
- if (!child <> heap.size &&
- fst heap.elements.(!child+1) > fst heap.elements.(!child)) then begin
- incr child
- end ;
-
- (* percolate one level *)
- if (fst last < fst heap.elements.(!child)) then begin
- heap.elements.(!i) <- heap.elements.(!child) ;
- i := !child
- end else begin
- break := true
- end
- done ;
- heap.elements.(!i) <- last ;
- match max with
- p,Some(elt) -> p,elt
- | p,None -> failwith "Heap.examine_min"
- end
-
-
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
diff --git a/cil/src/ext/heapify.ml b/cil/src/ext/heapify.ml
deleted file mode 100644
index a583181e7bcb964d7ecaa479c8fed0efe3f88ec1..0000000000000000000000000000000000000000
--- a/cil/src/ext/heapify.ml
+++ /dev/null
@@ -1,250 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(*
- * Heapify: a program transform that looks over functions, finds those
- * that have local (stack) variables that contain arrays, puts all such
- * local variables into a single heap allocated structure, changes all
- * accesses to such variables into accesses to fields of that structure
- * and frees the structure on return.
- *)
-open Cil
-
-(* utilities that should be in Cil.ml *)
-(* sfg: this function appears to never be called *)
-let mkSimpleField ci fn ft fl =
- { fcomp = ci ; fname = fn ; ftype = ft ; fbitfield = None ; fattr = [];
- floc = fl }
-
-
-(* actual Heapify begins *)
-
-let heapifyNonArrays = ref false
-
-(* Does this local var contain an array? *)
-let rec containsArray (t:typ) : bool = (* does this type contain an array? *)
- match unrollType t with
- TArray _ -> true
- | TComp(ci, _) -> (* look at the types of the fields *)
- List.exists (fun fi -> containsArray fi.ftype) ci.cfields
- | _ ->
- (* Ignore other types, including TInt and TPtr. We don't care whether
- there are arrays in the base types of pointers; only about whether
- this local variable itself needs to be moved to the heap. *)
- false
-
-
-class heapifyModifyVisitor big_struct big_struct_fields varlist free
- (currentFunction: fundec) = object(self)
- inherit nopCilVisitor (* visit lvalues and statements *)
- method vlval l = match l with (* should we change this one? *)
- Var(vi),vi_offset when List.mem_assoc vi varlist -> (* check list *)
- let i = List.assoc vi varlist in (* find field offset *)
- let big_struct_field = List.nth big_struct_fields i in
- let new_lval = Mem(Lval(big_struct, NoOffset)),
- Field(big_struct_field,vi_offset) in (* rewrite the lvalue *)
- ChangeDoChildrenPost(new_lval, (fun l -> l))
- | _ -> DoChildren (* ignore other lvalues *)
- method vstmt s = match s.skind with (* also rewrite the return *)
- Return(None,loc) ->
- let free_instr = Call(None,free,[Lval(big_struct,NoOffset)],loc) in
- self#queueInstr [free_instr]; (* insert free_instr before the return *)
- DoChildren
- | Return(Some exp ,loc) ->
- (* exp may depend on big_struct, so evaluate it before calling free.
- * This becomes: tmp = exp; free(big_struct); return tmp; *)
- let exp_new = visitCilExpr (self :> cilVisitor) exp in
- let ret_tmp = makeTempVar currentFunction (typeOf exp_new) in
- let eval_ret_instr = Set(var ret_tmp, exp_new, loc) in
- let free_instr = Call(None,free,[Lval(big_struct,NoOffset)],loc) in
- (* insert the instructions before the return *)
- self#queueInstr [eval_ret_instr; free_instr];
- s.skind <- (Return(Some(Lval(var ret_tmp)), loc));
- DoChildren
- | _ -> DoChildren (* ignore other statements *)
-end
-
-class heapifyAnalyzeVisitor f alloc free = object
- inherit nopCilVisitor (* only look at function bodies *)
- method vglob gl = match gl with
- GFun(fundec,funloc) ->
- let counter = ref 0 in (* the number of local vars containing arrays *)
- let varlist = ref [] in (* a list of (var,id) pairs, in reverse order *)
- List.iter (fun vi ->
- (* find all local vars with arrays. If the user requests it,
- we also look for non-array vars whose address is taken. *)
- if (containsArray vi.vtype) || (vi.vaddrof && !heapifyNonArrays)
- then begin
- varlist := (vi,!counter) :: !varlist ; (* add it to the list *)
- incr counter (* put the next such var in the next slot *)
- end
- ) fundec.slocals ;
- if (!varlist <> []) then begin (* some local vars contain arrays *)
- let name = (fundec.svar.vname ^ "_heapify") in
- let ci = mkCompInfo true name (* make a big structure *)
- (fun _ -> List.rev_map (* reverse the list to fix the order *)
- (* each local var becomes a field *)
- (fun (vi,i) -> vi.vname,vi.vtype,None,[],vi.vdecl) !varlist) [] in
- let vi = makeLocalVar fundec name (TPtr(TComp(ci,[]),[])) in
- let modify = new heapifyModifyVisitor (Var(vi)) ci.cfields
- !varlist free fundec in (* rewrite accesses to local vars *)
- fundec.sbody <- visitCilBlock modify fundec.sbody ;
- let alloc_stmt = mkStmt (* allocate the big struct on the heap *)
- (Instr [Call(Some(Var(vi),NoOffset), alloc,
- [SizeOf(TComp(ci,[]))],funloc)]) in
- fundec.sbody.bstmts <- alloc_stmt :: fundec.sbody.bstmts ;
- fundec.slocals <- List.filter (fun vi -> (* remove local vars *)
- not (List.mem_assoc vi !varlist)) fundec.slocals ;
- let typedec = (GCompTag(ci,funloc)) in (* declare the big struct *)
- ChangeTo([typedec ; GFun(fundec,funloc)]) (* done! *)
- end else
- DoChildren (* ignore everything else *)
- | _ -> DoChildren
-end
-
-let heapify (f : file) (alloc : exp) (free : exp) =
- visitCilFile (new heapifyAnalyzeVisitor f alloc free) f;
- f
-
-(* heapify code ends here *)
-
-let default_heapify (f : file) =
- let alloc_fun = emptyFunction "malloc" in
- let free_fun = emptyFunction "free" in
- let alloc_exp = (Lval((Var(alloc_fun.svar)),NoOffset)) in
- let free_exp = (Lval((Var(free_fun.svar)),NoOffset)) in
- ignore (heapify f alloc_exp free_exp)
-
-(* StackGuard clone *)
-
-class sgModifyVisitor restore_ra_stmt = object
- inherit nopCilVisitor
- method vstmt s = match s.skind with (* also rewrite the return *)
- Return(_,loc) -> let new_block = mkBlock [restore_ra_stmt ; s] in
- ChangeTo(mkStmt (Block(new_block)))
- | _ -> DoChildren (* ignore other statements *)
-end
-
-class sgAnalyzeVisitor f push pop get_ra set_ra = object
- inherit nopCilVisitor
- method vfunc fundec =
- let needs_guarding = List.fold_left
- (fun acc vi -> acc || containsArray vi.vtype)
- false fundec.slocals in
- if needs_guarding then begin
- let ra_tmp = makeLocalVar fundec "return_address" voidPtrType in
- let ra_exp = Lval(Var(ra_tmp),NoOffset) in
- let save_ra_stmt = mkStmt (* save the current return address *)
- (Instr [Call(Some(Var(ra_tmp),NoOffset), get_ra, [], locUnknown) ;
- Call(None, push, [ra_exp], locUnknown)]) in
- let restore_ra_stmt = mkStmt (* restore the old return address *)
- (Instr [Call(Some(Var(ra_tmp),NoOffset), pop, [], locUnknown) ;
- Call(None, set_ra, [ra_exp], locUnknown)]) in
- let modify = new sgModifyVisitor restore_ra_stmt in
- fundec.sbody <- visitCilBlock modify fundec.sbody ;
- fundec.sbody.bstmts <- save_ra_stmt :: fundec.sbody.bstmts ;
- ChangeTo(fundec) (* done! *)
- end else DoChildren
-end
-
-let stackguard (f : file) (push : exp) (pop : exp)
- (get_ra : exp) (set_ra : exp) =
- visitCilFileSameGlobals (new sgAnalyzeVisitor f push pop get_ra set_ra) f;
- f
- (* stackguard code ends *)
-
-let default_stackguard (f : file) =
- let expify fundec = Lval(Var(fundec.svar),NoOffset) in
- let push = expify (emptyFunction "stackguard_push") in
- let pop = expify (emptyFunction "stackguard_pop") in
- let get_ra = expify (emptyFunction "stackguard_get_ra") in
- let set_ra = expify (emptyFunction "stackguard_set_ra") in
- let global_decl =
-"extern void * stackguard_get_ra();
-extern void stackguard_set_ra(void *new_ra);
-/* You must provide an implementation for functions that get and set the
- * return address. Such code is unfortunately architecture specific.
- */
-struct stackguard_stack {
- void * data;
- struct stackguard_stack * next;
-} * stackguard_stack;
-
-void stackguard_push(void *ra) {
- void * old = stackguard_stack;
- stackguard_stack = (struct stackguard_stack *)
- malloc(sizeof(stackguard_stack));
- stackguard_stack->data = ra;
- stackguard_stack->next = old;
-}
-
-void * stackguard_pop() {
- void * ret = stackguard_stack->data;
- void * next = stackguard_stack->next;
- free(stackguard_stack);
- stackguard_stack->next = next;
- return ret;
-}" in
- f.globals <- GText(global_decl) :: f.globals ;
- ignore (stackguard f push pop get_ra set_ra )
-
-
-let feature1 : featureDescr =
- { fd_name = "stackGuard";
- fd_enabled = Cilutil.doStackGuard;
- fd_description = "instrument function calls and returns to maintain a separate stack for return addresses" ;
- fd_extraopt = [];
- fd_doit = (function (f: file) -> default_stackguard f);
- fd_post_check = true;
- }
-let feature2 : featureDescr =
- { fd_name = "heapify";
- fd_enabled = Cilutil.doHeapify;
- fd_description = "move stack-allocated arrays to the heap" ;
- fd_extraopt = [
- "--heapifyAll", Arg.Set heapifyNonArrays,
- "When using heapify, move all local vars whose address is taken, not just arrays.";
- ];
- fd_doit = (function (f: file) -> default_heapify f);
- fd_post_check = true;
- }
-
-
-
-
-
-
diff --git a/cil/src/ext/liveness.ml b/cil/src/ext/liveness.ml
deleted file mode 100644
index 72cd607322f2af28a16df341cdd9e5078e86cd3e..0000000000000000000000000000000000000000
--- a/cil/src/ext/liveness.ml
+++ /dev/null
@@ -1,190 +0,0 @@
-
-(* Calculate which variables are live at
- * each statememnt.
- *
- *
- *
- *)
-
-open Cil
-open Pretty
-
-module DF = Dataflow
-module UD = Usedef
-module IH = Inthash
-module E = Errormsg
-
-let debug = ref false
-
-let live_label = ref ""
-let live_func = ref ""
-
-module VS = UD.VS
-
-let debug_print () vs = (VS.fold
- (fun vi d ->
- d ++ text "name: " ++ text vi.vname
- ++ text " id: " ++ num vi.vid ++ text " ")
- vs nil) ++ line
-
-let min_print () vs = (VS.fold
- (fun vi d ->
- d ++ text vi.vname
- ++ text "(" ++ d_type () vi.vtype ++ text ")"
- ++ text ",")
- vs nil) ++ line
-
-let printer = ref debug_print
-
-module LiveFlow = struct
- let name = "Liveness"
- let debug = debug
- type t = VS.t
-
- let pretty () vs =
- let fn = !printer in
- fn () vs
-
- let stmtStartData = IH.create 32
-
- let combineStmtStartData (stm:stmt) ~(old:t) (now:t) =
- if not(VS.compare old now = 0)
- then Some(VS.union old now)
- else None
-
- let combineSuccessors = VS.union
-
- let doStmt stmt =
- if !debug then ignore(E.log "looking at: %a\n" d_stmt stmt);
- match stmt.succs with
- [] -> let u,d = UD.computeUseDefStmtKind stmt.skind in
- if !debug then ignore(E.log "doStmt: no succs %d\n" stmt.sid);
- DF.Done u
- | _ ->
- let handle_stm vs = match stmt.skind with
- Instr _ -> vs
- | s -> let u, d = UD.computeUseDefStmtKind s in
- VS.union u (VS.diff vs d)
- in
- DF.Post handle_stm
-
- let doInstr i vs =
- let transform vs' =
- let u,d = UD.computeUseDefInstr i in
- VS.union u (VS.diff vs' d)
- in
- DF.Post transform
-
- let filterStmt stm1 stm2 = true
-
-end
-
-module L = DF.BackwardsDataFlow(LiveFlow)
-
-let sink_stmts = ref []
-class sinkFinderClass = object(self)
- inherit nopCilVisitor
-
- method vstmt s = match s.succs with
- [] -> (sink_stmts := s :: (!sink_stmts);
- DoChildren)
- | _ -> DoChildren
-
-end
-
-(* gives list of return statements from a function *)
-(* fundec -> stm list *)
-let find_sinks fdec =
- sink_stmts := [];
- ignore(visitCilFunction (new sinkFinderClass) fdec);
- !sink_stmts
-
-(* XXX: This does not compute the best ordering to
- * give to the work-list algorithm.
- *)
-let all_stmts = ref []
-class nullAdderClass = object(self)
- inherit nopCilVisitor
-
- method vstmt s =
- all_stmts := s :: (!all_stmts);
- IH.add LiveFlow.stmtStartData s.sid VS.empty;
- DoChildren
-
-end
-
-let null_adder fdec =
- ignore(visitCilFunction (new nullAdderClass) fdec);
- !all_stmts
-
-let computeLiveness fdec =
- IH.clear LiveFlow.stmtStartData;
- UD.onlyNoOffsetsAreDefs := false;
- all_stmts := [];
- let a = null_adder fdec in
- L.compute a
-
-let print_everything () =
- let d = IH.fold (fun i vs d ->
- d ++ num i ++ text ": " ++ LiveFlow.pretty () vs)
- LiveFlow.stmtStartData nil in
- ignore(printf "%t" (fun () -> d))
-
-let match_label lbl = match lbl with
- Label(str,_,b) ->
- if !debug then ignore(E.log "Liveness: label seen: %s\n" str);
- (*b && *)(String.compare str (!live_label) = 0)
-| _ -> false
-
-class doFeatureClass = object(self)
- inherit nopCilVisitor
-
- method vfunc fd =
- if String.compare fd.svar.vname (!live_func) = 0 then
- (Cfg.clearCFGinfo fd;
- ignore(Cfg.cfgFun fd);
- computeLiveness fd;
- if String.compare (!live_label) "" = 0 then
- (printer := min_print;
- print_everything();
- SkipChildren)
- else DoChildren)
- else SkipChildren
-
- method vstmt s =
- if List.exists match_label s.labels then try
- let vs = IH.find LiveFlow.stmtStartData s.sid in
- (printer := min_print;
- ignore(printf "%a" LiveFlow.pretty vs);
- SkipChildren)
- with Not_found ->
- if !debug then ignore(E.log "Liveness: stmt: %d not found\n" s.sid);
- DoChildren
- else
- (if List.length s.labels = 0 then
- if !debug then ignore(E.log "Liveness: no label at sid=%d\n" s.sid);
- DoChildren)
-
-end
-
-let do_live_feature (f:file) =
- visitCilFile (new doFeatureClass) f
-
-let feature =
- {
- fd_name = "Liveness";
- fd_enabled = ref false;
- fd_description = "Spit out live variables at a label";
- fd_extraopt = [
- "--live_label",
- Arg.String (fun s -> live_label := s),
- "Output the variables live at this label";
- "--live_func",
- Arg.String (fun s -> live_func := s),
- "Output the variables live at each statement in this function.";
- "--live_debug",
- Arg.Unit (fun n -> debug := true),
- "Print lots of debugging info";];
- fd_doit = do_live_feature;
- fd_post_check = false
- }
diff --git a/cil/src/ext/logcalls.ml b/cil/src/ext/logcalls.ml
deleted file mode 100644
index 0cdbc1532d2270bca53b6658245fa31bddc2d2b5..0000000000000000000000000000000000000000
--- a/cil/src/ext/logcalls.ml
+++ /dev/null
@@ -1,268 +0,0 @@
-(** See copyright notice at the end of this file *)
-
-(** Add printf before each function call *)
-
-open Pretty
-open Cil
-open Trace
-module E = Errormsg
-module H = Hashtbl
-
-let i = ref 0
-let name = ref ""
-
-(* Switches *)
-let printFunctionName = ref "printf"
-
-let addProto = ref false
-
-let printf: varinfo option ref = ref None
-let makePrintfFunction () : varinfo =
- match !printf with
- Some v -> v
- | None -> begin
- let v = makeGlobalVar !printFunctionName
- (TFun(voidType, Some [("format", charPtrType, [])],
- true, [])) in
- printf := Some v;
- addProto := true;
- v
- end
-
-let mkPrint (format: string) (args: exp list) : instr =
- let p: varinfo = makePrintfFunction () in
- Call(None, Lval(var p), (mkString format) :: args, !currentLoc)
-
-
-let d_string (fmt : ('a,unit,doc,string) format4) : 'a =
- let f (d: doc) : string =
- Pretty.sprint 200 d
- in
- Pretty.gprintf f fmt
-
-let currentFunc: string ref = ref ""
-
-class logCallsVisitorClass = object
- inherit nopCilVisitor
-
- (* Watch for a declaration for our printer *)
-
- method vinst i = begin
- match i with
- | Call(lo,e,al,l) ->
- let pre = mkPrint (d_string "call %a\n" d_exp e) [] in
- let post = mkPrint (d_string "return from %a\n" d_exp e) [] in
-(*
- let str1 = prefix ^
- (Pretty.sprint 800 ( Pretty.dprintf "Calling %a(%a)\n"
- d_exp e
- (docList ~sep:(chr ',' ++ break ) (fun arg ->
- try
- match unrollType (typeOf arg) with
- TInt _ | TEnum _ -> dprintf "%a = %%d" d_exp arg
- | TFloat _ -> dprintf "%a = %%g" d_exp arg
- | TVoid _ -> text "void"
- | TComp _ -> text "comp"
- | _ -> dprintf "%a = %%p" d_exp arg
- with _ -> dprintf "%a = %%p" d_exp arg)) al)) in
- let log_args = List.filter (fun arg ->
- match unrollType (typeOf arg) with
- TVoid _ | TComp _ -> false
- | _ -> true) al in
- let str2 = prefix ^ (Pretty.sprint 800
- ( Pretty.dprintf "Returned from %a\n" d_exp e)) in
- let newinst str args = ((Call (None, Lval(var printfFun.svar),
- ( [ (* one ; *) mkString str ] @ args),
- locUnknown)) : instr )in
- let ilist = ([ (newinst str1 log_args) ; i ; (newinst str2 []) ] : instr list) in
- *)
- ChangeTo [ pre; i; post ]
-
- | _ -> DoChildren
- end
- method vstmt (s : stmt) = begin
- match s.skind with
- Return _ ->
- let pre = mkPrint (d_string "exit %s\n" !currentFunc) [] in
- ChangeTo (mkStmt (Block (mkBlock [ mkStmtOneInstr pre; s ])))
- | _ -> DoChildren
-
-(*
-(Some(e),l) ->
- let str = prefix ^ Pretty.sprint 800 ( Pretty.dprintf
- "Return(%%p) from %s\n" funstr ) in
- let newinst = ((Call (None, Lval(var printfFun.svar),
- ( [ (* one ; *) mkString str ; e ]),
- locUnknown)) : instr )in
- let new_stmt = mkStmtOneInstr newinst in
- let slist = [ new_stmt ; s ] in
- (ChangeTo(mkStmt(Block(mkBlock slist))))
- | Return(None,l) ->
- let str = prefix ^ (Pretty.sprint 800 ( Pretty.dprintf
- "Return void from %s\n" funstr)) in
- let newinst = ((Call (None, Lval(var printfFun.svar),
- ( [ (* one ; *) mkString str ]),
- locUnknown)) : instr )in
- let new_stmt = mkStmtOneInstr newinst in
- let slist = [ new_stmt ; s ] in
- (ChangeTo(mkStmt(Block(mkBlock slist))))
- | _ -> DoChildren
-*)
- end
-end
-
-let logCallsVisitor = new logCallsVisitorClass
-
-
-let logCalls (f: file) : unit =
-
- let doGlobal = function
- | GVarDecl (v, _) when v.vname = !printFunctionName ->
- if !printf = None then
- printf := Some v
-
- | GFun (fdec, loc) ->
- currentFunc := fdec.svar.vname;
- (* do the body *)
- ignore (visitCilFunction logCallsVisitor fdec);
- (* Now add the entry instruction *)
- let pre = mkPrint (d_string "enter %s\n" !currentFunc) [] in
- fdec.sbody <-
- mkBlock [ mkStmtOneInstr pre;
- mkStmt (Block fdec.sbody) ]
-(*
- (* debugging 'anagram', it's really nice to be able to see the strings *)
- (* inside fat pointers, even if it's a bit of a hassle and a hack here *)
- let isFatCharPtr (cinfo:compinfo) =
- cinfo.cname="wildp_char" ||
- cinfo.cname="fseqp_char" ||
- cinfo.cname="seqp_char" in
-
- (* Collect expressions that denote the actual arguments *)
- let actargs =
- (* make lvals out of args which pass test below *)
- (List.map
- (fun vi -> match unrollType vi.vtype with
- | TComp(cinfo, _) when isFatCharPtr(cinfo) ->
- (* access the _p field for these *)
- (* luckily it's called "_p" in all three fat pointer variants *)
- Lval(Var(vi), Field(getCompField cinfo "_p", NoOffset))
- | _ ->
- Lval(var vi))
-
- (* decide which args to pass *)
- (List.filter
- (fun vi -> match unrollType vi.vtype with
- | TPtr(TInt(k, _), _) when isCharType(k) ->
- !printPtrs || !printStrings
- | TComp(cinfo, _) when isFatCharPtr(cinfo) ->
- !printStrings
- | TVoid _ | TComp _ -> false
- | TPtr _ | TArray _ | TFun _ -> !printPtrs
- | _ -> true)
- fdec.sformals)
- ) in
-
- (* make a format string for printing them *)
- (* sm: expanded width to 200 because I want one per line *)
- let formatstr = prefix ^ (Pretty.sprint 200
- (dprintf "entering %s(%a)\n" fdec.svar.vname
- (docList ~sep:(chr ',' ++ break)
- (fun vi -> match unrollType vi.vtype with
- | TInt _ | TEnum _ -> dprintf "%s = %%d" vi.vname
- | TFloat _ -> dprintf "%s = %%g" vi.vname
- | TVoid _ -> dprintf "%s = (void)" vi.vname
- | TComp(cinfo, _) -> (
- if !printStrings && isFatCharPtr(cinfo) then
- dprintf "%s = \"%%s\"" vi.vname
- else
- dprintf "%s = (comp)" vi.vname
- )
- | TPtr(TInt(k, _), _) when isCharType(k) -> (
- if (!printStrings) then
- dprintf "%s = \"%%s\"" vi.vname
- else if (!printPtrs) then
- dprintf "%s = %%p" vi.vname
- else
- dprintf "%s = (str)" vi.vname
- )
- | TPtr _ | TArray _ | TFun _ -> (
- if (!printPtrs) then
- dprintf "%s = %%p" vi.vname
- else
- dprintf "%s = (ptr)" vi.vname
- )
- | _ -> dprintf "%s = (?type?)" vi.vname))
- fdec.sformals)) in
-
- i := 0 ;
- name := fdec.svar.vname ;
- if !allInsts then (
- let thisVisitor = new verboseLogVisitor printfFun !name prefix in
- fdec.sbody <- visitCilBlock thisVisitor fdec.sbody
- );
- fdec.sbody.bstmts <-
- mkStmt (Instr [Call (None, Lval(var printfFun.svar),
- ( (* one :: *) mkString formatstr
- :: actargs),
- loc)]) :: fdec.sbody.bstmts
- *)
- | _ -> ()
- in
- Stats.time "logCalls" (iterGlobals f) doGlobal;
- if !addProto then begin
- let p = makePrintfFunction () in
- E.log "Adding prototype for call logging function %s\n" p.vname;
- f.globals <- GVarDecl (p, locUnknown) :: f.globals
- end
-
-let feature : featureDescr =
- { fd_name = "logcalls";
- fd_enabled = Cilutil.logCalls;
- fd_description = "generation of code to log function calls";
- fd_extraopt = [
- ("--logcallprintf", Arg.String (fun s -> printFunctionName := s),
- "the name of the printf function to use");
- ("--logcalladdproto", Arg.Unit (fun s -> addProto := true),
- "whether to add the prototype for the printf function")
- ];
- fd_doit = logCalls;
- fd_post_check = true
- }
-
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
diff --git a/cil/src/ext/logcalls.mli b/cil/src/ext/logcalls.mli
deleted file mode 100644
index 22a1e96add98c9af2aa67ae4abf1a4b406343a5d..0000000000000000000000000000000000000000
--- a/cil/src/ext/logcalls.mli
+++ /dev/null
@@ -1,41 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-
-(* A simple CIL transformer that inserts calls to a runtime function to log
- * the call in each function *)
-val feature: Cil.featureDescr
diff --git a/cil/src/ext/logwrites.ml b/cil/src/ext/logwrites.ml
deleted file mode 100644
index 3afd0679e1de19d3b5f2461019e4b7a1f1e89b3e..0000000000000000000000000000000000000000
--- a/cil/src/ext/logwrites.ml
+++ /dev/null
@@ -1,139 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-open Pretty
-open Cil
-module E = Errormsg
-module H = Hashtbl
-
-(* David Park at Stanford points out that you cannot take the address of a
- * bitfield in GCC. *)
-
-(* Returns true if the given lvalue offset ends in a bitfield access. *)
-let rec is_bitfield lo = match lo with
- | NoOffset -> false
- | Field(fi,NoOffset) -> not (fi.fbitfield = None)
- | Field(_,lo) -> is_bitfield lo
- | Index(_,lo) -> is_bitfield lo
-
-(* Return an expression that evaluates to the address of the given lvalue.
- * For most lvalues, this is merely AddrOf(lv). However, for bitfields
- * we do some offset gymnastics.
- *)
-let addr_of_lv (lh,lo) =
- if is_bitfield lo then begin
- (* we figure out what the address would be without the final bitfield
- * access, and then we add in the offset of the bitfield from the
- * beginning of its enclosing comp *)
- let rec split_offset_and_bitfield lo = match lo with
- | NoOffset -> failwith "logwrites: impossible"
- | Field(fi,NoOffset) -> (NoOffset,fi)
- | Field(e,lo) -> let a,b = split_offset_and_bitfield lo in
- ((Field(e,a)),b)
- | Index(e,lo) -> let a,b = split_offset_and_bitfield lo in
- ((Index(e,a)),b)
- in
- let new_lv_offset, bf = split_offset_and_bitfield lo in
- let new_lv = (lh, new_lv_offset) in
- let enclosing_type = TComp(bf.fcomp, []) in
- let bits_offset, bits_width =
- bitsOffset enclosing_type (Field(bf,NoOffset)) in
- let bytes_offset = bits_offset / 8 in
- let lvPtr = mkCast ~e:(mkAddrOf (new_lv)) ~newt:(charPtrType) in
- (BinOp(PlusPI, lvPtr, (integer bytes_offset), ulongType))
- end else (AddrOf (lh,lo))
-
-class logWriteVisitor = object
- inherit nopCilVisitor
- (* Create a prototype for the logging function, but don't put it in the
- * file *)
- val printfFun =
- let fdec = emptyFunction "syslog" in
- fdec.svar.vtype <- TFun(intType,
- Some [ ("prio", intType, []);
- ("format", charConstPtrType, []) ],
- true, []);
- fdec
-
- method vinst (i: instr) : instr list visitAction =
- match i with
- Set(lv, e, l) -> begin
- (* Check if we need to log *)
- match lv with
- (Var(v), off) when not v.vglob -> SkipChildren
- | _ -> let str = Pretty.sprint 80
- (Pretty.dprintf "Write %%p to 0x%%08x at %%s:%%d (%a)\n" d_lval lv)
- in
- ChangeTo
- [ Call((None), (Lval(Var(printfFun.svar),NoOffset)),
- [ one ;
- mkString str ; e ; addr_of_lv lv;
- mkString l.file;
- integer l.line], locUnknown);
- i]
- end
- | Call(Some lv, f, args, l) -> begin
- (* Check if we need to log *)
- match lv with
- (Var(v), off) when not v.vglob -> SkipChildren
- | _ -> let str = Pretty.sprint 80
- (Pretty.dprintf "Write retval to 0x%%08x at %%s:%%d (%a)\n" d_lval lv)
- in
- ChangeTo
- [ Call((None), (Lval(Var(printfFun.svar),NoOffset)),
- [ one ;
- mkString str ; AddrOf lv;
- mkString l.file;
- integer l.line], locUnknown);
- i]
- end
- | _ -> SkipChildren
-
-end
-
-let feature : featureDescr =
- { fd_name = "logwrites";
- fd_enabled = Cilutil.logWrites;
- fd_description = "generation of code to log memory writes";
- fd_extraopt = [];
- fd_doit =
- (function (f: file) ->
- let lwVisitor = new logWriteVisitor in
- visitCilFileSameGlobals lwVisitor f);
- fd_post_check = true;
- }
-
diff --git a/cil/src/ext/oneret.ml b/cil/src/ext/oneret.ml
deleted file mode 100644
index b3ce4a10f82c25fea9e84bec94771b227155590b..0000000000000000000000000000000000000000
--- a/cil/src/ext/oneret.ml
+++ /dev/null
@@ -1,187 +0,0 @@
-(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* Make sure that there is exactly one Return statement in the whole body.
- * Replace all the other returns with Goto. This is convenient if you later
- * want to insert some finalizer code, since you have a precise place where
- * to put it *)
-open Cil
-open Pretty
-
-module E = Errormsg
-
-let dummyVisitor = new nopCilVisitor
-
-let oneret (f: Cil.fundec) : unit =
- let fname = f.svar.vname in
- (* Get the return type *)
- let retTyp =
- match f.svar.vtype with
- TFun(rt, _, _, _) -> rt
- | _ -> E.s (E.bug "Function %s does not have a function type\n"
- f.svar.vname)
- in
- (* Does it return anything ? *)
- let hasRet = match unrollType retTyp with TVoid _ -> false | _ -> true in
-
- (* Memoize the return result variable. Use only if hasRet *)
- let lastloc = ref locUnknown in
- let retVar : varinfo option ref = ref None in
- let getRetVar (x: unit) : varinfo =
- match !retVar with
- Some rv -> rv
- | None -> begin
- let rv = makeLocalVar f "__retres" retTyp in (* don't collide *)
- retVar := Some rv;
- rv
- end
- in
- (* Remember if we have introduced goto's *)
- let haveGoto = ref false in
- (* Memoize the return statement *)
- let retStmt : stmt ref = ref dummyStmt in
- let getRetStmt (x: unit) : stmt =
- if !retStmt == dummyStmt then begin
- (* Must create a statement *)
- let rv =
- if hasRet then Some (Lval(Var (getRetVar ()), NoOffset)) else None
- in
- let sr = mkStmt (Return (rv, !lastloc)) in
- retStmt := sr;
- sr
- end else
- !retStmt
- in
- (* Now scan all the statements. Know if you are the main body of the
- * function and be prepared to add new statements at the end *)
- let rec scanStmts (mainbody: bool) = function
- | [] when mainbody -> (* We are at the end of the function. Now it is
- * time to add the return statement *)
- let rs = getRetStmt () in
- if !haveGoto then
- rs.labels <- (Label("return_label", !lastloc, false)) :: rs.labels;
- [rs]
-
- | [] -> []
-
- | ({skind=Return (retval, l)} as s) :: rests ->
- currentLoc := l;
-(*
- ignore (E.log "Fixing return(%a) at %a\n"
- insert
- (match retval with None -> text "None"
- | Some e -> d_exp () e)
- d_loc l);
-*)
- if hasRet && retval = None then
- E.s (error "Found return without value in function %s\n" fname);
- if not hasRet && retval <> None then
- E.s (error "Found return in subroutine %s\n" fname);
- (* Keep this statement because it might have labels. But change it to
- * an instruction that sets the return value (if any). *)
- s.skind <- begin
- match retval with
- Some rval -> Instr [Set((Var (getRetVar ()), NoOffset), rval, l)]
- | None -> Instr []
- end;
- (* See if this is the last statement in function *)
- if mainbody && rests == [] then
- s :: scanStmts mainbody rests
- else begin
- (* Add a Goto *)
- let sgref = ref (getRetStmt ()) in
- let sg = mkStmt (Goto (sgref, l)) in
- haveGoto := true;
- s :: sg :: (scanStmts mainbody rests)
- end
-
- | ({skind=If(eb,t,e,l)} as s) :: rests ->
- currentLoc := l;
- s.skind <- If(eb, scanBlock false t, scanBlock false e, l);
- s :: scanStmts mainbody rests
-(*
- | ({skind=Loop(b,l,lb1,lb2)} as s) :: rests ->
- currentLoc := l;
- s.skind <- Loop(scanBlock false b, l,lb1,lb2);
- s :: scanStmts mainbody rests
-*)
- | ({skind=While(e,b,l)} as s) :: rests ->
- currentLoc := l;
- s.skind <- While(e, scanBlock false b, l);
- s :: scanStmts mainbody rests
- | ({skind=DoWhile(e,b,l)} as s) :: rests ->
- currentLoc := l;
- s.skind <- DoWhile(e, scanBlock false b, l);
- s :: scanStmts mainbody rests
- | ({skind=For(bInit,e,bIter,b,l)} as s) :: rests ->
- currentLoc := l;
- s.skind <- For(scanBlock false bInit, e, scanBlock false bIter,
- scanBlock false b, l);
- s :: scanStmts mainbody rests
- | ({skind=Switch(e, b, cases, l)} as s) :: rests ->
- currentLoc := l;
- s.skind <- Switch(e, scanBlock false b, cases, l);
- s :: scanStmts mainbody rests
- | ({skind=Block b} as s) :: rests ->
- s.skind <- Block (scanBlock false b);
- s :: scanStmts mainbody rests
- | ({skind=(Goto _ | Instr _ | Continue _ | Break _
- | TryExcept _ | TryFinally _)} as s)
- :: rests -> s :: scanStmts mainbody rests
-
- and scanBlock (mainbody: bool) (b: block) =
- { bstmts = scanStmts mainbody b.bstmts; battrs = b.battrs; }
-
- in
- ignore (visitCilBlock dummyVisitor f.sbody) ; (* sets CurrentLoc *)
- lastloc := !currentLoc ; (* last location in the function *)
- f.sbody <- scanBlock true f.sbody
-
-
-let feature : featureDescr =
- { fd_name = "oneRet";
- fd_enabled = Cilutil.doOneRet;
- fd_description = "make each function have at most one 'return'" ;
- fd_extraopt = [];
- fd_doit = (function (f: file) ->
- Cil.iterGlobals f (fun glob -> match glob with
- Cil.GFun(fd,_) -> oneret fd;
- | _ -> ()));
- fd_post_check = true;
- }
diff --git a/cil/src/ext/oneret.mli b/cil/src/ext/oneret.mli
deleted file mode 100644
index f98ab4d14d666f6b77a777064157cfbe39c3332a..0000000000000000000000000000000000000000
--- a/cil/src/ext/oneret.mli
+++ /dev/null
@@ -1,44 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-
-(* Make sure that there is only one Return statement in the whole body.
- * Replace all the other returns with Goto. Make sure that there is a return
- * if the function is supposed to return something, and it is not declared to
- * not return. *)
-val oneret: Cil.fundec -> unit
-val feature : Cil.featureDescr
diff --git a/cil/src/ext/partial.ml b/cil/src/ext/partial.ml
deleted file mode 100644
index 4beca3fc97778edec573af9d08ad0030c59bb45c..0000000000000000000000000000000000000000
--- a/cil/src/ext/partial.ml
+++ /dev/null
@@ -1,851 +0,0 @@
-(* See copyright notice at the end of the file *)
-(*****************************************************************************
- * Partial Evaluation & Constant Folding
- *
- * Soundness Assumptions:
- * (1) Whole program analysis. You may call functions that are not defined
- * (e.g., library functions) but they may not call back.
- * (2) An undefined function may not return the address of a function whose
- * address is not already taken in the code I can see.
- * (3) A function pointer call may only call a function that has its
- * address visibly taken in the code I can see.
- *
- * (More assumptions in the comments below)
- *****************************************************************************)
-open Cil
-open Pretty
-
-(*****************************************************************************
- * A generic signature for Alias Analysis information. Used to compute the
- * call graph and do symbolic execution.
- ****************************************************************************)
-module type AliasInfo =
- sig
- val can_have_the_same_value : Cil.exp -> Cil.exp -> bool
- val resolve_function_pointer : Cil.exp -> (Cil.fundec list)
- end
-
-(*****************************************************************************
- * A generic signature for Symbolic Execution execution algorithms. Such
- * algorithms are used below to perform constant folding and dead-code
- * elimination. You write a "basic-block" symex algorithm, we'll make it
- * a whole-program CFG-pruner.
- ****************************************************************************)
-module type Symex =
- sig
- type t (* the type of a symex algorithm state object *)
- val empty : t (* all values unknown *)
- val equal : t -> t -> bool (* are these the same? *)
- val assign : t -> Cil.lval -> Cil.exp -> (Cil.exp * t)
- (* incorporate an assignment, return the RHS *)
- val unassign : t -> Cil.lval -> t
- (* lose all information about the given lvalue: assume an
- * unknown external value has been assigned to it *)
- val assembly : t -> Cil.instr -> t (* handle ASM *)
- val assume : t -> Cil.exp -> t (* incorporate an assumption *)
- val evaluate : t -> Cil.exp -> Cil.exp (* symbolic evaluation *)
- val join : (t list) -> t (* join a bunch of states *)
- val call : t -> Cil.fundec -> (Cil.exp list) -> (Cil.exp list * t)
- (* we are calling the given function with the given actuals *)
- val return : t -> Cil.fundec -> t
- (* we are returning from the given function *)
- val call_to_unknown_function : t -> t
- (* throw away information that may have been changed *)
- val debug : t -> unit
- end
-
-(*****************************************************************************
- * A generic signature for whole-progam call graphs.
- ****************************************************************************)
-module type CallGraph =
- sig
- type t (* the type of a call graph *)
- val compute : Cil.file -> t (* file for which we compute the graph *)
- val can_call : t -> Cil.fundec -> (Cil.fundec list)
- val can_be_called_by : t -> Cil.fundec -> (Cil.fundec list)
- val fundec_of_varinfo : t -> Cil.varinfo -> Cil.fundec
- end
-
-(*****************************************************************************
- * My cheap-o Alias Analysis. Assume all expressions can have the same
- * value and any function with its address taken can be the target of
- * any function pointer.
- *
- * Soundness Assumptions:
- * (1) Someone must call "find_all_functions_With_address_taken" before the
- * results are valid. This is already done in the code below.
- ****************************************************************************)
-let all_functions_with_address_taken = ref []
-let find_all_functions_with_address_taken (f : Cil.file) =
- iterGlobals f (fun g -> match g with
- GFun(fd,_) -> if fd.svar.vaddrof then
- all_functions_with_address_taken := fd ::
- !all_functions_with_address_taken
- | _ -> ())
-
-module EasyAlias =
- struct
- let can_have_the_same_value e1 e2 = true
- let resolve_function_pointer e1 = !all_functions_with_address_taken
- end
-
-(*****************************************************************************
- * My particular method for computing the Call Graph.
- ****************************************************************************)
-module EasyCallGraph = functor (A : AliasInfo) ->
- struct
- type callGraphNode = {
- fd : Cil.fundec ;
- mutable calledBy : Cil.fundec list ;
- mutable calls : Cil.fundec list ;
- }
- type t = (Cil.varinfo, callGraphNode) Hashtbl.t
-
- let cgCreateNode cg fundec =
- let newnode = { fd = fundec ; calledBy = [] ; calls = [] } in
- Hashtbl.add cg fundec.svar newnode
-
- let cgFindNode cg svar = Hashtbl.find cg svar
-
- let cgAddEdge cg caller callee =
- try
- let n1 = cgFindNode cg caller in
- let n2 = cgFindNode cg callee in
- n1.calls <- n2.fd :: n1.calls ;
- n1.calledBy <- n1.fd :: n1.calledBy
- with _ -> ()
-
- class callGraphVisitor cg = object
- inherit nopCilVisitor
- val the_fun = ref None
-
- method vinst i =
- let _ = match i with
- Call(_,Lval(Var(callee),NoOffset),_,_) -> begin
- (* known function call *)
- match !the_fun with
- None -> failwith "callGraphVisitor: call outside of any function"
- | Some(enclosing) -> cgAddEdge cg enclosing callee
- end
- | Call(_,e,_,_) -> begin
- (* unknown function call *)
- match !the_fun with
- None -> failwith "callGraphVisitor: call outside of any function"
- | Some(enclosing) -> let lst = A.resolve_function_pointer e in
- List.iter (fun possible_target_fd ->
- cgAddEdge cg enclosing possible_target_fd.svar) lst
- end
- | _ -> ()
- in SkipChildren
-
- method vfunc f = the_fun := Some(f.svar) ; DoChildren
- end
-
- let compute (f : Cil.file) =
- let cg = Hashtbl.create 511 in
- iterGlobals f (fun g -> match g with
- GFun(fd,_) -> cgCreateNode cg fd
- | _ -> ()
- ) ;
- visitCilFileSameGlobals (new callGraphVisitor cg) f ;
- cg
-
- let can_call cg fd =
- let n = cgFindNode cg fd.svar in n.calls
- let can_be_called_by cg fd =
- let n = cgFindNode cg fd.svar in n.calledBy
- let fundec_of_varinfo cg vi =
- let n = cgFindNode cg vi in n.fd
- end (* END OF: module EasyCallGraph *)
-
-(*****************************************************************************
- * Necula's Constant Folding Strategem (re-written to be applicative)
- *
- * Soundness Assumptions:
- * (1) Inline assembly does not affect constant folding.
- ****************************************************************************)
-module OrderedInt =
- struct
- type t = int
- let compare = compare
- end
-module IntMap = Map.Make(OrderedInt)
-
-module NeculaFolding = functor (A : AliasInfo) ->
- struct
- (* Register file. Maps identifiers of local variables to expressions.
- * We also remember if the expression depends on memory or depends on
- * variables that depend on memory *)
- type reg = {
- rvi : varinfo ;
- rval : exp ;
- rmem : bool
- }
- type t = reg IntMap.t
- let empty = IntMap.empty
- let equal t1 t2 = (compare t1 t2 = 0) (* use OCAML here *)
- let dependsOnMem = ref false
- (* Rewrite an expression based on the current register file *)
- class rewriteExpClass (regFile : t) = object
- inherit nopCilVisitor
- method vexpr = function
- | Lval (Var v, NoOffset) -> begin
- try
- let defined = (IntMap.find v.vid regFile) in
- if (defined.rmem) then dependsOnMem := true;
- (match defined.rval with
- | Const(x) -> ChangeTo (defined.rval)
- | _ -> DoChildren)
- with Not_found -> DoChildren
- end
- | Lval (Mem _, _) -> dependsOnMem := true; DoChildren
- | _ -> DoChildren
- end
- (* Rewrite an expression and return the new expression along with an
- * indication of whether it depends on memory *)
- let rewriteExp r (e: exp) : exp * bool =
- dependsOnMem := false;
- let e' = constFold true (visitCilExpr (new rewriteExpClass r) e) in
- e', !dependsOnMem
- let eval r e =
- let new_e, depends = rewriteExp r e in
- new_e
-
- let setMemory regFile =
- (* Get a list of all mappings that depend on memory *)
- let depids = ref [] in
- IntMap.iter (fun id v -> if v.rmem then depids := id :: !depids) regFile;
- (* And remove them from the register file *)
- List.fold_left (fun acc id -> IntMap.remove id acc) regFile !depids
-
- let setRegister regFile (v: varinfo) ((e,b): exp * bool) =
- IntMap.add v.vid { rvi = v ; rval = e ; rmem = b; } regFile
-
- let resetRegister regFile (id: int) =
- IntMap.remove id regFile
-
- class findLval lv contains = object
- inherit nopCilVisitor
- method vlval l =
- if l = lv then
- (contains := true ; SkipChildren)
- else
- DoChildren
- end
-
- let removeMappingsThatDependOn regFile l =
- (* Get a list of all mappings that depend on l *)
- let depids = ref [] in
- IntMap.iter (fun id reg ->
- let found = ref false in
- ignore (visitCilExpr (new findLval l found) reg.rval) ;
- if !found then
- depids := id :: !depids
- ) regFile ;
- (* And remove them from the register file *)
- List.fold_left (fun acc id -> IntMap.remove id acc) regFile !depids
-
- let assign r l e =
- let (newe,b) = rewriteExp r e in
- let r' = match l with
- (Var v, NoOffset) ->
- let r'' = setRegister r v (newe,b) in
- removeMappingsThatDependOn r'' l
- | (Mem _, _) -> setMemory r
- | _ -> r
- in newe, r'
-
- let unassign r l =
- let r' = match l with
- (Var v, NoOffset) ->
- let r'' = resetRegister r v.vid in
- removeMappingsThatDependOn r'' l
- | (Mem _, _) -> setMemory r
- | _ -> r
- in r'
-
- let assembly r i = r (* no-op in Necula-world *)
- let assume r e = r (* no-op in Necula-world *)
-
- let evaluate r e =
- let (newe,_) = rewriteExp r e in
- newe
-
- (* Join two symex states *)
- let join2 (r1 : t) (r2 : t) =
- let keep = ref [] in
- IntMap.iter (fun id reg ->
- try
- let reg' = IntMap.find id r2 in
- if reg'.rval = reg.rval && reg'.rmem = reg.rmem then
- keep := (id,reg) :: !keep
- with _ -> ()
- ) r1 ;
- List.fold_left (fun acc (id,v) ->
- IntMap.add id v acc) (IntMap.empty) !keep
-
- let join (lst : t list) = match lst with
- [] -> failwith "empty list"
- | r :: tl -> List.fold_left
- (fun (acc : t) (elt : t) -> join2 acc elt) r tl
-
- let call r fd el =
- let new_arg_list = ref [] in
- let final_r = List.fold_left2 (fun r vi e ->
- let newe, r' = assign r ((Var(vi),NoOffset)) e in
- new_arg_list := newe :: !new_arg_list ;
- r'
- ) r fd.sformals el in
- (List.rev !new_arg_list), final_r
-
- let return r fd =
- let regFile =
- List.fold_left (fun r vi -> IntMap.remove vi.vid r) r fd.sformals
- in
- (* Get a list of all globals *)
- let depids = ref [] in
- IntMap.iter (fun vid reg ->
- if reg.rvi.vglob || reg.rvi.vaddrof then depids := vid :: !depids
- ) regFile ;
- (* And remove them from the register file *)
- List.fold_left (fun acc id -> IntMap.remove id acc) regFile !depids
-
-
- let call_to_unknown_function r =
- setMemory r
-
- let debug r =
- IntMap.iter (fun key reg ->
- ignore (Pretty.printf "%s <- %a (%b)@!" reg.rvi.vname d_exp reg.rval reg.rmem)
- ) r
- end (* END OF: NeculaFolding *)
-
-(*****************************************************************************
- * A transformation to make every function call end its statement. So
- * { x=1; Foo(); y=1; }
- * becomes at least:
- * { { x=1; Foo(); }
- * { y=1; } }
- * But probably more like:
- * { { x=1; } { Foo(); } { y=1; } }
- ****************************************************************************)
-let rec contains_call il = match il with
- [] -> false
- | Call(_) :: tl -> true
- | _ :: tl -> contains_call tl
-
-class callBBVisitor = object
- inherit nopCilVisitor
-
- method vstmt s =
- match s.skind with
- Instr(il) when contains_call il -> begin
- let list_of_stmts = List.map (fun one_inst ->
- mkStmtOneInstr one_inst) il in
- let block = mkBlock list_of_stmts in
- ChangeDoChildrenPost(s, (fun _ ->
- s.skind <- Block(block) ;
- s))
- end
- | _ -> DoChildren
-
- method vvdec _ = SkipChildren
- method vexpr _ = SkipChildren
- method vlval _ = SkipChildren
- method vtype _ = SkipChildren
-end
-
-let calls_end_basic_blocks f =
- let thisVisitor = new callBBVisitor in
- visitCilFileSameGlobals thisVisitor f
-
-(*****************************************************************************
- * A transformation that gives each variable a unique identifier.
- ****************************************************************************)
-class vidVisitor = object
- inherit nopCilVisitor
- val count = ref 0
-
- method vvdec vi =
- vi.vid <- !count ;
- incr count ; SkipChildren
-end
-
-let globally_unique_vids f =
- let thisVisitor = new vidVisitor in
- visitCilFileSameGlobals thisVisitor f
-
-(*****************************************************************************
- * The Weimeric Partial Evaluation Data-Flow Engine
- *
- * This functor performs flow-sensitive, context-insensitive whole-program
- * data-flow analysis with an eye toward partial evaluation and constant
- * folding.
- *
- * Toposort the whole-program inter-procedural CFG to compute
- * (1) the number of actual predecessors for each statement
- * (2) the global toposort ordering
- *
- * Perform standard data-flow analysis (joins, etc) on the ICFG until you
- * hit a fixed point. If this changed the structure of the ICFG (by
- * removing an IF-branch or an empty function call), redo the whole thing.
- *
- * Soundness Assumptions:
- * (1) A "call instruction" is the last thing in its statement.
- * Use "calls_end_basic_blocks" to get this. cil/src/main.ml does
- * this when you pass --makeCFG.
- * (2) All variables have globally unique identifiers.
- * Use "globally_unique_vids" to get this. cil/src/main.ml does
- * this when you pass --makeCFG.
- * (3) This may not be a strict soundness requirement, but I wrote this
- * assuming that the input file has all switch/break/continue
- * statements removed.
- ****************************************************************************)
-module MakePartial =
- functor (S : Symex) ->
- functor (C : CallGraph) ->
- functor (A : AliasInfo) ->
- struct
-
- let debug = false
-
- (* We keep this information about every statement. Ideally this should
- * be put in the stmt itself, but CIL doesn't give us space. *)
- type sinfo = { (* statement info *)
- incoming_state : (int, S.t) Hashtbl.t ;
- (* mapping from stmt.sid to Symex.state *)
- reachable_preds : (int, bool) Hashtbl.t ;
- (* basically a set of all of the stmt.sids that can really
- * reach this statement *)
- mutable last_used_state : S.t option ;
- (* When we last did the Post() of this statement, what
- * incoming state did we use? If our new incoming state is
- * the same, we don't have to do it again. *)
- mutable priority : int ;
- (* Whole-program toposort priority. High means "do me first".
- * The first stmt in "main()" will have the highest priority.
- *)
- }
- let sinfo_ht = Hashtbl.create 511
- let clear_sinfo () = Hashtbl.clear sinfo_ht
-
- (* We construct sinfo nodes lazily: if you ask for one that isn't
- * there, we build it. *)
- let get_sinfo stmt =
- try
- Hashtbl.find sinfo_ht stmt.sid
- with _ ->
- let new_sinfo = { incoming_state = Hashtbl.create 3 ;
- reachable_preds = Hashtbl.create 3 ;
- last_used_state = None ;
- priority = (-1) ; } in
- Hashtbl.add sinfo_ht stmt.sid new_sinfo ;
- new_sinfo
-
- (* Topological Sort is a DFS in which you assign a priority right as
- * you finished visiting the children. While we're there we compute
- * the actual number of unique predecessors for each statement. The CIL
- * information may be out of date because we keep changing the CFG by
- * removing IFs and whatnot. *)
- let toposort_counter = ref 1
- let add_edge s1 s2 =
- let si2 = get_sinfo s2 in
- Hashtbl.replace si2.reachable_preds s1.sid true
-
- let rec toposort c stmt =
- let si = get_sinfo stmt in
- if si.priority >= 0 then
- () (* already visited! *)
- else begin
- si.priority <- 0 ; (* currently visiting *)
- (* handle function calls in this basic block *)
- (match stmt.skind with
- (Instr(il)) ->
- List.iter (fun i ->
- let fd_list = match i with
- Call(_,Lval(Var(vi),NoOffset),_,_) ->
- begin
- try
- let fd = C.fundec_of_varinfo c vi in
- [fd]
- with e -> [] (* calling external function *)
- end
- | Call(_,e,_,_) ->
- A.resolve_function_pointer e
- | _ -> []
- in
- List.iter (fun fd ->
- if List.length fd.sbody.bstmts > 0 then
- let fun_stmt = List.hd fd.sbody.bstmts in
- add_edge stmt fun_stmt ;
- toposort c fun_stmt
- ) fd_list
- ) il
- | _ -> ());
- List.iter (fun succ ->
- add_edge stmt succ ; toposort c succ) stmt.succs ;
- si.priority <- !toposort_counter ;
- incr toposort_counter
- end
-
- (* we set this to true whenever we eliminate an IF or otherwise
- * change the CFG *)
- let changed_cfg = ref false
-
- (* Partially evaluate / constant fold a statement. Basically this just
- * asks the Symex algorithm to evaluate the RHS in the current state
- * and then compute a new state that incorporates the assignment.
- *
- * However, we have special handling for ifs and calls. If we can
- * evaluate an if predicate to a constant, we remove the if.
- *
- * If we are going to make a call to a function with an empty body, we
- * remove the function call. *)
- let partial_stmt c state stmt handle_funcall =
- let result = match stmt.skind with
- Instr(il) ->
- let state = ref state in
- let new_il = List.map (fun i ->
- if debug then begin
- ignore (Pretty.printf "Instr %a@!" d_instr i )
- end ;
- match i with
- | Set(l,e,loc) ->
- let e', state' = S.assign !state l e in
- state := state' ;
- [Set(l,e',loc)]
- | Call(lo,(Lval(Var(vi),NoOffset)),al,loc) ->
- let result = begin
- try
- let fd = C.fundec_of_varinfo c vi in
- begin
- match fd.sbody.bstmts with
- [] -> [] (* no point in making this call *)
- | hd :: tl ->
- let al', state' = S.call !state fd al in
- handle_funcall stmt hd state' ;
- let state'' = S.return state' fd in
- state := state'' ;
- [Call(lo,(Lval(Var(vi),NoOffset)),al',loc)]
- end
- with e ->
- let state'' = S.call_to_unknown_function !state in
- let al' = List.map (S.evaluate !state) al in
- state := state'' ;
- [Call(lo,(Lval(Var(vi),NoOffset)),al',loc)]
- end in
- (* handle return value *)
- begin
- match lo with
- Some(lv) -> state := S.unassign !state lv
- | _ -> ()
- end ;
- result
- | Call(lo,f,al,loc) ->
- let al' = List.map (S.evaluate !state) al in
- state := S.call_to_unknown_function !state ;
- (match lo with
- Some(lv) -> state := S.unassign !state lv
- | None -> ()) ;
- [Call(lo,f,al',loc)]
- | Asm(_) -> state := S.assembly !state i ; [i]
- ) il in
- stmt.skind <- Instr(List.flatten new_il) ;
- if debug then begin
- ignore (Pretty.printf "New Stmt is %a@!" d_stmt stmt) ;
- end ;
- !state
-
- | If(e,b1,b2,loc) ->
- let e' = S.evaluate state e in
- (* Pretty.printf "%a evals to %a\n" d_exp e d_exp e' ; *)
-
- (* helper function to remove an IF branch *)
- let remove b remains = begin
- changed_cfg := true ;
- (match b.bstmts with
- | [] -> ()
- | hd :: tl ->
- stmt.succs <- List.filter (fun succ -> succ.sid <> hd.sid)
- stmt.succs
- )
- end in
-
- if (e' = one) then begin
- if b2.bstmts = [] && b2.battrs = [] then begin
- stmt.skind <- Block(b1) ;
- match b1.bstmts with
- [] -> failwith "partial: completely empty if"
- | hd :: tl -> stmt.succs <- [hd]
- end else
- stmt.skind <- Block(
- { bstmts =
- [ mkStmt (Block(b1)) ;
- mkStmt (If(zero,b2,{bstmts=[];battrs=[];},loc)) ] ;
- battrs = [] } ) ;
- remove b2 b1 ;
- state
- end else if (e' = zero) then begin
- if b1.bstmts = [] && b1.battrs = [] then begin
- stmt.skind <- Block(b2) ;
- match b2.bstmts with
- [] -> failwith "partial: completely empty if"
- | hd :: tl -> stmt.succs <- [hd]
- end else
- stmt.skind <- Block(
- { bstmts =
- [ mkStmt (Block(b2)) ;
- mkStmt (If(zero,b1,{bstmts=[];battrs=[];},loc)) ] ;
- battrs = [] } ) ;
- remove b1 b2 ;
- state
- end else begin
- stmt.skind <- If(e',b1,b2,loc) ;
- state
- end
-
- | Return(Some(e),loc) ->
- let e' = S.evaluate state e in
- stmt.skind <- Return(Some(e'),loc) ;
- state
-
- | Block(b) ->
- if debug && List.length stmt.succs > 1 then begin
- ignore (Pretty.printf "(%a) has successors [%a]@!"
- d_stmt stmt
- (docList ~sep:(chr '@') (d_stmt ()))
- stmt.succs)
- end ;
- state
-
- | _ -> state
- in result
-
- (*
- * This is the main conceptual entry-point for the partial evaluation
- * data-flow functor.
- *)
- let dataflow (file : Cil.file) (* whole program *)
- (c : C.t) (* control-flow graph *)
- (initial_state : S.t) (* any assumptions? *)
- (initial_stmt : Cil.stmt) (* entry point *)
- = begin
- (* count the total number of statements in the program *)
- let num_stmts = ref 1 in
- iterGlobals file (fun g -> match g with
- GFun(fd,_) -> begin
- match fd.smaxstmtid with
- Some(i) -> if i > !num_stmts then num_stmts := i
- | None -> ()
- end
- | _ -> ()
- ) ;
- (if debug then
- Printf.printf "Dataflow: at most %d statements in program\n" !num_stmts);
-
- (* create a priority queue in which to store statements *)
- let worklist = Heap.create !num_stmts in
-
- let finished = ref false in
- let passes = ref 0 in
-
- (* add something to the work queue *)
- let enqueue caller callee state = begin
- let si = get_sinfo callee in
- Hashtbl.replace si.incoming_state caller.sid state ;
- Heap.insert worklist si.priority callee
- end in
-
- (* we will be finished when we complete a round of data-flow that
- * does not change the ICFG *)
- while not !finished do
- clear_sinfo () ;
- incr passes ;
-
- (* we must recompute the ordering and the predecessor information
- * because we may have changed it by removing IFs *)
- (if debug then Printf.printf "Dataflow: Topological Sorting & Reachability\n" );
- toposort c initial_stmt ;
-
- let initial_si = get_sinfo initial_stmt in
- Heap.insert worklist initial_si.priority initial_stmt ;
-
- while not (Heap.is_empty worklist) do
- let (p,s) = Heap.extract_max worklist in
- if debug then begin
- ignore (Pretty.printf "Working on stmt %d (%a) %a@!"
- s.sid
- (docList ~sep:(chr ',' ++ break) (fun s -> dprintf "%d" s.sid))
- s.succs
- d_stmt s) ;
- flush stdout ;
- end ;
- let si = get_sinfo s in
-
- (* Even though this stmt is on the worklist, we may not have
- * to do anything with it if the join of all of the incoming
- * states is the same as the last state we used here. *)
- let must_recompute, incoming_state =
- begin
- let list_of_incoming_states = ref [] in
- Hashtbl.iter (fun true_pred_sid b ->
- let this_pred_state =
- try
- Hashtbl.find si.incoming_state true_pred_sid
- with _ ->
- (* this occurs when we're evaluating a statement and we
- * have not yet evaluated all of its predecessors (the
- * first time we look at a loop head, say). We must be
- * conservative. We'll come back later with better
- * information (as we work toward the fix-point). *)
- S.empty
- in
- if debug then begin
- Printf.printf " Incoming State from %d\n" true_pred_sid ;
- S.debug this_pred_state ;
- flush stdout ;
- end ;
- list_of_incoming_states := this_pred_state ::
- !list_of_incoming_states
- ) si.reachable_preds ;
- let merged_incoming_state =
- if !list_of_incoming_states = [] then
- (* this occurs when we're looking at the first statement
- * in "main" -- it has no preds *)
- initial_state
- else
- S.join !list_of_incoming_states
- in
- if debug then begin
- Printf.printf " Merged State:\n" ;
- S.debug merged_incoming_state ;
- flush stdout ;
- end ;
- let must_recompute = match si.last_used_state with
- None -> true
- | Some(last) -> not (S.equal merged_incoming_state last)
- in must_recompute, merged_incoming_state
- end
- in
- if must_recompute then begin
- si.last_used_state <- Some(incoming_state) ;
- let outgoing_state =
- (* partially evaluate and optimize the statement *)
- partial_stmt c incoming_state s enqueue in
- let fresh_succs = s.succs in
- (* touch every successor so that we will reconsider it *)
- List.iter (fun succ ->
- enqueue s succ outgoing_state
- ) fresh_succs ;
- end else begin
- if debug then begin
- Printf.printf "No need to recompute.\n"
- end
- end
- done ;
- (if debug then Printf.printf "Dataflow: Pass %d Complete\n" !passes) ;
- if !changed_cfg then begin
- (if debug then Printf.printf "Dataflow: Restarting (CFG Changed)\n") ;
- changed_cfg := false
- end else
- finished := true
- done ;
- (if debug then Printf.printf "Dataflow: Completed (%d passes)\n" !passes)
-
- end
-
- let simplify file c fd (assumptions : (Cil.lval * Cil.exp) list) =
- let starting_state = List.fold_left (fun s (l,e) ->
- let e',s' = S.assign s l e in
- s'
- ) S.empty assumptions in
- dataflow file c starting_state (List.hd fd.sbody.bstmts)
-
- end
-
-
-(*
- * Currently our partial-eval optimizer is built out of basically nothing.
- * The alias analysis is fake, the call grpah is cheap, and we're using
- * George's old basic-block symex. Still, it works.
- *)
-(* Don't you love Functor application? *)
-module BasicCallGraph = EasyCallGraph(EasyAlias)
-module BasicSymex = NeculaFolding(EasyAlias)
-module BasicPartial = MakePartial(BasicSymex)(BasicCallGraph)(EasyAlias)
-
-(*
- * A very easy entry-point to partial evaluation/symbolic execution.
- * You pass the Cil file and a list of assumptions (lvalue, exp pairs that
- * should be treated as assignments that occur before the program starts).
- *
- * We partially evaluate and optimize starting from "main". The Cil.file
- * is modified in place.
- *)
-let partial (f : Cil.file) (assumptions : (Cil.lval * Cil.exp) list) =
- try
- find_all_functions_with_address_taken f ;
- let c = BasicCallGraph.compute f in
- try
- iterGlobals f (fun g -> match g with
- GFun(fd,_) when fd.svar.vname = "main" ->
- BasicPartial.simplify f c fd assumptions
- | _ -> ()) ;
- with e -> begin
- Printf.printf "Error in DataFlow: %s\n" (Printexc.to_string e) ;
- raise e
- end
- with e -> begin
- Printf.printf "Error in Partial: %s\n" (Printexc.to_string e) ;
- raise e
- end
-
-let feature : featureDescr =
- { fd_name = "partial";
- fd_enabled = Cilutil.doPartial;
- fd_description = "interprocedural partial evaluation and constant folding" ;
- fd_extraopt = [];
- fd_doit = (function (f: file) ->
- if not !Cilutil.makeCFG then begin
- Errormsg.s (Errormsg.error "--dopartial: you must also specify --domakeCFG\n")
- end ;
- partial f [] ) ;
- fd_post_check = false;
- }
-
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
diff --git a/cil/src/ext/pta/golf.ml b/cil/src/ext/pta/golf.ml
deleted file mode 100644
index 5ea47ff1a25798893a7849d4a416c2588c3408d6..0000000000000000000000000000000000000000
--- a/cil/src/ext/pta/golf.ml
+++ /dev/null
@@ -1,1657 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * John Kodumal <jkodumal@eecs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(***********************************************************************)
-(* *)
-(* Exceptions *)
-(* *)
-(***********************************************************************)
-
-exception Inconsistent (* raised if constraint system is inconsistent *)
-exception WellFormed (* raised if types are not well-formed *)
-exception NoContents
-exception APFound (* raised if an alias pair is found, a control
- flow exception *)
-
-
-module U = Uref
-module S = Setp
-module H = Hashtbl
-module Q = Queue
-
-
-(** Subtyping kinds *)
-type polarity =
- Pos
- | Neg
- | Sub
-
-(** Path kinds, for CFL reachability *)
-type pkind =
- Positive
- | Negative
- | Match
- | Seed
-
-(** Context kinds -- open or closed *)
-type context =
- Open
- | Closed
-
-(* A configuration is a context (open or closed) coupled with a pair
- of stamps representing a state in the cartesian product DFA. *)
-type configuration = context * int * int
-
-module ConfigHash =
-struct
- type t = configuration
- let equal t t' = t = t'
- let hash t = Hashtbl.hash t
-end
-
-module CH = H.Make (ConfigHash)
-
-type config_map = unit CH.t
-
-(** Generic bounds *)
-type 'a bound = {index : int; info : 'a U.uref}
-
-(** For label paths. *)
-type 'a path = {
- kind : pkind;
- reached_global : bool;
- head : 'a U.uref;
- tail : 'a U.uref
-}
-
-module Bound =
-struct
- type 'a t = 'a bound
- let compare (x : 'a t) (y : 'a t) =
- if U.equal (x.info, y.info) then x.index - y.index
- else Pervasives.compare (U.deref x.info) (U.deref y.info)
-end
-
-module Path =
-struct
- type 'a t = 'a path
- let compare (x : 'a t) (y : 'a t) =
- if U.equal (x.head, y.head) then
- begin
- if U.equal (x.tail, y.tail) then
- begin
- if x.reached_global = y.reached_global then
- Pervasives.compare x.kind y.kind
- else Pervasives.compare x.reached_global y.reached_global
- end
- else Pervasives.compare (U.deref x.tail) (U.deref y.tail)
- end
- else Pervasives.compare (U.deref x.head) (U.deref y.head)
-end
-
-module B = S.Make (Bound)
-
-module P = S.Make (Path)
-
-type 'a boundset = 'a B.t
-
-type 'a pathset = 'a P.t
-
-(** Constants, which identify elements in points-to sets *)
-(** jk : I'd prefer to make this an 'a constant and specialize it to varinfo
- for use with the Cil frontend, but for now, this will do *)
-type constant = int * string * Cil.varinfo
-
-module Constant =
-struct
- type t = constant
- let compare (xid, _, _) (yid, _, _) = xid - yid
-end
-module C = Set.Make (Constant)
-
-(** Sets of constants. Set union is used when two labels containing
- constant sets are unified *)
-type constantset = C.t
-
-type lblinfo = {
- mutable l_name: string;
- (** either empty or a singleton, the initial location for this label *)
- loc : constantset;
- (** Name of this label *)
- l_stamp : int;
- (** Unique integer for this label *)
- mutable l_global : bool;
- (** True if this location is globally accessible *)
- mutable aliases: constantset;
- (** Set of constants (tags) for checking aliases *)
- mutable p_lbounds: lblinfo boundset;
- (** Set of umatched (p) lower bounds *)
- mutable n_lbounds: lblinfo boundset;
- (** Set of unmatched (n) lower bounds *)
- mutable p_ubounds: lblinfo boundset;
- (** Set of umatched (p) upper bounds *)
- mutable n_ubounds: lblinfo boundset;
- (** Set of unmatched (n) upper bounds *)
- mutable m_lbounds: lblinfo boundset;
- (** Set of matched (m) lower bounds *)
- mutable m_ubounds: lblinfo boundset;
- (** Set of matched (m) upper bounds *)
-
- mutable m_upath: lblinfo pathset;
- mutable m_lpath: lblinfo pathset;
- mutable n_upath: lblinfo pathset;
- mutable n_lpath: lblinfo pathset;
- mutable p_upath: lblinfo pathset;
- mutable p_lpath: lblinfo pathset;
-
- mutable l_seeded : bool;
- mutable l_ret : bool;
- mutable l_param : bool;
-}
-
-(** Constructor labels *)
-and label = lblinfo U.uref
-
-(** The type of lvalues. *)
-type lvalue = {
- l: label;
- contents: tau
-}
-
-and vinfo = {
- v_stamp : int;
- v_name : string;
-
- mutable v_hole : (int,unit) H.t;
- mutable v_global : bool;
- mutable v_mlbs : tinfo boundset;
- mutable v_mubs : tinfo boundset;
- mutable v_plbs : tinfo boundset;
- mutable v_pubs : tinfo boundset;
- mutable v_nlbs : tinfo boundset;
- mutable v_nubs : tinfo boundset
-}
-
-and rinfo = {
- r_stamp : int;
- rl : label;
- points_to : tau;
- mutable r_global: bool;
-}
-
-and finfo = {
- f_stamp : int;
- fl : label;
- ret : tau;
- mutable args : tau list;
- mutable f_global : bool;
-}
-
-and pinfo = {
- p_stamp : int;
- ptr : tau;
- lam : tau;
- mutable p_global : bool;
-}
-
-and tinfo = Var of vinfo
- | Ref of rinfo
- | Fun of finfo
- | Pair of pinfo
-
-and tau = tinfo U.uref
-
-type tconstraint = Unification of tau * tau
- | Leq of tau * (int * polarity) * tau
-
-
-(** Association lists, used for printing recursive types. The first element
- is a type that has been visited. The second element is the string
- representation of that type (so far). If the string option is set, then
- this type occurs within itself, and is associated with the recursive var
- name stored in the option. When walking a type, add it to an association
- list.
-
- Example : suppose we have the constraint 'a = ref('a). The type is unified
- via cyclic unification, and would loop infinitely if we attempted to print
- it. What we want to do is print the type u rv. ref(rv). This is accomplished
- in the following manner:
-
- -- ref('a) is visited. It is not in the association list, so it is added
- and the string "ref(" is stored in the second element. We recurse to print
- the first argument of the constructor.
-
- -- In the recursive call, we see that 'a (or ref('a)) is already in the
- association list, so the type is recursive. We check the string option,
- which is None, meaning that this is the first recurrence of the type. We
- create a new recursive variable, rv and set the string option to 'rv. Next,
- we prepend u rv. to the string representation we have seen before, "ref(",
- and return "rv" as the string representation of this type.
-
- -- The string so far is "u rv.ref(". The recursive call returns, and we
- complete the type by printing the result of the call, "rv", and ")"
-
- In a type where the recursive variable appears twice, e.g. 'a = pair('a,'a),
- the second time we hit 'a, the string option will be set, so we know to
- reuse the same recursive variable name.
-*)
-type association = tau * string ref * string option ref
-
-module PathHash =
-struct
- type t = int list
- let equal t t' = t = t'
- let hash t = Hashtbl.hash t
-end
-
-module PH = H.Make (PathHash)
-
-(***********************************************************************)
-(* *)
-(* Global Variables *)
-(* *)
-(***********************************************************************)
-
-(** Print the instantiations constraints. *)
-let print_constraints : bool ref = ref false
-
-(** If true, print all constraints (including induced) and show
- additional debug output. *)
-let debug = ref false
-
-(** Just debug all the constraints (including induced) *)
-let debug_constraints = ref false
-
-(** Debug smart alias queries *)
-let debug_aliases = ref false
-
-let smart_aliases = ref false
-
-(** If true, make the flow step a no-op *)
-let no_flow = ref false
-
-(** If true, disable subtyping (unification at all levels) *)
-let no_sub = ref false
-
-(** If true, treat indexed edges as regular subtyping *)
-let analyze_mono = ref true
-
-(** A list of equality constraints. *)
-let eq_worklist : tconstraint Q.t = Q.create ()
-
-(** A list of leq constraints. *)
-let leq_worklist : tconstraint Q.t = Q.create ()
-
-let path_worklist : (lblinfo path) Q.t = Q.create ()
-
-let path_hash : (lblinfo path) PH.t = PH.create 32
-
-(** A count of the constraints introduced from the AST. Used for debugging. *)
-let toplev_count = ref 0
-
-(** A hashtable containing stamp pairs of labels that must be aliased. *)
-let cached_aliases : (int * int,unit) H.t = H.create 64
-
-(** A hashtable mapping pairs of tau's to their join node. *)
-let join_cache : (int * int, tau) H.t = H.create 64
-
-(***********************************************************************)
-(* *)
-(* Utility Functions *)
-(* *)
-(***********************************************************************)
-
-let find = U.deref
-
-let die s =
- Printf.printf "*******\nAssertion failed: %s\n*******\n" s;
- assert false
-
-let fresh_appsite : (unit -> int) =
- let appsite_index = ref 0 in
- fun () ->
- incr appsite_index;
- !appsite_index
-
-(** Generate a unique integer. *)
-let fresh_index : (unit -> int) =
- let counter = ref 0 in
- fun () ->
- incr counter;
- !counter
-
-let fresh_stamp : (unit -> int) =
- let stamp = ref 0 in
- fun () ->
- incr stamp;
- !stamp
-
-(** Return a unique integer representation of a tau *)
-let get_stamp (t : tau) : int =
- match find t with
- Var v -> v.v_stamp
- | Ref r -> r.r_stamp
- | Pair p -> p.p_stamp
- | Fun f -> f.f_stamp
-
-(** Negate a polarity. *)
-let negate (p : polarity) : polarity =
- match p with
- Pos -> Neg
- | Neg -> Pos
- | Sub -> die "negate"
-
-(** Consistency checks for inferred types *)
-let pair_or_var (t : tau) =
- match find t with
- Pair _ -> true
- | Var _ -> true
- | _ -> false
-
-let ref_or_var (t : tau) =
- match find t with
- Ref _ -> true
- | Var _ -> true
- | _ -> false
-
-let fun_or_var (t : tau) =
- match find t with
- Fun _ -> true
- | Var _ -> true
- | _ -> false
-
-
-
-(** Apply [f] structurally down [t]. Guaranteed to terminate, even if [t]
- is recursive *)
-let iter_tau f t =
- let visited : (int,tau) H.t = H.create 4 in
- let rec iter_tau' t =
- if H.mem visited (get_stamp t) then () else
- begin
- f t;
- H.add visited (get_stamp t) t;
- match U.deref t with
- Pair p ->
- iter_tau' p.ptr;
- iter_tau' p.lam
- | Fun f ->
- List.iter iter_tau' (f.args);
- iter_tau' f.ret
- | Ref r -> iter_tau' r.points_to
- | _ -> ()
- end
- in
- iter_tau' t
-
-(* Extract a label's bounds according to [positive] and [upper]. *)
-let get_bounds (p :polarity ) (upper : bool) (l : label) : lblinfo boundset =
- let li = find l in
- match p with
- Pos -> if upper then li.p_ubounds else li.p_lbounds
- | Neg -> if upper then li.n_ubounds else li.n_lbounds
- | Sub -> if upper then li.m_ubounds else li.m_lbounds
-
-let equal_tau (t : tau) (t' : tau) =
- get_stamp t = get_stamp t'
-
-let get_label_stamp (l : label) : int =
- (find l).l_stamp
-
-(** Return true if [t] is global (treated monomorphically) *)
-let get_global (t : tau) : bool =
- match find t with
- Var v -> v.v_global
- | Ref r -> r.r_global
- | Pair p -> p.p_global
- | Fun f -> f.f_global
-
-let is_ret_label l = (find l).l_ret || (find l).l_global (* todo - check *)
-
-let is_param_label l = (find l).l_param || (find l).l_global
-
-let is_global_label l = (find l).l_global
-
-let is_seeded_label l = (find l).l_seeded
-
-let set_global_label (l : label) (b : bool) : unit =
- assert ((not (is_global_label l)) || b);
- (U.deref l).l_global <- b
-
-(** Aliases for set_global *)
-let global_tau = get_global
-
-
-(** Get_global for lvalues *)
-let global_lvalue lv = get_global lv.contents
-
-
-
-(***********************************************************************)
-(* *)
-(* Printing Functions *)
-(* *)
-(***********************************************************************)
-
-let string_of_configuration (c, i, i') =
- let context = match c with
- Open -> "O"
- | Closed -> "C"
- in
- Printf.sprintf "(%s,%d,%d)" context i i'
-
-let string_of_polarity p =
- match p with
- Pos -> "+"
- | Neg -> "-"
- | Sub -> "M"
-
-(** Convert a label to a string, short representation *)
-let string_of_label (l : label) : string =
- "\"" ^ (find l).l_name ^ "\""
-
-(** Return true if the element [e] is present in the association list,
- according to uref equality *)
-let rec assoc_list_mem (e : tau) (l : association list) =
- match l with
- | [] -> None
- | (h, s, so) :: t ->
- if U.equal (h,e) then Some (s, so) else assoc_list_mem e t
-
-(** Given a tau, create a unique recursive variable name. This should always
- return the same name for a given tau *)
-let fresh_recvar_name (t : tau) : string =
- match find t with
- Pair p -> "rvp" ^ string_of_int p.p_stamp
- | Ref r -> "rvr" ^ string_of_int r.r_stamp
- | Fun f -> "rvf" ^ string_of_int f.f_stamp
- | _ -> die "fresh_recvar_name"
-
-
-(** Return a string representation of a tau, using association lists. *)
-let string_of_tau (t : tau) : string =
- let tau_map : association list ref = ref [] in
- let rec string_of_tau' t =
- match assoc_list_mem t !tau_map with
- Some (s, so) -> (* recursive type. see if a var name has been set *)
- begin
- match !so with
- None ->
- let rv = fresh_recvar_name t in
- s := "u " ^ rv ^ "." ^ !s;
- so := Some rv;
- rv
- | Some rv -> rv
- end
- | None -> (* type's not recursive. Add it to the assoc list and cont. *)
- let s = ref ""
- and so : string option ref = ref None in
- tau_map := (t, s, so) :: !tau_map;
- begin
- match find t with
- Var v -> s := v.v_name;
- | Pair p ->
- assert (ref_or_var p.ptr);
- assert (fun_or_var p.lam);
- s := "{";
- s := !s ^ string_of_tau' p.ptr;
- s := !s ^ ",";
- s := !s ^ string_of_tau' p.lam;
- s := !s ^"}"
- | Ref r ->
- assert (pair_or_var r.points_to);
- s := "ref(|";
- s := !s ^ string_of_label r.rl;
- s := !s ^ "|,";
- s := !s ^ string_of_tau' r.points_to;
- s := !s ^ ")"
- | Fun f ->
- assert (pair_or_var f.ret);
- let rec string_of_args = function
- h :: [] ->
- assert (pair_or_var h);
- s := !s ^ string_of_tau' h
- | h :: t ->
- assert (pair_or_var h);
- s := !s ^ string_of_tau' h ^ ",";
- string_of_args t
- | [] -> ()
- in
- s := "fun(|";
- s := !s ^ string_of_label f.fl;
- s := !s ^ "|,";
- s := !s ^ "<";
- if List.length f.args > 0 then string_of_args f.args
- else s := !s ^ "void";
- s := !s ^">,";
- s := !s ^ string_of_tau' f.ret;
- s := !s ^ ")"
- end;
- tau_map := List.tl !tau_map;
- !s
- in
- string_of_tau' t
-
-(** Convert an lvalue to a string *)
-let rec string_of_lvalue (lv : lvalue) : string =
- let contents = string_of_tau lv.contents
- and l = string_of_label lv.l in
- assert (pair_or_var lv.contents); (* do a consistency check *)
- Printf.sprintf "[%s]^(%s)" contents l
-
-let print_path (p : lblinfo path) : unit =
- let string_of_pkind = function
- Positive -> "p"
- | Negative -> "n"
- | Match -> "m"
- | Seed -> "s"
- in
- Printf.printf
- "%s --%s--> %s (%d) : "
- (string_of_label p.head)
- (string_of_pkind p.kind)
- (string_of_label p.tail)
- (PathHash.hash p)
-
-(** Print a list of tau elements, comma separated *)
-let rec print_tau_list (l : tau list) : unit =
- let rec print_t_strings = function
- h :: [] -> print_endline h
- | h :: t ->
- print_string h;
- print_string ", ";
- print_t_strings t
- | [] -> ()
- in
- print_t_strings (List.map string_of_tau l)
-
-let print_constraint (c : tconstraint) =
- match c with
- Unification (t, t') ->
- let lhs = string_of_tau t
- and rhs = string_of_tau t' in
- Printf.printf "%s == %s\n" lhs rhs
- | Leq (t, (i, p), t') ->
- let lhs = string_of_tau t
- and rhs = string_of_tau t' in
- Printf.printf "%s <={%d,%s} %s\n" lhs i (string_of_polarity p) rhs
-
-(***********************************************************************)
-(* *)
-(* Type Operations -- these do not create any constraints *)
-(* *)
-(***********************************************************************)
-
-(** Create an lvalue with label [lbl] and tau contents [t]. *)
-let make_lval (lbl, t : label * tau) : lvalue =
- {l = lbl; contents = t}
-
-let make_label_int (is_global : bool) (name :string) (vio : Cil.varinfo option) : label =
- let locc =
- match vio with
- Some vi -> C.add (fresh_index (), name, vi) C.empty
- | None -> C.empty
- in
- U.uref {
- l_name = name;
- l_global = is_global;
- l_stamp = fresh_stamp ();
- loc = locc;
- aliases = locc;
- p_ubounds = B.empty;
- p_lbounds = B.empty;
- n_ubounds = B.empty;
- n_lbounds = B.empty;
- m_ubounds = B.empty;
- m_lbounds = B.empty;
- m_upath = P.empty;
- m_lpath = P.empty;
- n_upath = P.empty;
- n_lpath = P.empty;
- p_upath = P.empty;
- p_lpath = P.empty;
- l_seeded = false;
- l_ret = false;
- l_param = false
- }
-
-(** Create a new label with name [name]. Also adds a fresh constant
- with name [name] to this label's aliases set. *)
-let make_label (is_global : bool) (name : string) (vio : Cil.varinfo option) : label =
- make_label_int is_global name vio
-
-(** Create a new label with an unspecified name and an empty alias set. *)
-let fresh_label (is_global : bool) : label =
- let index = fresh_index () in
- make_label_int is_global ("l_" ^ string_of_int index) None
-
-(** Create a fresh bound (edge in the constraint graph). *)
-let make_bound (i, a : int * label) : lblinfo bound =
- {index = i; info = a}
-
-let make_tau_bound (i, a : int * tau) : tinfo bound =
- {index = i; info = a}
-
-(** Create a fresh named variable with name '[name]. *)
-let make_var (b: bool) (name : string) : tau =
- U.uref (Var {v_name = ("'" ^ name);
- v_hole = H.create 8;
- v_stamp = fresh_index ();
- v_global = b;
- v_mlbs = B.empty;
- v_mubs = B.empty;
- v_plbs = B.empty;
- v_pubs = B.empty;
- v_nlbs = B.empty;
- v_nubs = B.empty})
-
-(** Create a fresh unnamed variable (name will be 'fv). *)
-let fresh_var (is_global : bool) : tau =
- make_var is_global ("fv" ^ string_of_int (fresh_index ()))
-
-(** Create a fresh unnamed variable (name will be 'fi). *)
-let fresh_var_i (is_global : bool) : tau =
- make_var is_global ("fi" ^ string_of_int (fresh_index()))
-
-(** Create a Fun constructor. *)
-let make_fun (lbl, a, r : label * (tau list) * tau) : tau =
- U.uref (Fun {fl = lbl;
- f_stamp = fresh_index ();
- f_global = false;
- args = a;
- ret = r })
-
-(** Create a Ref constructor. *)
-let make_ref (lbl,pt : label * tau) : tau =
- U.uref (Ref {rl = lbl;
- r_stamp = fresh_index ();
- r_global = false;
- points_to = pt})
-
-(** Create a Pair constructor. *)
-let make_pair (p,f : tau * tau) : tau =
- U.uref (Pair {ptr = p;
- p_stamp = fresh_index ();
- p_global = false;
- lam = f})
-
-(** Copy the toplevel constructor of [t], putting fresh variables in each
- argement of the constructor. *)
-let copy_toplevel (t : tau) : tau =
- match find t with
- Pair _ -> make_pair (fresh_var_i false, fresh_var_i false)
- | Ref _ -> make_ref (fresh_label false, fresh_var_i false)
- | Fun f ->
- let fresh_fn = fun _ -> fresh_var_i false in
- make_fun (fresh_label false,
- List.map fresh_fn f.args, fresh_var_i false)
- | _ -> die "copy_toplevel"
-
-
-let has_same_structure (t : tau) (t' : tau) =
- match find t, find t' with
- Pair _, Pair _ -> true
- | Ref _, Ref _ -> true
- | Fun _, Fun _ -> true
- | Var _, Var _ -> true
- | _ -> false
-
-
-let pad_args (f, f' : finfo * finfo) : unit =
- let padding = ref ((List.length f.args) - (List.length f'.args))
- in
- if !padding == 0 then ()
- else
- let to_pad =
- if !padding > 0 then f' else (padding := -(!padding); f)
- in
- for i = 1 to !padding do
- to_pad.args <- to_pad.args @ [fresh_var false]
- done
-
-
-let pad_args2 (fi, tlr : finfo * tau list ref) : unit =
- let padding = ref (List.length fi.args - List.length !tlr)
- in
- if !padding == 0 then ()
- else
- if !padding > 0 then
- for i = 1 to !padding do
- tlr := !tlr @ [fresh_var false]
- done
- else
- begin
- padding := -(!padding);
- for i = 1 to !padding do
- fi.args <- fi.args @ [fresh_var false]
- done
- end
-
-(***********************************************************************)
-(* *)
-(* Constraint Generation/ Resolution *)
-(* *)
-(***********************************************************************)
-
-
-(** Make the type a global type *)
-let set_global (t : tau) (b : bool) : unit =
- let set_global_down t =
- match find t with
- Var v -> v.v_global <- true
- | Ref r -> set_global_label r.rl true
- | Fun f -> set_global_label f.fl true
- | _ -> ()
- in
- if !debug && b then Printf.printf "Set global: %s\n" (string_of_tau t);
- assert ((not (get_global t)) || b);
- if b then iter_tau set_global_down t;
- match find t with
- Var v -> v.v_global <- b
- | Ref r -> r.r_global <- b
- | Pair p -> p.p_global <- b
- | Fun f -> f.f_global <- b
-
-
-let rec unify_int (t, t' : tau * tau) : unit =
- if equal_tau t t' then ()
- else
- let ti, ti' = find t, find t' in
- U.unify combine (t, t');
- match ti, ti' with
- Var v, Var v' ->
- set_global t' (v.v_global || get_global t');
- merge_vholes (v, v');
- merge_vlbs (v, v');
- merge_vubs (v, v')
- | Var v, _ ->
- set_global t' (v.v_global || get_global t');
- trigger_vhole v t';
- notify_vlbs t v;
- notify_vubs t v
- | _, Var v ->
- set_global t (v.v_global || get_global t);
- trigger_vhole v t;
- notify_vlbs t' v;
- notify_vubs t' v
- | Ref r, Ref r' ->
- set_global t (r.r_global || r'.r_global);
- unify_ref (r, r')
- | Fun f, Fun f' ->
- set_global t (f.f_global || f'.f_global);
- unify_fun (f, f')
- | Pair p, Pair p' -> ()
- | _ -> raise Inconsistent
-and notify_vlbs (t : tau) (vi : vinfo) : unit =
- let notify p bounds =
- List.iter
- (fun b ->
- add_constraint (Unification (b.info,copy_toplevel t));
- add_constraint (Leq (b.info, (b.index, p), t)))
- bounds
- in
- notify Sub (B.elements vi.v_mlbs);
- notify Pos (B.elements vi.v_plbs);
- notify Neg (B.elements vi.v_nlbs)
-and notify_vubs (t : tau) (vi : vinfo) : unit =
- let notify p bounds =
- List.iter
- (fun b ->
- add_constraint (Unification (b.info,copy_toplevel t));
- add_constraint (Leq (t, (b.index, p), b.info)))
- bounds
- in
- notify Sub (B.elements vi.v_mubs);
- notify Pos (B.elements vi.v_pubs);
- notify Neg (B.elements vi.v_nubs)
-and unify_ref (ri,ri' : rinfo * rinfo) : unit =
- add_constraint (Unification (ri.points_to, ri'.points_to))
-and unify_fun (fi, fi' : finfo * finfo) : unit =
- let rec union_args = function
- _, [] -> false
- | [], _ -> true
- | h :: t, h' :: t' ->
- add_constraint (Unification (h, h'));
- union_args(t, t')
- in
- unify_label(fi.fl, fi'.fl);
- add_constraint (Unification (fi.ret, fi'.ret));
- if union_args (fi.args, fi'.args) then fi.args <- fi'.args;
-and unify_label (l, l' : label * label) : unit =
- let pick_name (li, li' : lblinfo * lblinfo) =
- if String.length li.l_name > 1 && String.sub (li.l_name) 0 2 = "l_" then
- li.l_name <- li'.l_name
- else ()
- in
- let combine_label (li, li' : lblinfo *lblinfo) : lblinfo =
- let rm_self b = not (li.l_stamp = get_label_stamp b.info)
- in
- pick_name (li, li');
- li.l_global <- li.l_global || li'.l_global;
- li.aliases <- C.union li.aliases li'.aliases;
- li.p_ubounds <- B.union li.p_ubounds li'.p_ubounds;
- li.p_lbounds <- B.union li.p_lbounds li'.p_lbounds;
- li.n_ubounds <- B.union li.n_ubounds li'.n_ubounds;
- li.n_lbounds <- B.union li.n_lbounds li'.n_lbounds;
- li.m_ubounds <- B.union li.m_ubounds (B.filter rm_self li'.m_ubounds);
- li.m_lbounds <- B.union li.m_lbounds (B.filter rm_self li'.m_lbounds);
- li.m_upath <- P.union li.m_upath li'.m_upath;
- li.m_lpath<- P.union li.m_lpath li'.m_lpath;
- li.n_upath <- P.union li.n_upath li'.n_upath;
- li.n_lpath <- P.union li.n_lpath li'.n_lpath;
- li.p_upath <- P.union li.p_upath li'.p_upath;
- li.p_lpath <- P.union li.p_lpath li'.p_lpath;
- li.l_seeded <- li.l_seeded || li'.l_seeded;
- li.l_ret <- li.l_ret || li'.l_ret;
- li.l_param <- li.l_param || li'.l_param;
- li
- in
- if !debug_constraints then
- Printf.printf "%s == %s\n" (string_of_label l) (string_of_label l');
- U.unify combine_label (l, l')
-and merge_vholes (vi, vi' : vinfo * vinfo) : unit =
- H.iter
- (fun i -> fun _ -> H.replace vi'.v_hole i ())
- vi.v_hole
-and merge_vlbs (vi, vi' : vinfo * vinfo) : unit =
- vi'.v_mlbs <- B.union vi.v_mlbs vi'.v_mlbs;
- vi'.v_plbs <- B.union vi.v_plbs vi'.v_plbs;
- vi'.v_nlbs <- B.union vi.v_nlbs vi'.v_nlbs
-and merge_vubs (vi, vi' : vinfo * vinfo) : unit =
- vi'.v_mubs <- B.union vi.v_mubs vi'.v_mubs;
- vi'.v_pubs <- B.union vi.v_pubs vi'.v_pubs;
- vi'.v_nubs <- B.union vi.v_nubs vi'.v_nubs
-and trigger_vhole (vi : vinfo) (t : tau) =
- let add_self_loops (t : tau) : unit =
- match find t with
- Var v ->
- H.iter
- (fun i -> fun _ -> H.replace v.v_hole i ())
- vi.v_hole
- | Ref r ->
- H.iter
- (fun i -> fun _ ->
- leq_label (r.rl, (i, Pos), r.rl);
- leq_label (r.rl, (i, Neg), r.rl))
- vi.v_hole
- | Fun f ->
- H.iter
- (fun i -> fun _ ->
- leq_label (f.fl, (i, Pos), f.fl);
- leq_label (f.fl, (i, Neg), f.fl))
- vi.v_hole
- | _ -> ()
- in
- iter_tau add_self_loops t
-(** Pick the representative info for two tinfo's. This function prefers the
- first argument when both arguments are the same structure, but when
- one type is a structure and the other is a var, it picks the structure.
- All other actions (e.g., updating the info) is done in unify_int *)
-and combine (ti, ti' : tinfo * tinfo) : tinfo =
- match ti, ti' with
- Var _, _ -> ti'
- | _, _ -> ti
-and leq_int (t, (i, p), t') : unit =
- if equal_tau t t' then ()
- else
- let ti, ti' = find t, find t' in
- match ti, ti' with
- Var v, Var v' ->
- begin
- match p with
- Pos ->
- v.v_pubs <- B.add (make_tau_bound (i, t')) v.v_pubs;
- v'.v_plbs <- B.add (make_tau_bound (i, t)) v'.v_plbs
- | Neg ->
- v.v_nubs <- B.add (make_tau_bound (i, t')) v.v_nubs;
- v'.v_nlbs <- B.add (make_tau_bound (i, t)) v'.v_nlbs
- | Sub ->
- v.v_mubs <- B.add (make_tau_bound (i, t')) v.v_mubs;
- v'.v_mlbs <- B.add (make_tau_bound (i, t)) v'.v_mlbs
- end
- | Var v, _ ->
- add_constraint (Unification (t, copy_toplevel t'));
- add_constraint (Leq (t, (i, p), t'))
- | _, Var v ->
- add_constraint (Unification (t', copy_toplevel t));
- add_constraint (Leq (t, (i, p), t'))
- | Ref r, Ref r' -> leq_ref (r, (i, p), r')
- | Fun f, Fun f' -> add_constraint (Unification (t, t'))
- | Pair pr, Pair pr' ->
- add_constraint (Leq (pr.ptr, (i, p), pr'.ptr));
- add_constraint (Leq (pr.lam, (i, p), pr'.lam))
- | _ -> raise Inconsistent
-and leq_ref (ri, (i, p), ri') : unit =
- let add_self_loops (t : tau) : unit =
- match find t with
- Var v -> H.replace v.v_hole i ()
- | Ref r ->
- leq_label (r.rl, (i, Pos), r.rl);
- leq_label (r.rl, (i, Neg), r.rl)
- | Fun f ->
- leq_label (f.fl, (i, Pos), f.fl);
- leq_label (f.fl, (i, Neg), f.fl)
- | _ -> ()
- in
- iter_tau add_self_loops ri.points_to;
- add_constraint (Unification (ri.points_to, ri'.points_to));
- leq_label(ri.rl, (i, p), ri'.rl)
-and leq_label (l,(i, p), l') : unit =
- if !debug_constraints then
- Printf.printf
- "%s <={%d,%s} %s\n"
- (string_of_label l) i (string_of_polarity p) (string_of_label l');
- let li, li' = find l, find l' in
- match p with
- Pos ->
- li.l_ret <- true;
- li.p_ubounds <- B.add (make_bound (i, l')) li.p_ubounds;
- li'.p_lbounds <- B.add (make_bound (i, l)) li'.p_lbounds
- | Neg ->
- li'.l_param <- true;
- li.n_ubounds <- B.add (make_bound (i, l')) li.n_ubounds;
- li'.n_lbounds <- B.add (make_bound (i, l)) li'.n_lbounds
- | Sub ->
- if U.equal (l, l') then ()
- else
- begin
- li.m_ubounds <- B.add (make_bound(0, l')) li.m_ubounds;
- li'.m_lbounds <- B.add (make_bound(0, l)) li'.m_lbounds
- end
-and add_constraint_int (c : tconstraint) (toplev : bool) =
- if !debug_constraints && toplev then
- begin
- Printf.printf "%d:>" !toplev_count;
- print_constraint c;
- incr toplev_count
- end
- else
- if !debug_constraints then print_constraint c else ();
- begin
- match c with
- Unification _ -> Q.add c eq_worklist
- | Leq _ -> Q.add c leq_worklist
- end;
- solve_constraints ()
-and add_constraint (c : tconstraint) =
- add_constraint_int c false
-and add_toplev_constraint (c : tconstraint) =
- if !print_constraints && not !debug_constraints then
- begin
- Printf.printf "%d:>" !toplev_count;
- incr toplev_count;
- print_constraint c
- end
- else ();
- add_constraint_int c true
-and fetch_constraint () : tconstraint option =
- try Some (Q.take eq_worklist)
- with Q.Empty -> (try Some (Q.take leq_worklist)
- with Q.Empty -> None)
-(** The main solver loop. *)
-and solve_constraints () : unit =
- match fetch_constraint () with
- Some c ->
- begin
- match c with
- Unification (t, t') -> unify_int (t, t')
- | Leq (t, (i, p), t') ->
- if !no_sub then unify_int (t, t')
- else
- if !analyze_mono then leq_int (t, (0, Sub), t')
- else leq_int (t, (i, p), t')
- end;
- solve_constraints ()
- | None -> ()
-
-
-(***********************************************************************)
-(* *)
-(* Interface Functions *)
-(* *)
-(***********************************************************************)
-
-(** Return the contents of the lvalue. *)
-let rvalue (lv : lvalue) : tau =
- lv.contents
-
-(** Dereference the rvalue. If it does not have enough structure to support
- the operation, then the correct structure is added via new unification
- constraints. *)
-let rec deref (t : tau) : lvalue =
- match U.deref t with
- Pair p ->
- begin
- match U.deref p.ptr with
- Var _ ->
- let is_global = global_tau p.ptr in
- let points_to = fresh_var is_global in
- let l = fresh_label is_global in
- let r = make_ref (l, points_to)
- in
- add_toplev_constraint (Unification (p.ptr, r));
- make_lval (l, points_to)
- | Ref r -> make_lval (r.rl, r.points_to)
- | _ -> raise WellFormed
- end
- | Var v ->
- let is_global = global_tau t in
- add_toplev_constraint
- (Unification (t, make_pair (fresh_var is_global,
- fresh_var is_global)));
- deref t
- | _ -> raise WellFormed
-
-(** Form the union of [t] and [t'], if it doesn't exist already. *)
-let join (t : tau) (t' : tau) : tau =
- try H.find join_cache (get_stamp t, get_stamp t')
- with Not_found ->
- let t'' = fresh_var false in
- add_toplev_constraint (Leq (t, (0, Sub), t''));
- add_toplev_constraint (Leq (t', (0, Sub), t''));
- H.add join_cache (get_stamp t, get_stamp t') t'';
- t''
-
-(** Form the union of a list [tl], expected to be the initializers of some
- structure or array type. *)
-let join_inits (tl : tau list) : tau =
- let t' = fresh_var false in
- List.iter
- (fun t -> add_toplev_constraint (Leq (t, (0, Sub), t')))
- tl;
- t'
-
-(** Take the address of an lvalue. Does not add constraints. *)
-let address (lv : lvalue) : tau =
- make_pair (make_ref (lv.l, lv.contents), fresh_var false)
-
-(** For this version of golf, instantiation is handled at [apply] *)
-let instantiate (lv : lvalue) (i : int) : lvalue =
- lv
-
-(** Constraint generated from assigning [t] to [lv]. *)
-let assign (lv : lvalue) (t : tau) : unit =
- add_toplev_constraint (Leq (t, (0, Sub), lv.contents))
-
-let assign_ret (i : int) (lv : lvalue) (t : tau) : unit =
- add_toplev_constraint (Leq (t, (i, Pos), lv.contents))
-
-(** Project out the first (ref) component or a pair. If the argument [t] has
- no discovered structure, raise NoContents. *)
-let proj_ref (t : tau) : tau =
- match U.deref t with
- Pair p -> p.ptr
- | Var v -> raise NoContents
- | _ -> raise WellFormed
-
-(* Project out the second (fun) component of a pair. If the argument [t] has
- no discovered structure, create it on the fly by adding constraints. *)
-let proj_fun (t : tau) : tau =
- match U.deref t with
- Pair p -> p.lam
- | Var v ->
- let p, f = fresh_var false, fresh_var false in
- add_toplev_constraint (Unification (t, make_pair(p, f)));
- f
- | _ -> raise WellFormed
-
-let get_args (t : tau) : tau list =
- match U.deref t with
- Fun f -> f.args
- | _ -> raise WellFormed
-
-let get_finfo (t : tau) : finfo =
- match U.deref t with
- Fun f -> f
- | _ -> raise WellFormed
-
-(** Function type [t] is applied to the arguments [actuals]. Unifies the
- actuals with the formals of [t]. If no functions have been discovered for
- [t] yet, create a fresh one and unify it with t. The result is the return
- value of the function plus the index of this application site. *)
-let apply (t : tau) (al : tau list) : (tau * int) =
- let i = fresh_appsite () in
- let f = proj_fun t in
- let actuals = ref al in
- let fi,ret =
- match U.deref f with
- Fun fi -> fi, fi.ret
- | Var v ->
- let new_l, new_ret, new_args =
- fresh_label false, fresh_var false,
- List.map (function _ -> fresh_var false) !actuals
- in
- let new_fun = make_fun (new_l, new_args, new_ret) in
- add_toplev_constraint (Unification (new_fun, f));
- (get_finfo new_fun, new_ret)
- | _ -> raise WellFormed
- in
- pad_args2 (fi, actuals);
- List.iter2
- (fun actual -> fun formal ->
- add_toplev_constraint (Leq (actual,(i, Neg), formal)))
- !actuals fi.args;
- (ret, i)
-
-(** Create a new function type with name [name], list of formal arguments
- [formals], and return value [ret]. Adds no constraints. *)
-let make_function (name : string) (formals : lvalue list) (ret : tau) : tau =
- let f = make_fun (make_label false name None,
- List.map (fun x -> rvalue x) formals,
- ret)
- in
- make_pair (fresh_var false, f)
-
-(** Create an lvalue. If [is_global] is true, the lvalue will be treated
- monomorphically. *)
-let make_lvalue (is_global : bool) (name : string) (vio : Cil.varinfo option) : lvalue =
- if !debug && is_global then
- Printf.printf "Making global lvalue : %s\n" name
- else ();
- make_lval (make_label is_global name vio, make_var is_global name)
-
-(** Create a fresh non-global named variable. *)
-let make_fresh (name : string) : tau =
- make_var false name
-
-(** The default type for constants. *)
-let bottom () : tau =
- make_var false "bottom"
-
-(** Unify the result of a function with its return value. *)
-let return (t : tau) (t' : tau) =
- add_toplev_constraint (Leq (t', (0, Sub), t))
-
-(***********************************************************************)
-(* *)
-(* Query/Extract Solutions *)
-(* *)
-(***********************************************************************)
-
-let make_summary = leq_label
-
-let path_signature k l l' b : int list =
- let ksig =
- match k with
- Positive -> 1
- | Negative -> 2
- | _ -> 3
- in
- [ksig;
- get_label_stamp l;
- get_label_stamp l';
- if b then 1 else 0]
-
-let make_path (k, l, l', b) =
- let psig = path_signature k l l' b in
- if PH.mem path_hash psig then ()
- else
- let new_path = {kind = k; head = l; tail = l'; reached_global = b}
- and li, li' = find l, find l' in
- PH.add path_hash psig new_path;
- Q.add new_path path_worklist;
- begin
- match k with
- Positive ->
- li.p_upath <- P.add new_path li.p_upath;
- li'.p_lpath <- P.add new_path li'.p_lpath
- | Negative ->
- li.n_upath <- P.add new_path li.n_upath;
- li'.n_lpath <- P.add new_path li'.n_lpath
- | _ ->
- li.m_upath <- P.add new_path li.m_upath;
- li'.m_lpath <- P.add new_path li'.m_lpath
- end;
- if !debug then
- begin
- print_string "Discovered path : ";
- print_path new_path;
- print_newline ()
- end
-
-let backwards_tabulate (l : label) : unit =
- let rec loop () =
- let rule1 p =
- if !debug then print_endline "rule1";
- B.iter
- (fun lb ->
- make_path (Match, lb.info, p.tail,
- p.reached_global || is_global_label p.head))
- (find p.head).m_lbounds
- and rule2 p =
- if !debug then print_endline "rule2";
- B.iter
- (fun lb ->
- make_path (Negative, lb.info, p.tail,
- p.reached_global || is_global_label p.head))
- (find p.head).n_lbounds
- and rule2m p =
- if !debug then print_endline "rule2m";
- B.iter
- (fun lb ->
- make_path (Match, lb.info, p.tail,
- p.reached_global || is_global_label p.head))
- (find p.head).n_lbounds
- and rule3 p =
- if !debug then print_endline "rule3";
- B.iter
- (fun lb ->
- make_path (Positive, lb.info, p.tail,
- p.reached_global || is_global_label p.head))
- (find p.head).p_lbounds
- and rule4 p =
- if !debug then print_endline "rule4";
- B.iter
- (fun lb ->
- make_path(Negative, lb.info, p.tail,
- p.reached_global || is_global_label p.head))
- (find p.head).m_lbounds
- and rule5 p =
- if !debug then print_endline "rule5";
- B.iter
- (fun lb ->
- make_path (Positive, lb.info, p.tail,
- p.reached_global || is_global_label p.head))
- (find p.head).m_lbounds
- and rule6 p =
- if !debug then print_endline "rule6";
- B.iter
- (fun lb ->
- if is_seeded_label lb.info then ()
- else
- begin
- (find lb.info).l_seeded <- true; (* set seeded *)
- make_path (Seed, lb.info, lb.info,
- is_global_label lb.info)
- end)
- (find p.head).p_lbounds
- and rule7 p =
- if !debug then print_endline "rule7";
- if not (is_ret_label p.tail && is_param_label p.head) then ()
- else
- B.iter
- (fun lb ->
- B.iter
- (fun ub ->
- if lb.index = ub.index then
- begin
- if !debug then
- Printf.printf "New summary : %s %s\n"
- (string_of_label lb.info)
- (string_of_label ub.info);
- make_summary (lb.info, (0, Sub), ub.info);
- (* rules 1, 4, and 5 *)
- P.iter
- (fun ubp -> (* rule 1 *)
- make_path (Match, lb.info, ubp.tail,
- ubp.reached_global))
- (find ub.info).m_upath;
- P.iter
- (fun ubp -> (* rule 4 *)
- make_path (Negative, lb.info, ubp.tail,
- ubp.reached_global))
- (find ub.info).n_upath;
- P.iter
- (fun ubp -> (* rule 5 *)
- make_path (Positive, lb.info, ubp.tail,
- ubp.reached_global))
- (find ub.info).p_upath
- end)
- (find p.tail).p_ubounds)
- (find p.head).n_lbounds
- in
- let matched_backward_rules p =
- rule1 p;
- if p.reached_global then rule2m p else rule2 p;
- rule3 p;
- rule6 p;
- rule7 p
- and negative_backward_rules p =
- rule2 p;
- rule3 p;
- rule4 p;
- rule6 p;
- rule7 p
- and positive_backward_rules p =
- rule3 p;
- rule5 p;
- rule6 p;
- rule7 p
- in (* loop *)
- if Q.is_empty path_worklist then ()
- else
- let p = Q.take path_worklist in
- if !debug then
- begin
- print_string "Processing path: ";
- print_path p;
- print_newline ()
- end;
- begin
- match p.kind with
- Positive ->
- if is_global_label p.tail then matched_backward_rules p
- else positive_backward_rules p
- | Negative -> negative_backward_rules p
- | _ -> matched_backward_rules p
- end;
- loop ()
- in (* backwards_tabulate *)
- if !debug then
- begin
- Printf.printf "Tabulating for %s..." (string_of_label l);
- if is_global_label l then print_string "(global)";
- print_newline ()
- end;
- make_path (Seed, l, l, is_global_label l);
- loop ()
-
-let collect_ptsets (l : label) : constantset = (* todo -- cache aliases *)
- let li = find l
- and collect init s =
- P.fold (fun x a -> C.union a (find x.head).aliases) s init
- in
- backwards_tabulate l;
- collect (collect (collect li.aliases li.m_lpath) li.n_lpath) li.p_lpath
-
-let extract_ptlabel (lv : lvalue) : label option =
- try
- match find (proj_ref lv.contents) with
- Var v -> None
- | Ref r -> Some r.rl;
- | _ -> raise WellFormed
- with NoContents -> None
-
-let points_to_aux (t : tau) : constant list =
- try
- match find (proj_ref t) with
- Var v -> []
- | Ref r -> C.elements (collect_ptsets r.rl)
- | _ -> raise WellFormed
- with NoContents -> []
-
-let points_to_names (lv : lvalue) : string list =
- List.map (fun (_, str, _) -> str) (points_to_aux lv.contents)
-
-let points_to (lv : lvalue) : Cil.varinfo list =
- let rec get_vinfos l : Cil.varinfo list = match l with
- | (_, _, h) :: t -> h :: get_vinfos t
- | [] -> []
- in
- get_vinfos (points_to_aux lv.contents)
-
-let epoints_to (t : tau) : Cil.varinfo list =
- let rec get_vinfos l : Cil.varinfo list = match l with
- | (_, _, h) :: t -> h :: get_vinfos t
- | [] -> []
- in
- get_vinfos (points_to_aux t)
-
-let smart_alias_query (l : label) (l' : label) : bool =
- (* Set of dead configurations *)
- let dead_configs : config_map = CH.create 16 in
- (* the set of discovered configurations *)
- let discovered : config_map = CH.create 16 in
- let rec filter_match (i : int) =
- B.filter (fun (b : lblinfo bound) -> i = b.index)
- in
- let rec simulate c l l' =
- let config = (c, get_label_stamp l, get_label_stamp l') in
- if U.equal (l, l') then
- begin
- if !debug then
- Printf.printf
- "%s and %s are aliased\n"
- (string_of_label l)
- (string_of_label l');
- raise APFound
- end
- else if CH.mem discovered config then ()
- else
- begin
- if !debug_aliases then
- Printf.printf
- "Exploring configuration %s\n"
- (string_of_configuration config);
- CH.add discovered config ();
- B.iter
- (fun lb -> simulate c lb.info l')
- (get_bounds Sub false l); (* epsilon closure of l *)
- B.iter
- (fun lb -> simulate c l lb.info)
- (get_bounds Sub false l'); (* epsilon closure of l' *)
- B.iter
- (fun lb ->
- let matching =
- filter_match lb.index (get_bounds Pos false l')
- in
- B.iter
- (fun b -> simulate Closed lb.info b.info)
- matching;
- if is_global_label l' then (* positive self-loops on l' *)
- simulate Closed lb.info l')
- (get_bounds Pos false l); (* positive transitions on l *)
- if is_global_label l then
- B.iter
- (fun lb -> simulate Closed l lb.info)
- (get_bounds Pos false l'); (* positive self-loops on l *)
- begin
- match c with (* negative transitions on l, only if Open *)
- Open ->
- B.iter
- (fun lb ->
- let matching =
- filter_match lb.index (get_bounds Neg false l')
- in
- B.iter
- (fun b -> simulate Open lb.info b.info)
- matching ;
- if is_global_label l' then (* neg self-loops on l' *)
- simulate Open lb.info l')
- (get_bounds Neg false l);
- if is_global_label l then
- B.iter
- (fun lb -> simulate Open l lb.info)
- (get_bounds Neg false l') (* negative self-loops on l *)
- | _ -> ()
- end;
- (* if we got this far, then the configuration was not used *)
- CH.add dead_configs config ();
- end
- in
- try
- begin
- if H.mem cached_aliases (get_label_stamp l, get_label_stamp l') then
- true
- else
- begin
- simulate Open l l';
- if !debug then
- Printf.printf
- "%s and %s are NOT aliased\n"
- (string_of_label l)
- (string_of_label l');
- false
- end
- end
- with APFound ->
- CH.iter
- (fun config -> fun _ ->
- if not (CH.mem dead_configs config) then
- H.add
- cached_aliases
- (get_label_stamp l, get_label_stamp l')
- ())
- discovered;
- true
-
-(** todo : uses naive alias query for now *)
-let may_alias (t1 : tau) (t2 : tau) : bool =
- try
- let l1 =
- match find (proj_ref t1) with
- Ref r -> r.rl
- | Var v -> raise NoContents
- | _ -> raise WellFormed
- and l2 =
- match find (proj_ref t2) with
- Ref r -> r.rl
- | Var v -> raise NoContents
- | _ -> raise WellFormed
- in
- not (C.is_empty (C.inter (collect_ptsets l1) (collect_ptsets l2)))
- with NoContents -> false
-
-let alias_query (b : bool) (lvl : lvalue list) : int * int =
- let naive_count = ref 0 in
- let smart_count = ref 0 in
- let lbls = List.map extract_ptlabel lvl in (* label option list *)
- let ptsets =
- List.map
- (function
- Some l -> collect_ptsets l
- | None -> C.empty)
- lbls in
- let record_alias s lo s' lo' =
- match lo, lo' with
- Some l, Some l' ->
- if !debug_aliases then
- Printf.printf
- "Checking whether %s and %s are aliased...\n"
- (string_of_label l)
- (string_of_label l');
- if C.is_empty (C.inter s s') then ()
- else
- begin
- incr naive_count;
- if !smart_aliases && smart_alias_query l l' then
- incr smart_count
- end
- | _ -> ()
- in
- let rec check_alias sets labels =
- match sets,labels with
- s :: st, l :: lt ->
- List.iter2 (record_alias s l) ptsets lbls;
- check_alias st lt
- | [], [] -> ()
- | _ -> die "check_alias"
- in
- check_alias ptsets lbls;
- (!naive_count, !smart_count)
-
-let alias_frequency (lvl : (lvalue * bool) list) : int * int =
- let extract_lbl (lv, b : lvalue * bool) = (lv.l, b) in
- let naive_count = ref 0 in
- let smart_count = ref 0 in
- let lbls = List.map extract_lbl lvl in
- let ptsets =
- List.map
- (fun (lbl, b) ->
- if b then (find lbl).loc (* symbol access *)
- else collect_ptsets lbl)
- lbls in
- let record_alias s (l, b) s' (l', b') =
- if !debug_aliases then
- Printf.printf
- "Checking whether %s and %s are aliased...\n"
- (string_of_label l)
- (string_of_label l');
- if C.is_empty (C.inter s s') then ()
- else
- begin
- if !debug_aliases then
- Printf.printf
- "%s and %s are aliased naively...\n"
- (string_of_label l)
- (string_of_label l');
- incr naive_count;
- if !smart_aliases then
- if b || b' || smart_alias_query l l' then incr smart_count
- else
- Printf.printf
- "%s and %s are not aliased by smart queries...\n"
- (string_of_label l)
- (string_of_label l');
- end
- in
- let rec check_alias sets labels =
- match sets, labels with
- s :: st, l :: lt ->
- List.iter2 (record_alias s l) ptsets lbls;
- check_alias st lt
- | [], [] -> ()
- | _ -> die "check_alias"
- in
- check_alias ptsets lbls;
- (!naive_count, !smart_count)
-
-
-(** an interface for extracting abstract locations from this analysis *)
-
-type absloc = label
-
-let absloc_of_lvalue (l : lvalue) : absloc = l.l
-let absloc_eq (a1, a2) = smart_alias_query a1 a2
-let absloc_print_name = ref true
-let d_absloc () (p : absloc) =
- let a = find p in
- if !absloc_print_name then Pretty.dprintf "%s" a.l_name
- else Pretty.dprintf "%d" a.l_stamp
-
-let phonyAddrOf (lv : lvalue) : lvalue =
- make_lval (fresh_label true, address lv)
-
-(* transitive closure of points to, starting from l *)
-let rec tauPointsTo (l : tau) : absloc list =
- match find l with
- Var _ -> []
- | Ref r -> r.rl :: tauPointsTo r.points_to
- | _ -> []
-
-let rec absloc_points_to (l : lvalue) : absloc list =
- tauPointsTo l.contents
-
-
-(** The following definitions are only introduced for the
- compatability with Olf. *)
-
-exception UnknownLocation
-
-let finished_constraints () = ()
-let apply_undefined (_ : tau list) = (fresh_var true, 0)
-let assign_undefined (_ : lvalue) = ()
-
-let absloc_epoints_to = tauPointsTo
diff --git a/cil/src/ext/pta/golf.mli b/cil/src/ext/pta/golf.mli
deleted file mode 100644
index 569855c5915cf4eae6da861bc39cf684da88e680..0000000000000000000000000000000000000000
--- a/cil/src/ext/pta/golf.mli
+++ /dev/null
@@ -1,83 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * John Kodumal <jkodumal@eecs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-type lvalue
-type tau
-type absloc
-
-(* only for compatability with Olf *)
-exception UnknownLocation
-
-val debug : bool ref
-val debug_constraints : bool ref
-val debug_aliases : bool ref
-val smart_aliases : bool ref
-val finished_constraints : unit -> unit (* only for compatability with Olf *)
-val print_constraints : bool ref
-val no_flow : bool ref
-val no_sub : bool ref
-val analyze_mono : bool ref
-val solve_constraints : unit -> unit
-val rvalue : lvalue -> tau
-val deref : tau -> lvalue
-val join : tau -> tau -> tau
-val join_inits : tau list -> tau
-val address : lvalue -> tau
-val instantiate : lvalue -> int -> lvalue
-val assign : lvalue -> tau -> unit
-val assign_ret : int -> lvalue -> tau -> unit
-val apply : tau -> tau list -> (tau * int)
-val apply_undefined : tau list -> (tau * int) (* only for compatability with Olf *)
-val assign_undefined : lvalue -> unit (* only for compatability with Olf *)
-val make_function : string -> lvalue list -> tau -> tau
-val make_lvalue : bool -> string -> (Cil.varinfo option) -> lvalue
-val bottom : unit -> tau
-val return : tau -> tau -> unit
-val make_fresh : string -> tau
-val points_to_names : lvalue -> string list
-val points_to : lvalue -> Cil.varinfo list
-val epoints_to : tau -> Cil.varinfo list
-val string_of_lvalue : lvalue -> string
-val global_lvalue : lvalue -> bool
-val alias_query : bool -> lvalue list -> int * int
-val alias_frequency : (lvalue * bool) list -> int * int
-
-val may_alias : tau -> tau -> bool
-
-val absloc_points_to : lvalue -> absloc list
-val absloc_epoints_to : tau -> absloc list
-val absloc_of_lvalue : lvalue -> absloc
-val absloc_eq : (absloc * absloc) -> bool
-val d_absloc : unit -> absloc -> Pretty.doc
-val phonyAddrOf : lvalue -> lvalue
diff --git a/cil/src/ext/pta/olf.ml b/cil/src/ext/pta/olf.ml
deleted file mode 100644
index 0d770028732e1f54f9162d402ee1f448705372ed..0000000000000000000000000000000000000000
--- a/cil/src/ext/pta/olf.ml
+++ /dev/null
@@ -1,1108 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * John Kodumal <jkodumal@eecs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(***********************************************************************)
-(* *)
-(* Exceptions *)
-(* *)
-(***********************************************************************)
-
-exception Inconsistent (* raised if constraint system is inconsistent *)
-exception WellFormed (* raised if types are not well-formed *)
-exception NoContents
-exception APFound (* raised if an alias pair is found, a control
- flow exception *)
-exception ReachedTop (* raised if top (from an undefined function)
- flows to a c_absloc during the flow step *)
-exception UnknownLocation
-
-let solve_constraints () = () (* only for compatability with Golf *)
-
-open Cil
-
-module U = Uref
-module S = Setp
-module H = Hashtbl
-module Q = Queue
-
-(** Generic bounds *)
-type 'a bound = {info : 'a U.uref}
-
-module Bound =
-struct
- type 'a t = 'a bound
- let compare (x : 'a t) (y : 'a t) =
- Pervasives.compare (U.deref x.info) (U.deref y.info)
-end
-
-module B = S.Make (Bound)
-
-type 'a boundset = 'a B.t
-
-(** Abslocs, which identify elements in points-to sets *)
-(** jk : I'd prefer to make this an 'a absloc and specialize it to
- varinfo for use with the Cil frontend, but for now, this will do *)
-type absloc = int * string * Cil.varinfo option
-
-module Absloc =
-struct
- type t = absloc
- let compare (xid, _, _) (yid, _, _) = xid - yid
-end
-
-module C = Set.Make (Absloc)
-
-(** Sets of abslocs. Set union is used when two c_abslocs containing
- absloc sets are unified *)
-type abslocset = C.t
-
-let d_absloc () (a: absloc) : Pretty.doc =
- let i,s,_ = a in
- Pretty.dprintf "<%d, %s>" i s
-
-type c_abslocinfo = {
- mutable l_name: string; (** name of the location *)
- loc : absloc;
- l_stamp : int;
- mutable l_top : bool;
- mutable aliases : abslocset;
- mutable lbounds : c_abslocinfo boundset;
- mutable ubounds : c_abslocinfo boundset;
- mutable flow_computed : bool
-}
-and c_absloc = c_abslocinfo U.uref
-
-(** The type of lvalues. *)
-type lvalue = {
- l: c_absloc;
- contents: tau
-}
-and vinfo = {
- v_stamp : int;
- v_name : string;
- mutable v_top : bool;
- mutable v_lbounds : tinfo boundset;
- mutable v_ubounds : tinfo boundset
-}
-and rinfo = {
- r_stamp : int;
- rl : c_absloc;
- points_to : tau
-}
-and finfo = {
- f_stamp : int;
- fl : c_absloc;
- ret : tau;
- mutable args : tau list
-}
-and pinfo = {
- p_stamp : int;
- ptr : tau;
- lam : tau
-}
-and tinfo =
- Var of vinfo
- | Ref of rinfo
- | Fun of finfo
- | Pair of pinfo
-and tau = tinfo U.uref
-
-type tconstraint =
- Unification of tau * tau
- | Leq of tau * tau
-
-(** Association lists, used for printing recursive types. The first
- element is a type that has been visited. The second element is the
- string representation of that type (so far). If the string option is
- set, then this type occurs within itself, and is associated with the
- recursive var name stored in the option. When walking a type, add it
- to an association list.
-
- Example: suppose we have the constraint 'a = ref('a). The type is
- unified via cyclic unification, and would loop infinitely if we
- attempted to print it. What we want to do is print the type u
- rv. ref(rv). This is accomplished in the following manner:
-
- -- ref('a) is visited. It is not in the association list, so it is
- added and the string "ref(" is stored in the second element. We
- recurse to print the first argument of the constructor.
-
- -- In the recursive call, we see that 'a (or ref('a)) is already
- in the association list, so the type is recursive. We check the
- string option, which is None, meaning that this is the first
- recurrence of the type. We create a new recursive variable, rv and
- set the string option to 'rv. Next, we prepend u rv. to the string
- representation we have seen before, "ref(", and return "rv" as the
- string representation of this type.
-
- -- The string so far is "u rv.ref(". The recursive call returns,
- and we complete the type by printing the result of the call, "rv",
- and ")"
-
- In a type where the recursive variable appears twice, e.g. 'a =
- pair('a,'a), the second time we hit 'a, the string option will be
- set, so we know to reuse the same recursive variable name.
-*)
-type association = tau * string ref * string option ref
-
-(** The current state of the solver engine either adding more
- constraints, or finished adding constraints and querying graph *)
-type state =
- AddingConstraints
- | FinishedConstraints
-
-(***********************************************************************)
-(* *)
-(* Global Variables *)
-(* *)
-(***********************************************************************)
-
-(** A count of the constraints introduced from the AST. Used for
- debugging. *)
-let toplev_count = ref 0
-
-let solver_state : state ref = ref AddingConstraints
-
-(** Print the instantiations constraints. *)
-let print_constraints : bool ref = ref false
-
-(** If true, print all constraints (including induced) and show
- additional debug output. *)
-let debug = ref false
-
-(** Just debug all the constraints (including induced) *)
-let debug_constraints = ref false
-
-(** Debug the flow step *)
-let debug_flow_step = ref false
-
-(** Compatibility with GOLF *)
-let debug_aliases = ref false
-let smart_aliases = ref false
-let no_flow = ref false
-let analyze_mono = ref false
-
-(** If true, disable subtyping (unification at all levels) *)
-let no_sub = ref false
-
-(** A list of equality constraints. *)
-let eq_worklist : tconstraint Q.t = Q.create ()
-
-(** A list of leq constraints. *)
-let leq_worklist : tconstraint Q.t = Q.create ()
-
-(** A hashtable containing stamp pairs of c_abslocs that must be aliased. *)
-let cached_aliases : (int * int, unit) H.t = H.create 64
-
-(** A hashtable mapping pairs of tau's to their join node. *)
-let join_cache : (int * int, tau) H.t = H.create 64
-
-(** *)
-let label_prefix = "l_"
-
-
-(***********************************************************************)
-(* *)
-(* Utility Functions *)
-(* *)
-(***********************************************************************)
-
-let starts_with s p =
- let n = String.length p in
- if String.length s < n then false
- else String.sub s 0 n = p
-
-
-let die s =
- Printf.printf "*******\nAssertion failed: %s\n*******\n" s;
- assert false
-
-let insist b s =
- if not b then die s else ()
-
-
-let can_add_constraints () =
- !solver_state = AddingConstraints
-
-let can_query_graph () =
- !solver_state = FinishedConstraints
-
-let finished_constraints () =
- insist (!solver_state = AddingConstraints) "inconsistent states";
- solver_state := FinishedConstraints
-
-let find = U.deref
-
-(** return the prefix of the list up to and including the first
- element satisfying p. if no element satisfies p, return the empty
- list *)
-let rec keep_until p l =
- match l with
- [] -> []
- | x :: xs -> if p x then [x] else x :: keep_until p xs
-
-
-(** Generate a unique integer. *)
-let fresh_index : (unit -> int) =
- let counter = ref 0 in
- fun () ->
- incr counter;
- !counter
-
-let fresh_stamp : (unit -> int) =
- let stamp = ref 0 in
- fun () ->
- incr stamp;
- !stamp
-
-(** Return a unique integer representation of a tau *)
-let get_stamp (t : tau) : int =
- match find t with
- Var v -> v.v_stamp
- | Ref r -> r.r_stamp
- | Pair p -> p.p_stamp
- | Fun f -> f.f_stamp
-
-(** Consistency checks for inferred types *)
-let pair_or_var (t : tau) =
- match find t with
- Pair _ -> true
- | Var _ -> true
- | _ -> false
-
-let ref_or_var (t : tau) =
- match find t with
- Ref _ -> true
- | Var _ -> true
- | _ -> false
-
-let fun_or_var (t : tau) =
- match find t with
- Fun _ -> true
- | Var _ -> true
- | _ -> false
-
-
-(** Apply [f] structurally down [t]. Guaranteed to terminate, even if [t]
- is recursive *)
-let iter_tau f t =
- let visited : (int, tau) H.t = H.create 4 in
- let rec iter_tau' t =
- if H.mem visited (get_stamp t) then () else
- begin
- f t;
- H.add visited (get_stamp t) t;
- match find t with
- Pair p ->
- iter_tau' p.ptr;
- iter_tau' p.lam
- | Fun f ->
- List.iter iter_tau' f.args;
- iter_tau' f.ret;
- | Ref r -> iter_tau' r.points_to
- | _ -> ()
- end
- in
- iter_tau' t
-
-let equal_absloc = function
- (i, _, _), (i', _, _) -> i = i'
-
-let equal_c_absloc l l' =
- (find l).l_stamp = (find l').l_stamp
-
-let equal_tau (t : tau) (t' : tau) =
- get_stamp t = get_stamp t'
-
-let top_c_absloc l =
- (find l).l_top
-
-let get_flow_computed l =
- (find l).flow_computed
-
-let set_flow_computed l =
- (find l).flow_computed <- true
-
-let rec top_tau (t : tau) =
- match find t with
- Pair p -> top_tau p.ptr || top_tau p.lam
- | Ref r -> top_c_absloc r.rl
- | Fun f -> top_c_absloc f.fl
- | Var v -> v.v_top
-
-let get_c_absloc_stamp (l : c_absloc) : int =
- (find l).l_stamp
-
-let set_top_c_absloc (l : c_absloc) (b: bool) : unit =
- (find l).l_top <- b
-
-let get_aliases (l : c_absloc) =
- if top_c_absloc l then raise ReachedTop
- else (find l).aliases
-
-(***********************************************************************)
-(* *)
-(* Printing Functions *)
-(* *)
-(***********************************************************************)
-
-(** Convert a c_absloc to a string, short representation *)
-let string_of_c_absloc (l : c_absloc) : string =
- "\"" ^
- (find l).l_name ^
- if top_c_absloc l then "(top)" else "" ^
- "\""
-
-(** Return true if the element [e] is present in the association list,
- according to uref equality *)
-let rec assoc_list_mem (e : tau) (l : association list) =
- match l with
- [] -> None
- | (h, s, so) :: t ->
- if U.equal (h, e) then Some (s, so)
- else assoc_list_mem e t
-
-(** Given a tau, create a unique recursive variable name. This should
- always return the same name for a given tau *)
-let fresh_recvar_name (t : tau) : string =
- match find t with
- Pair p -> "rvp" ^ string_of_int p.p_stamp
- | Ref r -> "rvr" ^ string_of_int r.r_stamp
- | Fun f -> "rvf" ^ string_of_int f.f_stamp
- | _ -> die "fresh_recvar_name"
-
-
-(** Return a string representation of a tau, using association lists. *)
-let string_of_tau (t : tau) : string =
- let tau_map : association list ref = ref [] in
- let rec string_of_tau' t =
- match assoc_list_mem t !tau_map with
- Some (s, so) -> (* recursive type. see if a var name has been set *)
- begin
- match !so with
- None ->
- let rv = fresh_recvar_name t in
- s := "u " ^ rv ^ "." ^ !s;
- so := Some rv;
- rv
- | Some rv -> rv
- end
- | None -> (* type's not recursive. Add it to the assoc list and cont. *)
- let s = ref ""
- and so : string option ref = ref None in
- tau_map := (t, s, so) :: !tau_map;
- begin
- match find t with
- Var v -> s := v.v_name
- | Pair p ->
- insist (ref_or_var p.ptr) "wellformed";
- insist (fun_or_var p.lam) "wellformed";
- s := "{";
- s := !s ^ string_of_tau' p.ptr;
- s := !s ^ ",";
- s := !s ^ string_of_tau' p.lam;
- s := !s ^ "}"
- | Ref r ->
- insist (pair_or_var r.points_to) "wellformed";
- s := "ref(|";
- s := !s ^ string_of_c_absloc r.rl;
- s := !s ^ "|,";
- s := !s ^ string_of_tau' r.points_to;
- s := !s ^ ")"
- | Fun f ->
- let rec string_of_args = function
- [] -> ()
- | h :: [] ->
- insist (pair_or_var h) "wellformed";
- s := !s ^ string_of_tau' h
- | h :: t ->
- insist (pair_or_var h) "wellformed";
- s := !s ^ string_of_tau' h ^ ",";
- string_of_args t
- in
- insist (pair_or_var f.ret) "wellformed";
- s := "fun(|";
- s := !s ^ string_of_c_absloc f.fl;
- s := !s ^ "|,";
- s := !s ^ "<";
- if List.length f.args > 0 then string_of_args f.args
- else s := !s ^ "void";
- s := !s ^ ">,";
- s := !s ^ string_of_tau' f.ret;
- s := !s ^ ")"
- end;
- tau_map := List.tl !tau_map;
- !s
- in
- string_of_tau' t
-
-(** Convert an lvalue to a string *)
-let rec string_of_lvalue (lv : lvalue) : string =
- let contents = string_of_tau lv.contents
- and l = string_of_c_absloc lv.l
- in
- insist (pair_or_var lv.contents) "inconsistency at string_of_lvalue";
- (* do a consistency check *)
- Printf.sprintf "[%s]^(%s)" contents l
-
-(** Print a list of tau elements, comma separated *)
-let rec print_tau_list (l : tau list) : unit =
- let rec print_t_strings = function
- [] -> ()
- | h :: [] -> print_endline h
- | h :: t ->
- print_string h;
- print_string ", ";
- print_t_strings t
- in
- print_t_strings (List.map string_of_tau l)
-
-let print_constraint (c : tconstraint) =
- match c with
- Unification (t, t') ->
- let lhs = string_of_tau t in
- let rhs = string_of_tau t' in
- Printf.printf "%s == %s\n" lhs rhs
- | Leq (t, t') ->
- let lhs = string_of_tau t in
- let rhs = string_of_tau t' in
- Printf.printf "%s <= %s\n" lhs rhs
-
-(***********************************************************************)
-(* *)
-(* Type Operations -- these do not create any constraints *)
-(* *)
-(***********************************************************************)
-
-(** Create an lvalue with c_absloc [lbl] and tau contents [t]. *)
-let make_lval (loc, t : c_absloc * tau) : lvalue =
- {l = loc; contents = t}
-
-let make_c_absloc_int (is_top : bool) (name : string) (vio : Cil.varinfo option) : c_absloc =
- let my_absloc = (fresh_index (), name, vio) in
- let locc = C.add my_absloc C.empty
- in
- U.uref {
- l_name = name;
- l_top = is_top;
- l_stamp = fresh_stamp ();
- loc = my_absloc;
- aliases = locc;
- ubounds = B.empty;
- lbounds = B.empty;
- flow_computed = false
- }
-
-(** Create a new c_absloc with name [name]. Also adds a fresh absloc
- with name [name] to this c_absloc's aliases set. *)
-let make_c_absloc (is_top : bool) (name : string) (vio : Cil.varinfo option) =
- make_c_absloc_int is_top name vio
-
-let fresh_c_absloc (is_top : bool) : c_absloc =
- let index = fresh_index () in
- make_c_absloc_int is_top (label_prefix ^ string_of_int index) None
-
-(** Create a fresh bound (edge in the constraint graph). *)
-let make_bound (a : c_absloc) : c_abslocinfo bound =
- {info = a}
-
-let make_tau_bound (t : tau) : tinfo bound =
- {info = t}
-
-(** Create a fresh named variable with name '[name]. *)
-let make_var (is_top : bool) (name : string) : tau =
- U.uref (Var {v_name = ("'" ^ name);
- v_top = is_top;
- v_stamp = fresh_index ();
- v_lbounds = B.empty;
- v_ubounds = B.empty})
-
-let fresh_var (is_top : bool) : tau =
- make_var is_top ("fi" ^ string_of_int (fresh_index ()))
-
-(** Create a fresh unnamed variable (name will be 'fi). *)
-let fresh_var_i (is_top : bool) : tau =
- make_var is_top ("fi" ^ string_of_int (fresh_index ()))
-
-(** Create a Fun constructor. *)
-let make_fun (lbl, a, r : c_absloc * (tau list) * tau) : tau =
- U.uref (Fun {fl = lbl;
- f_stamp = fresh_index ();
- args = a;
- ret = r})
-
-(** Create a Ref constructor. *)
-let make_ref (lbl, pt : c_absloc * tau) : tau =
- U.uref (Ref {rl = lbl;
- r_stamp = fresh_index ();
- points_to = pt})
-
-(** Create a Pair constructor. *)
-let make_pair (p, f : tau * tau) : tau =
- U.uref (Pair {ptr = p;
- p_stamp = fresh_index ();
- lam = f})
-
-(** Copy the toplevel constructor of [t], putting fresh variables in each
- argement of the constructor. *)
-let copy_toplevel (t : tau) : tau =
- match find t with
- Pair _ -> make_pair (fresh_var_i false, fresh_var_i false)
- | Ref _ -> make_ref (fresh_c_absloc false, fresh_var_i false)
- | Fun f ->
- make_fun (fresh_c_absloc false,
- List.map (fun _ -> fresh_var_i false) f.args,
- fresh_var_i false)
- | _ -> die "copy_toplevel"
-
-let has_same_structure (t : tau) (t' : tau) =
- match find t, find t' with
- Pair _, Pair _ -> true
- | Ref _, Ref _ -> true
- | Fun _, Fun _ -> true
- | Var _, Var _ -> true
- | _ -> false
-
-let pad_args (fi, tlr : finfo * tau list ref) : unit =
- let padding = List.length fi.args - List.length !tlr
- in
- if padding == 0 then ()
- else
- if padding > 0 then
- for i = 1 to padding do
- tlr := !tlr @ [fresh_var false]
- done
- else
- for i = 1 to -padding do
- fi.args <- fi.args @ [fresh_var false]
- done
-
-(***********************************************************************)
-(* *)
-(* Constraint Generation/ Resolution *)
-(* *)
-(***********************************************************************)
-
-let set_top (b : bool) (t : tau) : unit =
- let set_top_down t =
- match find t with
- Var v -> v.v_top <- b
- | Ref r -> set_top_c_absloc r.rl b
- | Fun f -> set_top_c_absloc f.fl b
- | Pair p -> ()
- in
- iter_tau set_top_down t
-
-let rec unify_int (t, t' : tau * tau) : unit =
- if equal_tau t t' then ()
- else
- let ti, ti' = find t, find t' in
- U.unify combine (t, t');
- match ti, ti' with
- Var v, Var v' ->
- set_top (v.v_top || v'.v_top) t';
- merge_v_lbounds (v, v');
- merge_v_ubounds (v, v')
- | Var v, _ ->
- set_top (v.v_top || top_tau t') t';
- notify_vlbounds t v;
- notify_vubounds t v
- | _, Var v ->
- set_top (v.v_top || top_tau t) t;
- notify_vlbounds t' v;
- notify_vubounds t' v
- | Ref r, Ref r' -> unify_ref (r, r')
- | Fun f, Fun f' -> unify_fun (f, f')
- | Pair p, Pair p' -> unify_pair (p, p')
- | _ -> raise Inconsistent
-and notify_vlbounds (t : tau) (vi : vinfo) : unit =
- let notify bounds =
- List.iter
- (fun b ->
- add_constraint (Unification (b.info, copy_toplevel t));
- add_constraint (Leq (b.info, t)))
- bounds
- in
- notify (B.elements vi.v_lbounds)
-and notify_vubounds (t : tau) (vi : vinfo) : unit =
- let notify bounds =
- List.iter
- (fun b ->
- add_constraint (Unification (b.info, copy_toplevel t));
- add_constraint (Leq (t, b.info)))
- bounds
- in
- notify (B.elements vi.v_ubounds)
-and unify_ref (ri, ri' : rinfo * rinfo) : unit =
- unify_c_abslocs (ri.rl, ri'.rl);
- add_constraint (Unification (ri.points_to, ri'.points_to))
-and unify_fun (fi, fi' : finfo * finfo) : unit =
- let rec union_args = function
- _, [] -> false
- | [], _ -> true
- | h :: t, h' :: t' ->
- add_constraint (Unification (h, h'));
- union_args(t, t')
- in
- unify_c_abslocs (fi.fl, fi'.fl);
- add_constraint (Unification (fi.ret, fi'.ret));
- if union_args (fi.args, fi'.args) then fi.args <- fi'.args
-and unify_pair (pi, pi' : pinfo * pinfo) : unit =
- add_constraint (Unification (pi.ptr, pi'.ptr));
- add_constraint (Unification (pi.lam, pi'.lam))
-and unify_c_abslocs (l, l' : c_absloc * c_absloc) : unit =
- let pick_name (li, li' : c_abslocinfo * c_abslocinfo) =
- if starts_with li.l_name label_prefix then li.l_name <- li'.l_name
- else () in
- let combine_c_absloc (li, li' : c_abslocinfo * c_abslocinfo) : c_abslocinfo =
- pick_name (li, li');
- li.l_top <- li.l_top || li'.l_top;
- li.aliases <- C.union li.aliases li'.aliases;
- li.ubounds <- B.union li.ubounds li'.ubounds;
- li.lbounds <- B.union li.lbounds li'.lbounds;
- li
- in
- if !debug_constraints then
- Printf.printf
- "%s == %s\n"
- (string_of_c_absloc l)
- (string_of_c_absloc l');
- U.unify combine_c_absloc (l, l')
-and merge_v_lbounds (vi, vi' : vinfo * vinfo) : unit =
- vi'.v_lbounds <- B.union vi.v_lbounds vi'.v_lbounds;
-and merge_v_ubounds (vi, vi' : vinfo * vinfo) : unit =
- vi'.v_ubounds <- B.union vi.v_ubounds vi'.v_ubounds;
-(** Pick the representative info for two tinfo's. This function
- prefers the first argument when both arguments are the same
- structure, but when one type is a structure and the other is a
- var, it picks the structure. All other actions (e.g., updating
- the info) is done in unify_int *)
-and combine (ti, ti' : tinfo * tinfo) : tinfo =
- match ti, ti' with
- Var _, _ -> ti'
- | _, _ -> ti
-and leq_int (t, t') : unit =
- if equal_tau t t' then ()
- else
- let ti, ti' = find t, find t' in
- match ti, ti' with
- Var v, Var v' ->
- v.v_ubounds <- B.add (make_tau_bound t') v.v_ubounds;
- v'.v_lbounds <- B.add (make_tau_bound t) v'.v_lbounds
- | Var v, _ ->
- add_constraint (Unification (t, copy_toplevel t'));
- add_constraint (Leq (t, t'))
- | _, Var v ->
- add_constraint (Unification (t', copy_toplevel t));
- add_constraint (Leq (t, t'))
- | Ref r, Ref r' -> leq_ref (r, r')
- | Fun f, Fun f' ->
- (* TODO: check, why not do subtyping here? *)
- add_constraint (Unification (t, t'))
- | Pair pr, Pair pr' ->
- add_constraint (Leq (pr.ptr, pr'.ptr));
- add_constraint (Leq (pr.lam, pr'.lam))
- | _ -> raise Inconsistent
-and leq_ref (ri, ri') : unit =
- leq_c_absloc (ri.rl, ri'.rl);
- add_constraint (Unification (ri.points_to, ri'.points_to))
-and leq_c_absloc (l, l') : unit =
- let li, li' = find l, find l' in
- if !debug_constraints then
- Printf.printf
- "%s <= %s\n"
- (string_of_c_absloc l)
- (string_of_c_absloc l');
- if U.equal (l, l') then ()
- else
- begin
- li.ubounds <- B.add (make_bound l') li.ubounds;
- li'.lbounds <- B.add (make_bound l) li'.lbounds
- end
-and add_constraint_int (c : tconstraint) (toplev : bool) =
- if !debug_constraints && toplev then
- begin
- Printf.printf "%d:>" !toplev_count;
- print_constraint c;
- incr toplev_count
- end
- else
- if !debug_constraints then print_constraint c else ();
- insist (can_add_constraints ())
- "can't add constraints after compute_results is called";
- begin
- match c with
- Unification _ -> Q.add c eq_worklist
- | Leq _ -> Q.add c leq_worklist
- end;
- solve_constraints () (* solve online *)
-and add_constraint (c : tconstraint) =
- add_constraint_int c false
-and add_toplev_constraint (c : tconstraint) =
- if !print_constraints && not !debug_constraints then
- begin
- Printf.printf "%d:>" !toplev_count;
- incr toplev_count;
- print_constraint c
- end
- else ();
- add_constraint_int c true
-and fetch_constraint () : tconstraint option =
- try Some (Q.take eq_worklist)
- with Q.Empty ->
- begin
- try Some (Q.take leq_worklist)
- with Q.Empty -> None
- end
-(** The main solver loop. *)
-and solve_constraints () : unit =
- match fetch_constraint () with
- None -> ()
- | Some c ->
- begin
- match c with
- Unification (t, t') -> unify_int (t, t')
- | Leq (t, t') ->
- if !no_sub then unify_int (t, t')
- else leq_int (t, t')
- end;
- solve_constraints ()
-
-(***********************************************************************)
-(* *)
-(* Interface Functions *)
-(* *)
-(***********************************************************************)
-
-(** Return the contents of the lvalue. *)
-let rvalue (lv : lvalue) : tau =
- lv.contents
-
-(** Dereference the rvalue. If it does not have enough structure to
- support the operation, then the correct structure is added via new
- unification constraints. *)
-let rec deref (t : tau) : lvalue =
- match find t with
- Pair p ->
- begin
- match find p.ptr with
- | Var _ ->
- let is_top = top_tau p.ptr in
- let points_to = fresh_var is_top in
- let l = fresh_c_absloc is_top in
- let r = make_ref (l, points_to)
- in
- add_toplev_constraint (Unification (p.ptr, r));
- make_lval (l, points_to)
- | Ref r -> make_lval (r.rl, r.points_to)
- | _ -> raise WellFormed
- end
- | Var v ->
- let is_top = top_tau t in
- add_toplev_constraint
- (Unification (t, make_pair (fresh_var is_top, fresh_var is_top)));
- deref t
- | _ -> raise WellFormed
-
-
-(** Form the union of [t] and [t'], if it doesn't exist already. *)
-let join (t : tau) (t' : tau) : tau =
- let s, s' = get_stamp t, get_stamp t' in
- try H.find join_cache (s, s')
- with Not_found ->
- let t'' = fresh_var false in
- add_toplev_constraint (Leq (t, t''));
- add_toplev_constraint (Leq (t', t''));
- H.add join_cache (s, s') t'';
- t''
-
-(** Form the union of a list [tl], expected to be the initializers of some
- structure or array type. *)
-let join_inits (tl : tau list) : tau =
- let t' = fresh_var false in
- List.iter (function t -> add_toplev_constraint (Leq (t, t'))) tl;
- t'
-
-(** Take the address of an lvalue. Does not add constraints. *)
-let address (lv : lvalue) : tau =
- make_pair (make_ref (lv.l, lv.contents), fresh_var false )
-
-(** No instantiation in this analysis *)
-let instantiate (lv : lvalue) (i : int) : lvalue =
- lv
-
-(** Constraint generated from assigning [t] to [lv]. *)
-let assign (lv : lvalue) (t : tau) : unit =
- add_toplev_constraint (Leq (t, lv.contents))
-
-let assign_ret (i : int) (lv : lvalue) (t : tau) : unit =
- add_toplev_constraint (Leq (t, lv.contents))
-
-(** Project out the first (ref) component or a pair. If the argument
- [t] has no discovered structure, raise NoContents. *)
-let proj_ref (t : tau) : tau =
- match find t with
- Pair p -> p.ptr
- | Var v -> raise NoContents
- | _ -> raise WellFormed
-
-(* Project out the second (fun) component of a pair. If the argument
- [t] has no discovered structure, create it on the fly by adding
- constraints. *)
-let proj_fun (t : tau) : tau =
- match find t with
- Pair p -> p.lam
- | Var v ->
- let p, f = fresh_var false, fresh_var false in
- add_toplev_constraint (Unification (t, make_pair (p, f)));
- f
- | _ -> raise WellFormed
-
-let get_args (t : tau) : tau list =
- match find t with
- Fun f -> f.args
- | _ -> raise WellFormed
-
-let get_finfo (t : tau) : finfo =
- match find t with
- Fun f -> f
- | _ -> raise WellFormed
-
-(** Function type [t] is applied to the arguments [actuals]. Unifies
- the actuals with the formals of [t]. If no functions have been
- discovered for [t] yet, create a fresh one and unify it with
- t. The result is the return value of the function plus the index
- of this application site.
-
- For this analysis, the application site is always 0 *)
-let apply (t : tau) (al : tau list) : (tau * int) =
- let f = proj_fun t in
- let actuals = ref al in
- let fi, ret =
- match find f with
- Fun fi -> fi, fi.ret
- | Var v ->
- let new_l, new_ret, new_args =
- fresh_c_absloc false,
- fresh_var false,
- List.map (function _ -> fresh_var false) !actuals
- in
- let new_fun = make_fun (new_l, new_args, new_ret) in
- add_toplev_constraint (Unification (new_fun, f));
- (get_finfo new_fun, new_ret)
- | _ -> raise WellFormed
- in
- pad_args (fi, actuals);
- List.iter2
- (fun actual -> fun formal ->
- add_toplev_constraint (Leq (actual, formal)))
- !actuals fi.args;
- (ret, 0)
-
-let make_undefined_lvalue () =
- make_lval (make_c_absloc false "undefined" None,
- make_var true "undefined")
-
-let make_undefined_rvalue () =
- make_var true "undefined"
-
-let assign_undefined (lv : lvalue) : unit =
- assign lv (make_undefined_rvalue ())
-
-let apply_undefined (al : tau list) : (tau * int) =
- List.iter
- (fun actual -> assign (make_undefined_lvalue ()) actual)
- al;
- (fresh_var true, 0)
-
-(** Create a new function type with name [name], list of formal
- arguments [formals], and return value [ret]. Adds no constraints. *)
-let make_function (name : string) (formals : lvalue list) (ret : tau) : tau =
- let f = make_fun (make_c_absloc false name None,
- List.map (fun x -> rvalue x) formals,
- ret)
- in
- make_pair (fresh_var false, f)
-
-(** Create an lvalue. *)
-let make_lvalue (b : bool ) (name : string) (vio : Cil.varinfo option) =
- make_lval (make_c_absloc false name vio,
- make_var false name)
-
-(** Create a fresh named variable. *)
-let make_fresh (name : string) : tau =
- make_var false name
-
-(** The default type for abslocs. *)
-let bottom () : tau =
- make_var false "bottom"
-
-(** Unify the result of a function with its return value. *)
-let return (t : tau) (t' : tau) =
- add_toplev_constraint (Leq (t', t))
-
-(***********************************************************************)
-(* *)
-(* Query/Extract Solutions *)
-(* *)
-(***********************************************************************)
-
-module IntHash = Hashtbl.Make (struct
- type t = int
- let equal x y = x = y
- let hash x = x
- end)
-
-(** todo : reached_top !! *)
-let collect_ptset_fast (l : c_absloc) : abslocset =
- let onpath : unit IntHash.t = IntHash.create 101 in
- let path : c_absloc list ref = ref [] in
- let compute_path (i : int) =
- keep_until (fun l -> i = get_c_absloc_stamp l) !path in
- let collapse_cycle (cycle : c_absloc list) =
- match cycle with
- l :: ls ->
- List.iter (fun l' -> unify_c_abslocs (l, l')) ls;
- C.empty
- | [] -> die "collapse cycle" in
- let rec flow_step (l : c_absloc) : abslocset =
- let stamp = get_c_absloc_stamp l in
- if IntHash.mem onpath stamp then (* already seen *)
- collapse_cycle (compute_path stamp)
- else
- let li = find l in
- IntHash.add onpath stamp ();
- path := l :: !path;
- B.iter
- (fun lb -> li.aliases <- C.union li.aliases (flow_step lb.info))
- li.lbounds;
- path := List.tl !path;
- IntHash.remove onpath stamp;
- li.aliases
- in
- insist (can_query_graph ()) "collect_ptset_fast can't query graph";
- if get_flow_computed l then get_aliases l
- else
- begin
- set_flow_computed l;
- flow_step l
- end
-
-(** this is a quadratic flow step. keep it for debugging the fast
- version above. *)
-let collect_ptset_slow (l : c_absloc) : abslocset =
- let onpath : unit IntHash.t = IntHash.create 101 in
- let rec flow_step (l : c_absloc) : abslocset =
- if top_c_absloc l then raise ReachedTop
- else
- let stamp = get_c_absloc_stamp l in
- if IntHash.mem onpath stamp then C.empty
- else
- let li = find l in
- IntHash.add onpath stamp ();
- B.iter
- (fun lb -> li.aliases <- C.union li.aliases (flow_step lb.info))
- li.lbounds;
- li.aliases
- in
- insist (can_query_graph ()) "collect_ptset_slow can't query graph";
- if get_flow_computed l then get_aliases l
- else
- begin
- set_flow_computed l;
- flow_step l
- end
-
-let collect_ptset =
- collect_ptset_slow
- (* if !debug_flow_step then collect_ptset_slow
- else collect_ptset_fast *)
-
-let may_alias (t1 : tau) (t2 : tau) : bool =
- let get_l (t : tau) : c_absloc =
- match find (proj_ref t) with
- Ref r -> r.rl
- | Var v -> raise NoContents
- | _ -> raise WellFormed
- in
- try
- let l1 = get_l t1
- and l2 = get_l t2 in
- equal_c_absloc l1 l2 ||
- not (C.is_empty (C.inter (collect_ptset l1) (collect_ptset l2)))
- with
- NoContents -> false
- | ReachedTop -> raise UnknownLocation
-
-let points_to_aux (t : tau) : absloc list =
- try
- match find (proj_ref t) with
- Var v -> []
- | Ref r -> C.elements (collect_ptset r.rl)
- | _ -> raise WellFormed
- with
- NoContents -> []
- | ReachedTop -> raise UnknownLocation
-
-let points_to (lv : lvalue) : Cil.varinfo list =
- let rec get_vinfos l : Cil.varinfo list =
- match l with
- [] -> []
- | (_, _, Some h) :: t -> h :: get_vinfos t
- | (_, _, None) :: t -> get_vinfos t
- in
- get_vinfos (points_to_aux lv.contents)
-
-let epoints_to (t : tau) : Cil.varinfo list =
- let rec get_vinfos l : Cil.varinfo list = match l with
- [] -> []
- | (_, _, Some h) :: t -> h :: get_vinfos t
- | (_, _, None) :: t -> get_vinfos t
- in
- get_vinfos (points_to_aux t)
-
-let points_to_names (lv : lvalue) : string list =
- List.map (fun v -> v.vname) (points_to lv)
-
-let absloc_points_to (lv : lvalue) : absloc list =
- points_to_aux lv.contents
-
-let absloc_epoints_to (t : tau) : absloc list =
- points_to_aux t
-
-let absloc_of_lvalue (lv : lvalue) : absloc =
- (find lv.l).loc
-
-let absloc_eq = equal_absloc
diff --git a/cil/src/ext/pta/olf.mli b/cil/src/ext/pta/olf.mli
deleted file mode 100644
index 43794825062027565a8ae0b86ae8f0bf1d1d3081..0000000000000000000000000000000000000000
--- a/cil/src/ext/pta/olf.mli
+++ /dev/null
@@ -1,80 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * John Kodumal <jkodumal@eecs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-type lvalue
-type tau
-type absloc
-
-(** Raised if a pointer flows to an undefined function.
- We assume that such a function can have any effect on the pointer's contents
-*)
-exception UnknownLocation
-
-val debug : bool ref
-val debug_constraints : bool ref
-val debug_aliases : bool ref
-val smart_aliases : bool ref
-val finished_constraints : unit -> unit
-val print_constraints : bool ref
-val no_flow : bool ref
-val no_sub : bool ref
-val analyze_mono : bool ref
-val solve_constraints : unit -> unit (* only for compatability with Golf *)
-val rvalue : lvalue -> tau
-val deref : tau -> lvalue
-val join : tau -> tau -> tau
-val join_inits : tau list -> tau
-val address : lvalue -> tau
-val instantiate : lvalue -> int -> lvalue
-val assign : lvalue -> tau -> unit
-val assign_ret : int -> lvalue -> tau -> unit
-val apply : tau -> tau list -> (tau * int)
-val apply_undefined : tau list -> (tau * int)
-val assign_undefined : lvalue -> unit
-val make_function : string -> lvalue list -> tau -> tau
-val make_lvalue : bool -> string -> (Cil.varinfo option) -> lvalue
-val bottom : unit -> tau
-val return : tau -> tau -> unit
-val make_fresh : string -> tau
-val points_to_names : lvalue -> string list
-val points_to : lvalue -> Cil.varinfo list
-val epoints_to : tau -> Cil.varinfo list
-val string_of_lvalue : lvalue -> string
-val may_alias : tau -> tau -> bool
-
-val absloc_points_to : lvalue -> absloc list
-val absloc_epoints_to : tau -> absloc list
-val absloc_of_lvalue : lvalue -> absloc
-val absloc_eq : (absloc * absloc) -> bool
-val d_absloc : unit -> absloc -> Pretty.doc
diff --git a/cil/src/ext/pta/ptranal.ml b/cil/src/ext/pta/ptranal.ml
deleted file mode 100644
index c91bda81f841dbd49d78d3a3c4bab29080036d11..0000000000000000000000000000000000000000
--- a/cil/src/ext/pta/ptranal.ml
+++ /dev/null
@@ -1,597 +0,0 @@
-(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-
-(*
- *
- * Copyright (c) 2001-2002,
- * John Kodumal <jkodumal@eecs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-exception Bad_return
-exception Bad_function
-
-
-open Cil
-
-module H = Hashtbl
-
-module A = Olf
-exception UnknownLocation = A.UnknownLocation
-
-type access = A.lvalue * bool
-
-type access_map = (lval, access) H.t
-
-(** a mapping from varinfo's back to fundecs *)
-module VarInfoKey =
-struct
- type t = varinfo
- let compare v1 v2 = v1.vid - v2.vid
-end
-
-module F = Map.Make (VarInfoKey)
-
-
-(***********************************************************************)
-(* *)
-(* Global Variables *)
-(* *)
-(***********************************************************************)
-
-let model_strings = ref false
-let print_constraints = A.print_constraints
-let debug_constraints = A.debug_constraints
-let debug_aliases = A.debug_aliases
-let smart_aliases = A.smart_aliases
-let debug = A.debug
-let analyze_mono = A.analyze_mono
-let no_flow = A.no_flow
-let no_sub = A.no_sub
-let fun_ptrs_as_funs = ref false
-let show_progress = ref false
-let debug_may_aliases = ref false
-
-let found_undefined = ref false
-
-let conservative_undefineds = ref false
-
-let current_fundec : fundec option ref = ref None
-
-let fun_access_map : (fundec, access_map) H.t = H.create 64
-
-(* A mapping from varinfos to fundecs *)
-let fun_varinfo_map = ref F.empty
-
-let current_ret : A.tau option ref = ref None
-
-let lvalue_hash : (varinfo,A.lvalue) H.t = H.create 64
-
-let expressions : (exp,A.tau) H.t = H.create 64
-
-let lvalues : (lval,A.lvalue) H.t = H.create 64
-
-let fresh_index : (unit -> int) =
- let count = ref 0 in
- fun () ->
- incr count;
- !count
-
-let alloc_names = [
- "malloc";
- "calloc";
- "realloc";
- "xmalloc";
- "__builtin_alloca";
- "alloca";
- "kmalloc"
-]
-
-let all_globals : varinfo list ref = ref []
-let all_functions : fundec list ref = ref []
-
-
-(***********************************************************************)
-(* *)
-(* Utility Functions *)
-(* *)
-(***********************************************************************)
-
-let is_undefined_fun = function
- Lval (lh, o) ->
- if isFunctionType (typeOfLval (lh, o)) then
- match lh with
- Var v -> v.vstorage = Extern
- | _ -> false
- else false
- | _ -> false
-
-let is_alloc_fun = function
- Lval (lh, o) ->
- if isFunctionType (typeOfLval (lh, o)) then
- match lh with
- Var v -> List.mem v.vname alloc_names
- | _ -> false
- else false
- | _ -> false
-
-let next_alloc = function
- Lval (Var v, o) ->
- let name = Printf.sprintf "%s@%d" v.vname (fresh_index ())
- in
- A.address (A.make_lvalue false name (Some v)) (* check *)
- | _ -> raise Bad_return
-
-let is_effect_free_fun = function
- Lval (lh, o) when isFunctionType (typeOfLval (lh, o)) ->
- begin
- match lh with
- Var v ->
- begin
- try ("CHECK_" = String.sub v.vname 0 6)
- with Invalid_argument _ -> false
- end
- | _ -> false
- end
- | _ -> false
-
-
-(***********************************************************************)
-(* *)
-(* AST Traversal Functions *)
-(* *)
-(***********************************************************************)
-
-(* should do nothing, might need to worry about Index case *)
-(* let analyzeOffset (o : offset ) : A.tau = A.bottom () *)
-
-let analyze_var_decl (v : varinfo ) : A.lvalue =
- try H.find lvalue_hash v
- with Not_found ->
- let lv = A.make_lvalue false v.vname (Some v)
- in
- H.add lvalue_hash v lv;
- lv
-
-let isFunPtrType (t : typ) : bool =
- match t with
- TPtr (t, _) -> isFunctionType t
- | _ -> false
-
-let rec analyze_lval (lv : lval ) : A.lvalue =
- let find_access (l : A.lvalue) (is_var : bool) : A.lvalue =
- match !current_fundec with
- None -> l
- | Some f ->
- let accesses = H.find fun_access_map f in
- if H.mem accesses lv then l
- else
- begin
- H.add accesses lv (l, is_var);
- l
- end in
- let result =
- match lv with
- Var v, _ -> (* instantiate every syntactic occurrence of a function *)
- let alv =
- if isFunctionType (typeOfLval lv) then
- A.instantiate (analyze_var_decl v) (fresh_index ())
- else analyze_var_decl v
- in
- find_access alv true
- | Mem e, _ ->
- (* assert (not (isFunctionType(typeOf(e))) ); *)
- let alv =
- if !fun_ptrs_as_funs && isFunPtrType (typeOf e) then
- analyze_expr_as_lval e
- else A.deref (analyze_expr e)
- in
- find_access alv false
- in
- H.replace lvalues lv result;
- result
-and analyze_expr_as_lval (e : exp) : A.lvalue =
- match e with
- Lval l -> analyze_lval l
- | _ -> assert false (* todo -- other kinds of expressions? *)
-and analyze_expr (e : exp ) : A.tau =
- let result =
- match e with
- Const (CStr s) ->
- if !model_strings then
- A.address (A.make_lvalue
- false
- s
- (Some (makeVarinfo false s charConstPtrType)))
- else A.bottom ()
- | Const c -> A.bottom ()
- | Lval l -> A.rvalue (analyze_lval l)
- | SizeOf _ -> A.bottom ()
- | SizeOfStr _ -> A.bottom ()
- | AlignOf _ -> A.bottom ()
- | UnOp (op, e, t) -> analyze_expr e
- | BinOp (op, e, e', t) -> A.join (analyze_expr e) (analyze_expr e')
- | CastE (t, e) -> analyze_expr e
- | AddrOf l ->
- if !fun_ptrs_as_funs && isFunctionType (typeOfLval l) then
- A.rvalue (analyze_lval l)
- else A.address (analyze_lval l)
- | StartOf l -> A.address (analyze_lval l)
- | AlignOfE _ -> A.bottom ()
- | SizeOfE _ -> A.bottom ()
- in
- H.add expressions e result;
- result
-
-
-(* check *)
-let rec analyze_init (i : init ) : A.tau =
- match i with
- SingleInit e -> analyze_expr e
- | CompoundInit (t, oi) ->
- A.join_inits (List.map (function (_, i) -> analyze_init i) oi)
-
-let analyze_instr (i : instr ) : unit =
- match i with
- Set (lval, rhs, l) ->
- A.assign (analyze_lval lval) (analyze_expr rhs)
- | Call (res, fexpr, actuals, l) ->
- if not (isFunctionType (typeOf fexpr)) then
- () (* todo : is this a varargs? *)
- else if is_alloc_fun fexpr then
- begin
- if !debug then print_string "Found allocation function...\n";
- match res with
- Some r -> A.assign (analyze_lval r) (next_alloc fexpr)
- | None -> ()
- end
- else if is_effect_free_fun fexpr then
- List.iter (fun e -> ignore (analyze_expr e)) actuals
- else (* todo : check to see if the thing is an undefined function *)
- let fnres, site =
- if is_undefined_fun fexpr & !conservative_undefineds then
- A.apply_undefined (List.map analyze_expr actuals)
- else
- A.apply (analyze_expr fexpr) (List.map analyze_expr actuals)
- in
- begin
- match res with
- Some r ->
- begin
- A.assign_ret site (analyze_lval r) fnres;
- found_undefined := true;
- end
- | None -> ()
- end
- | Asm _ -> ()
-
-let rec analyze_stmt (s : stmt ) : unit =
- match s.skind with
- Instr il -> List.iter analyze_instr il
- | Return (eo, l) ->
- begin
- match eo with
- Some e ->
- begin
- match !current_ret with
- Some ret -> A.return ret (analyze_expr e)
- | None -> raise Bad_return
- end
- | None -> ()
- end
- | Goto (s', l) -> () (* analyze_stmt(!s') *)
- | If (e, b, b', l) ->
- (* ignore the expression e; expressions can't be side-effecting *)
- analyze_block b;
- analyze_block b'
- | Switch (e, b, sl, l) ->
- analyze_block b;
- List.iter analyze_stmt sl
-(*
- | Loop (b, l, _, _) -> analyze_block b
-*)
- | While (_, b, _) -> analyze_block b
- | DoWhile (_, b, _) -> analyze_block b
- | For (bInit, _, bIter, b, _) ->
- analyze_block bInit;
- analyze_block bIter;
- analyze_block b
- | Block b -> analyze_block b
- | TryFinally (b, h, _) ->
- analyze_block b;
- analyze_block h
- | TryExcept (b, (il, _), h, _) ->
- analyze_block b;
- List.iter analyze_instr il;
- analyze_block h
- | Break l -> ()
- | Continue l -> ()
-
-
-and analyze_block (b : block ) : unit =
- List.iter analyze_stmt b.bstmts
-
-let analyze_function (f : fundec ) : unit =
- let oldlv = analyze_var_decl f.svar in
- let ret = A.make_fresh (f.svar.vname ^ "_ret") in
- let formals = List.map analyze_var_decl f.sformals in
- let newf = A.make_function f.svar.vname formals ret in
- if !show_progress then
- Printf.printf "Analyzing function %s\n" f.svar.vname;
- fun_varinfo_map := F.add f.svar f (!fun_varinfo_map);
- current_fundec := Some f;
- H.add fun_access_map f (H.create 8);
- A.assign oldlv newf;
- current_ret := Some ret;
- analyze_block f.sbody
-
-let analyze_global (g : global ) : unit =
- match g with
- GVarDecl (v, l) -> () (* ignore (analyze_var_decl(v)) -- no need *)
- | GVar (v, init, l) ->
- all_globals := v :: !all_globals;
- begin
- match init.init with
- Some i -> A.assign (analyze_var_decl v) (analyze_init i)
- | None -> ignore (analyze_var_decl v)
- end
- | GFun (f, l) ->
- all_functions := f :: !all_functions;
- analyze_function f
- | _ -> ()
-
-let analyze_file (f : file) : unit =
- iterGlobals f analyze_global
-
-
-(***********************************************************************)
-(* *)
-(* High-level Query Interface *)
-(* *)
-(***********************************************************************)
-
-(* Same as analyze_expr, but no constraints. *)
-let rec traverse_expr (e : exp) : A.tau =
- H.find expressions e
-
-and traverse_expr_as_lval (e : exp) : A.lvalue =
- match e with
- | Lval l -> traverse_lval l
- | _ -> assert false (* todo -- other kinds of expressions? *)
-
-and traverse_lval (lv : lval ) : A.lvalue =
- H.find lvalues lv
-
-let may_alias (e1 : exp) (e2 : exp) : bool =
- let tau1,tau2 = traverse_expr e1, traverse_expr e2 in
- let result = A.may_alias tau1 tau2 in
- if !debug_may_aliases then
- begin
- let doc1 = d_exp () e1 in
- let doc2 = d_exp () e2 in
- let s1 = Pretty.sprint ~width:30 doc1 in
- let s2 = Pretty.sprint ~width:30 doc2 in
- Printf.printf
- "%s and %s may alias? %s\n"
- s1
- s2
- (if result then "yes" else "no")
- end;
- result
-
-let resolve_lval (lv : lval) : varinfo list =
- A.points_to (traverse_lval lv)
-
-let resolve_exp (e : exp) : varinfo list =
- A.epoints_to (traverse_expr e)
-
-let resolve_funptr (e : exp) : fundec list =
- let varinfos = A.epoints_to (traverse_expr e) in
- List.fold_left
- (fun fdecs -> fun vinf ->
- try F.find vinf !fun_varinfo_map :: fdecs
- with Not_found -> fdecs)
- []
- varinfos
-
-let count_hash_elts h =
- let result = ref 0 in
- H.iter (fun _ -> fun _ -> incr result) lvalue_hash;
- !result
-
-let compute_may_aliases (b : bool) : unit =
- let rec compute_may_aliases_aux (exps : exp list) =
- match exps with
- [] -> ()
- | h :: t ->
- ignore (List.map (may_alias h) t);
- compute_may_aliases_aux t
- and exprs : exp list ref = ref [] in
- H.iter (fun e -> fun _ -> exprs := e :: !exprs) expressions;
- compute_may_aliases_aux !exprs
-
-
-let compute_results (show_sets : bool) : unit =
- let total_pointed_to = ref 0
- and total_lvalues = H.length lvalue_hash
- and counted_lvalues = ref 0
- and lval_elts : (string * (string list)) list ref = ref [] in
- let print_result (name, set) =
- let rec print_set s =
- match s with
- [] -> ()
- | h :: [] -> print_string h
- | h :: t ->
- print_string (h ^ ", ");
- print_set t
- and ptsize = List.length set in
- total_pointed_to := !total_pointed_to + ptsize;
- if ptsize > 0 then
- begin
- print_string (name ^ "(" ^ (string_of_int ptsize) ^ ") -> ");
- print_set set;
- print_newline ()
- end
- in
- (* Make the most pessimistic assumptions about globals if an
- undefined function is present. Such a function can write to every
- global variable *)
- let hose_globals () : unit =
- List.iter
- (fun vd -> A.assign_undefined (analyze_var_decl vd))
- !all_globals
- in
- let show_progress_fn (counted : int ref) (total : int) : unit =
- incr counted;
- if !show_progress then
- Printf.printf "Computed flow for %d of %d sets\n" !counted total
- in
- if !conservative_undefineds && !found_undefined then hose_globals ();
- A.finished_constraints ();
- if show_sets then
- begin
- print_endline "Computing points-to sets...";
- Hashtbl.iter
- (fun vinf -> fun lv ->
- show_progress_fn counted_lvalues total_lvalues;
- try lval_elts := (vinf.vname, A.points_to_names lv) :: !lval_elts
- with A.UnknownLocation -> ())
- lvalue_hash;
- List.iter print_result !lval_elts;
- Printf.printf
- "Total number of things pointed to: %d\n"
- !total_pointed_to
- end;
- if !debug_may_aliases then
- begin
- Printf.printf "Printing may alias relationships\n";
- compute_may_aliases true
- end
-
-let print_types () : unit =
- print_string "Printing inferred types of lvalues...\n";
- Hashtbl.iter
- (fun vi -> fun lv ->
- Printf.printf "%s : %s\n" vi.vname (A.string_of_lvalue lv))
- lvalue_hash
-
-
-
-(** Alias queries. For each function, gather sets of locals, formals, and
- globals. Do n^2 work for each of these functions, reporting whether or not
- each pair of values is aliased. Aliasing is determined by taking points-to
- set intersections.
-*)
-let compute_aliases = compute_may_aliases
-
-
-(***********************************************************************)
-(* *)
-(* Abstract Location Interface *)
-(* *)
-(***********************************************************************)
-
-type absloc = A.absloc
-
-let rec lvalue_of_varinfo (vi : varinfo) : A.lvalue =
- H.find lvalue_hash vi
-
-let lvalue_of_lval = traverse_lval
-let tau_of_expr = traverse_expr
-
-(** return an abstract location for a varinfo, resp. lval *)
-let absloc_of_varinfo vi =
- A.absloc_of_lvalue (lvalue_of_varinfo vi)
-
-let absloc_of_lval lv =
- A.absloc_of_lvalue (lvalue_of_lval lv)
-
-let absloc_e_points_to e =
- A.absloc_epoints_to (tau_of_expr e)
-
-let absloc_lval_aliases lv =
- A.absloc_points_to (lvalue_of_lval lv)
-
-(* all abslocs that e transitively points to *)
-let absloc_e_transitive_points_to (e : Cil.exp) : absloc list =
- let rec lv_trans_ptsto (worklist : varinfo list) (acc : varinfo list) : absloc list =
- match worklist with
- [] -> List.map absloc_of_varinfo acc
- | vi :: wklst'' ->
- if List.mem vi acc then lv_trans_ptsto wklst'' acc
- else
- lv_trans_ptsto
- (List.rev_append
- (A.points_to (lvalue_of_varinfo vi))
- wklst'')
- (vi :: acc)
- in
- lv_trans_ptsto (A.epoints_to (tau_of_expr e)) []
-
-let absloc_eq a b = A.absloc_eq (a, b)
-
-let d_absloc: unit -> absloc -> Pretty.doc = A.d_absloc
-
-
-let ptrAnalysis = ref false
-let ptrResults = ref false
-let ptrTypes = ref false
-
-
-
-(** Turn this into a CIL feature *)
-let feature : featureDescr = {
- fd_name = "ptranal";
- fd_enabled = ptrAnalysis;
- fd_description = "alias analysis";
- fd_extraopt = [
- ("--ptr_may_aliases",
- Arg.Unit (fun _ -> debug_may_aliases := true),
- "Print out results of may alias queries");
- ("--ptr_unify", Arg.Unit (fun _ -> no_sub := true),
- "Make the alias analysis unification-based");
- ("--ptr_model_strings", Arg.Unit (fun _ -> model_strings := true),
- "Make the alias analysis model string constants");
- ("--ptr_conservative",
- Arg.Unit (fun _ -> conservative_undefineds := true),
- "Treat undefineds conservatively in alias analysis");
- ("--ptr_results", Arg.Unit (fun _ -> ptrResults := true),
- "print the results of the alias analysis");
- ("--ptr_mono", Arg.Unit (fun _ -> analyze_mono := true),
- "run alias analysis monomorphically");
- ("--ptr_types",Arg.Unit (fun _ -> ptrTypes := true),
- "print inferred points-to analysis types")
- ];
- fd_doit = (function (f: file) ->
- analyze_file f;
- compute_results !ptrResults;
- if !ptrTypes then print_types ());
- fd_post_check = false (* No changes *)
-}
diff --git a/cil/src/ext/pta/ptranal.mli b/cil/src/ext/pta/ptranal.mli
deleted file mode 100644
index 36eb7a546f9e34930325daa6f956dbc29a28d623..0000000000000000000000000000000000000000
--- a/cil/src/ext/pta/ptranal.mli
+++ /dev/null
@@ -1,156 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * John Kodumal <jkodumal@eecs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(***********************************************************************)
-(* *)
-(* Flags *)
-(* *)
-(***********************************************************************)
-
-(** Print extra debugging info *)
-val debug : bool ref
-
-(** Debug constraints (print all constraints) *)
-val debug_constraints : bool ref
-
-(** Debug smart alias queries *)
-val debug_aliases : bool ref
-
-(** Debug may alias queries *)
-val debug_may_aliases : bool ref
-
-val smart_aliases : bool ref
-
-(** Print out the top level constraints *)
-val print_constraints : bool ref
-
-(** Make the analysis monomorphic *)
-val analyze_mono : bool ref
-
-(** Disable subtyping *)
-val no_sub : bool ref
-
-(** Make the flow step a no-op *)
-val no_flow : bool ref
-
-(** Show the progress of the flow step *)
-val show_progress : bool ref
-
-(** Treat undefined functions conservatively *)
-val conservative_undefineds : bool ref
-
-(***********************************************************************)
-(* *)
-(* Building the Points-to Graph *)
-(* *)
-(***********************************************************************)
-
-(** Analyze a file *)
-val analyze_file : Cil.file -> unit
-
-(** Print the type of each lvalue in the program *)
-val print_types : unit -> unit
-
-(***********************************************************************)
-(* *)
-(* High-level Query Interface *)
-(* *)
-(***********************************************************************)
-
-(** If undefined functions are analyzed conservatively, any of the
- high-level queries may raise this exception *)
-exception UnknownLocation
-
-val may_alias : Cil.exp -> Cil.exp -> bool
-
-val resolve_lval : Cil.lval -> (Cil.varinfo list)
-
-val resolve_exp : Cil.exp -> (Cil.varinfo list)
-
-val resolve_funptr : Cil.exp -> (Cil.fundec list)
-
-(***********************************************************************)
-(* *)
-(* Low-level Query Interface *)
-(* *)
-(***********************************************************************)
-
-(** type for abstract locations *)
-type absloc
-
-(** Give an abstract location for a varinfo *)
-val absloc_of_varinfo : Cil.varinfo -> absloc
-
-(** Give an abstract location for an Cil lvalue *)
-val absloc_of_lval : Cil.lval -> absloc
-
-(** may the two abstract locations be aliased? *)
-val absloc_eq : absloc -> absloc -> bool
-
-val absloc_e_points_to : Cil.exp -> absloc list
-val absloc_e_transitive_points_to : Cil.exp -> absloc list
-
-val absloc_lval_aliases : Cil.lval -> absloc list
-
-(** Print a string representing an absloc, for debugging. *)
-val d_absloc : unit -> absloc -> Pretty.doc
-
-
-(***********************************************************************)
-(* *)
-(* Printing results *)
-(* *)
-(***********************************************************************)
-
-(** Compute points to sets for variables. If true is passed, print the sets. *)
-val compute_results : bool -> unit
-
-(*
-
-Deprecated these. -- jk
-
-(** Compute alias relationships. If true is passed, print all alias pairs. *)
- val compute_aliases : bool -> unit
-
-(** Compute alias frequncy *)
-val compute_alias_frequency : unit -> unit
-
-
-*)
-
-val compute_aliases : bool -> unit
-
-
-val feature: Cil.featureDescr
diff --git a/cil/src/ext/pta/setp.ml b/cil/src/ext/pta/setp.ml
deleted file mode 100644
index a39b972268bbfda9f22c6b2282baac5b17fdf71f..0000000000000000000000000000000000000000
--- a/cil/src/ext/pta/setp.ml
+++ /dev/null
@@ -1,342 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * John Kodumal <jkodumal@eecs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-(***********************************************************************)
-(* *)
-(* Objective Caml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. All rights reserved. This file is distributed *)
-(* under the terms of the GNU Library General Public License, with *)
-(* the special exception on linking described in file ../LICENSE. *)
-(* *)
-(***********************************************************************)
-
-(* $Id: setp.ml,v 1.3 2003-02-19 19:26:31 jkodumal Exp $ *)
-
-(* Sets over ordered types *)
-
-module type PolyOrderedType =
- sig
- type 'a t
- val compare: 'a t -> 'a t -> int
- end
-
-module type S =
- sig
- type 'a elt
- type 'a t
- val empty: 'a t
- val is_empty: 'a t -> bool
- val mem: 'a elt -> 'a t -> bool
- val add: 'a elt -> 'a t -> 'a t
- val singleton: 'a elt -> 'a t
- val remove: 'a elt -> 'a t -> 'a t
- val union: 'a t -> 'a t -> 'a t
- val inter: 'a t -> 'a t -> 'a t
- val diff: 'a t -> 'a t -> 'a t
- val compare: 'a t -> 'a t -> int
- val equal: 'a t -> 'a t -> bool
- val subset: 'a t -> 'a t -> bool
- val iter: ('a elt -> unit) -> 'a t -> unit
- val fold: ('a elt -> 'b -> 'b) -> 'a t -> 'b -> 'b
- val for_all: ('a elt -> bool) -> 'a t -> bool
- val exists: ('a elt -> bool) -> 'a t -> bool
- val filter: ('a elt -> bool) -> 'a t -> 'a t
- val partition: ('a elt -> bool) -> 'a t -> 'a t * 'a t
- val cardinal: 'a t -> int
- val elements: 'a t -> 'a elt list
- val min_elt: 'a t -> 'a elt
- val max_elt: 'a t -> 'a elt
- val choose: 'a t -> 'a elt
- end
-
-module Make(Ord: PolyOrderedType) =
- struct
- type 'a elt = 'a Ord.t
- type 'a t = Empty | Node of 'a t * 'a elt * 'a t * int
-
- (* Sets are represented by balanced binary trees (the heights of the
- children differ by at most 2 *)
-
- let height = function
- Empty -> 0
- | Node(_, _, _, h) -> h
-
- (* Creates a new node with left son l, value x and right son r.
- l and r must be balanced and | height l - height r | <= 2.
- Inline expansion of height for better speed. *)
-
- let create l x r =
- let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h in
- let hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in
- Node(l, x, r, (if hl >= hr then hl + 1 else hr + 1))
-
- (* Same as create, but performs one step of rebalancing if necessary.
- Assumes l and r balanced.
- Inline expansion of create for better speed in the most frequent case
- where no rebalancing is required. *)
-
- let bal l x r =
- let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h in
- let hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in
- if hl > hr + 2 then begin
- match l with
- Empty -> invalid_arg "Set.bal"
- | Node(ll, lv, lr, _) ->
- if height ll >= height lr then
- create ll lv (create lr x r)
- else begin
- match lr with
- Empty -> invalid_arg "Set.bal"
- | Node(lrl, lrv, lrr, _)->
- create (create ll lv lrl) lrv (create lrr x r)
- end
- end else if hr > hl + 2 then begin
- match r with
- Empty -> invalid_arg "Set.bal"
- | Node(rl, rv, rr, _) ->
- if height rr >= height rl then
- create (create l x rl) rv rr
- else begin
- match rl with
- Empty -> invalid_arg "Set.bal"
- | Node(rll, rlv, rlr, _) ->
- create (create l x rll) rlv (create rlr rv rr)
- end
- end else
- Node(l, x, r, (if hl >= hr then hl + 1 else hr + 1))
-
- (* Same as bal, but repeat rebalancing until the final result
- is balanced. *)
-
- let rec join l x r =
- match bal l x r with
- Empty -> invalid_arg "Set.join"
- | Node(l', x', r', _) as t' ->
- let d = height l' - height r' in
- if d < -2 || d > 2 then join l' x' r' else t'
-
- (* Merge two trees l and r into one.
- All elements of l must precede the elements of r.
- Assumes | height l - height r | <= 2. *)
-
- let rec merge t1 t2 =
- match (t1, t2) with
- (Empty, t) -> t
- | (t, Empty) -> t
- | (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) ->
- bal l1 v1 (bal (merge r1 l2) v2 r2)
-
- (* Same as merge, but does not assume anything about l and r. *)
-
- let rec concat t1 t2 =
- match (t1, t2) with
- (Empty, t) -> t
- | (t, Empty) -> t
- | (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) ->
- join l1 v1 (join (concat r1 l2) v2 r2)
-
- (* Splitting *)
-
- let rec split x = function
- Empty ->
- (Empty, None, Empty)
- | Node(l, v, r, _) ->
- let c = Ord.compare x v in
- if c = 0 then (l, Some v, r)
- else if c < 0 then
- let (ll, vl, rl) = split x l in (ll, vl, join rl v r)
- else
- let (lr, vr, rr) = split x r in (join l v lr, vr, rr)
-
- (* Implementation of the set operations *)
-
- let empty = Empty
-
- let is_empty = function Empty -> true | _ -> false
-
- let rec mem x = function
- Empty -> false
- | Node(l, v, r, _) ->
- let c = Ord.compare x v in
- c = 0 || mem x (if c < 0 then l else r)
-
- let rec add x = function
- Empty -> Node(Empty, x, Empty, 1)
- | Node(l, v, r, _) as t ->
- let c = Ord.compare x v in
- if c = 0 then t else
- if c < 0 then bal (add x l) v r else bal l v (add x r)
-
- let singleton x = Node(Empty, x, Empty, 1)
-
- let rec remove x = function
- Empty -> Empty
- | Node(l, v, r, _) ->
- let c = Ord.compare x v in
- if c = 0 then merge l r else
- if c < 0 then bal (remove x l) v r else bal l v (remove x r)
-
- let rec union s1 s2 =
- match (s1, s2) with
- (Empty, t2) -> t2
- | (t1, Empty) -> t1
- | (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) ->
- if h1 >= h2 then
- if h2 = 1 then add v2 s1 else begin
- let (l2, _, r2) = split v1 s2 in
- join (union l1 l2) v1 (union r1 r2)
- end
- else
- if h1 = 1 then add v1 s2 else begin
- let (l1, _, r1) = split v2 s1 in
- join (union l1 l2) v2 (union r1 r2)
- end
-
- let rec inter s1 s2 =
- match (s1, s2) with
- (Empty, t2) -> Empty
- | (t1, Empty) -> Empty
- | (Node(l1, v1, r1, _), t2) ->
- match split v1 t2 with
- (l2, None, r2) ->
- concat (inter l1 l2) (inter r1 r2)
- | (l2, Some _, r2) ->
- join (inter l1 l2) v1 (inter r1 r2)
-
- let rec diff s1 s2 =
- match (s1, s2) with
- (Empty, t2) -> Empty
- | (t1, Empty) -> t1
- | (Node(l1, v1, r1, _), t2) ->
- match split v1 t2 with
- (l2, None, r2) ->
- join (diff l1 l2) v1 (diff r1 r2)
- | (l2, Some _, r2) ->
- concat (diff l1 l2) (diff r1 r2)
-
- let rec compare_aux l1 l2 =
- match (l1, l2) with
- ([], []) -> 0
- | ([], _) -> -1
- | (_, []) -> 1
- | (Empty :: t1, Empty :: t2) ->
- compare_aux t1 t2
- | (Node(Empty, v1, r1, _) :: t1, Node(Empty, v2, r2, _) :: t2) ->
- let c = Ord.compare v1 v2 in
- if c <> 0 then c else compare_aux (r1::t1) (r2::t2)
- | (Node(l1, v1, r1, _) :: t1, t2) ->
- compare_aux (l1 :: Node(Empty, v1, r1, 0) :: t1) t2
- | (t1, Node(l2, v2, r2, _) :: t2) ->
- compare_aux t1 (l2 :: Node(Empty, v2, r2, 0) :: t2)
-
- let compare s1 s2 =
- compare_aux [s1] [s2]
-
- let equal s1 s2 =
- compare s1 s2 = 0
-
- let rec subset s1 s2 =
- match (s1, s2) with
- Empty, _ ->
- true
- | _, Empty ->
- false
- | Node (l1, v1, r1, _), (Node (l2, v2, r2, _) as t2) ->
- let c = Ord.compare v1 v2 in
- if c = 0 then
- subset l1 l2 && subset r1 r2
- else if c < 0 then
- subset (Node (l1, v1, Empty, 0)) l2 && subset r1 t2
- else
- subset (Node (Empty, v1, r1, 0)) r2 && subset l1 t2
-
- let rec iter f = function
- Empty -> ()
- | Node(l, v, r, _) -> iter f l; f v; iter f r
-
- let rec fold f s accu =
- match s with
- Empty -> accu
- | Node(l, v, r, _) -> fold f l (f v (fold f r accu))
-
- let rec for_all p = function
- Empty -> true
- | Node(l, v, r, _) -> p v && for_all p l && for_all p r
-
- let rec exists p = function
- Empty -> false
- | Node(l, v, r, _) -> p v || exists p l || exists p r
-
- let filter p s =
- let rec filt accu = function
- | Empty -> accu
- | Node(l, v, r, _) ->
- filt (filt (if p v then add v accu else accu) l) r in
- filt Empty s
-
- let partition p s =
- let rec part (t, f as accu) = function
- | Empty -> accu
- | Node(l, v, r, _) ->
- part (part (if p v then (add v t, f) else (t, add v f)) l) r in
- part (Empty, Empty) s
-
- let rec cardinal = function
- Empty -> 0
- | Node(l, v, r, _) -> cardinal l + 1 + cardinal r
-
- let rec elements_aux accu = function
- Empty -> accu
- | Node(l, v, r, _) -> elements_aux (v :: elements_aux accu r) l
-
- let elements s =
- elements_aux [] s
-
- let rec min_elt = function
- Empty -> raise Not_found
- | Node(Empty, v, r, _) -> v
- | Node(l, v, r, _) -> min_elt l
-
- let rec max_elt = function
- Empty -> raise Not_found
- | Node(l, v, Empty, _) -> v
- | Node(l, v, r, _) -> max_elt r
-
- let choose = min_elt
-
- end
diff --git a/cil/src/ext/pta/setp.mli b/cil/src/ext/pta/setp.mli
deleted file mode 100644
index a3b30313c11c49810c838dd6df7dacb2c4c250b4..0000000000000000000000000000000000000000
--- a/cil/src/ext/pta/setp.mli
+++ /dev/null
@@ -1,180 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * John Kodumal <jkodumal@eecs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-(***********************************************************************)
-(* *)
-(* Objective Caml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. All rights reserved. This file is distributed *)
-(* under the terms of the GNU Library General Public License, with *)
-(* the special exception on linking described in file ../LICENSE. *)
-(* *)
-(***********************************************************************)
-
-(* $Id: setp.mli,v 1.3 2003-02-19 19:26:31 jkodumal Exp $ *)
-
-(** Sets over ordered types.
-
- This module implements the set data structure, given a total ordering
- function over the set elements. All operations over sets
- are purely applicative (no side-effects).
- The implementation uses balanced binary trees, and is therefore
- reasonably efficient: insertion and membership take time
- logarithmic in the size of the set, for instance.
-*)
-
-module type PolyOrderedType =
- sig
- type 'a t
- (** The type of the set elements. *)
- val compare : 'a t -> 'a t -> int
- (** A total ordering function over the set elements.
- This is a two-argument function [f] such that
- [f e1 e2] is zero if the elements [e1] and [e2] are equal,
- [f e1 e2] is strictly negative if [e1] is smaller than [e2],
- and [f e1 e2] is strictly positive if [e1] is greater than [e2].
- Example: a suitable ordering function is
- the generic structural comparison function {!Pervasives.compare}. *)
- end
-(** Input signature of the functor {!Set.Make}. *)
-
-module type S =
- sig
- type 'a elt
- (** The type of the set elements. *)
-
- type 'a t
- (** The type of sets. *)
-
- val empty: 'a t
- (** The empty set. *)
-
- val is_empty: 'a t -> bool
- (** Test whether a set is empty or not. *)
-
- val mem: 'a elt -> 'a t -> bool
- (** [mem x s] tests whether [x] belongs to the set [s]. *)
-
- val add: 'a elt -> 'a t -> 'a t
- (** [add x s] returns a set containing all elements of [s],
- plus [x]. If [x] was already in [s], [s] is returned unchanged. *)
-
- val singleton: 'a elt -> 'a t
- (** [singleton x] returns the one-element set containing only [x]. *)
-
- val remove: 'a elt -> 'a t -> 'a t
- (** [remove x s] returns a set containing all elements of [s],
- except [x]. If [x] was not in [s], [s] is returned unchanged. *)
-
- val union: 'a t -> 'a t -> 'a t
- (** Set union. *)
-
- val inter: 'a t -> 'a t -> 'a t
- (** Set interseection. *)
-
- (** Set difference. *)
- val diff: 'a t -> 'a t -> 'a t
-
- val compare: 'a t -> 'a t -> int
- (** Total ordering between sets. Can be used as the ordering function
- for doing sets of sets. *)
-
- val equal: 'a t -> 'a t -> bool
- (** [equal s1 s2] tests whether the sets [s1] and [s2] are
- equal, that is, contain equal elements. *)
-
- val subset: 'a t -> 'a t -> bool
- (** [subset s1 s2] tests whether the set [s1] is a subset of
- the set [s2]. *)
-
- val iter: ('a elt -> unit) -> 'a t -> unit
- (** [iter f s] applies [f] in turn to all elements of [s].
- The order in which the elements of [s] are presented to [f]
- is unspecified. *)
-
- val fold: ('a elt -> 'b -> 'b) -> 'a t -> 'b -> 'b
- (** [fold f s a] computes [(f xN ... (f x2 (f x1 a))...)],
- where [x1 ... xN] are the elements of [s].
- The order in which elements of [s] are presented to [f] is
- unspecified. *)
-
- val for_all: ('a elt -> bool) -> 'a t -> bool
- (** [for_all p s] checks if all elements of the set
- satisfy the predicate [p]. *)
-
- val exists: ('a elt -> bool) -> 'a t -> bool
- (** [exists p s] checks if at least one element of
- the set satisfies the predicate [p]. *)
-
- val filter: ('a elt -> bool) -> 'a t -> 'a t
- (** [filter p s] returns the set of all elements in [s]
- that satisfy predicate [p]. *)
-
- val partition: ('a elt -> bool) -> 'a t -> 'a t * 'a t
- (** [partition p s] returns a pair of sets [(s1, s2)], where
- [s1] is the set of all the elements of [s] that satisfy the
- predicate [p], and [s2] is the set of all the elements of
- [s] that do not satisfy [p]. *)
-
- val cardinal: 'a t -> int
- (** Return the number of elements of a set. *)
-
- val elements: 'a t -> 'a elt list
- (** Return the list of all elements of the given set.
- The returned list is sorted in increasing order with respect
- to the ordering [Ord.compare], where [Ord] is the argument
- given to {!Set.Make}. *)
-
- val min_elt: 'a t -> 'a elt
- (** Return the smallest element of the given set
- (with respect to the [Ord.compare] ordering), or raise
- [Not_found] if the set is empty. *)
-
- val max_elt: 'a t -> 'a elt
- (** Same as {!Set.S.min_elt}, but returns the largest element of the
- given set. *)
-
- val choose: 'a t -> 'a elt
- (** Return one element of the given set, or raise [Not_found] if
- the set is empty. Which element is chosen is unspecified,
- but equal elements will be chosen for equal sets. *)
- end
-(** Output signature of the functor {!Set.Make}. *)
-
-module Make (Ord : PolyOrderedType) : S with type 'a elt = 'a Ord.t
-(** Functor building an implementation of the set structure
- given a totally ordered type. *)
diff --git a/cil/src/ext/pta/steensgaard.ml b/cil/src/ext/pta/steensgaard.ml
deleted file mode 100644
index 6368693478c2ee77dfac8a9ec2c2656defc86253..0000000000000000000000000000000000000000
--- a/cil/src/ext/pta/steensgaard.ml
+++ /dev/null
@@ -1,1417 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * John Kodumal <jkodumal@eecs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(***********************************************************************)
-(* *)
-(* *)
-(* This file is currently unused by CIL. It is included in the *)
-(* distribution for reference only. *)
-(* *)
-(* *)
-(***********************************************************************)
-
-
-(***********************************************************************)
-(* *)
-(* Type Declarations *)
-(* *)
-(***********************************************************************)
-
-exception Inconsistent of string
-exception Bad_cache
-exception No_contents
-exception Bad_proj
-exception Bad_type_copy
-exception Instantiation_cycle
-
-module U = Uref
-module S = Setp
-module H = Hashtbl
-module Q = Queue
-
-(** Polarity kinds-- positive, negative, or nonpolar. *)
-type polarity = Pos
- | Neg
- | Non
-
-(** Label bounds. The polymorphic type is a hack for recursive modules *)
-type 'a bound = {index : int; info : 'a}
-
-(** The 'a type may in general contain urefs, which makes Pervasives.compare
- incorrect. However, the bounds will always be correct because if two tau's
- get unified, their cached instantiations will be re-entered into the
- worklist, ensuring that any labels find the new bounds *)
-module Bound =
-struct
- type 'a t = 'a bound
- let compare (x : 'a t) (y : 'a t) =
- Pervasives.compare x y
-end
-
-module B = S.Make(Bound)
-
-type 'a boundset = 'a B.t
-
-(** Constants, which identify elements in points-to sets *)
-type constant = int * string
-
-module Constant =
-struct
- type t = constant
-
- let compare ((xid,_) : t) ((yid,_) : t) =
- Pervasives.compare xid yid
-end
-
-module C = Set.Make(Constant)
-
-(** Sets of constants. Set union is used when two labels containing
- constant sets are unified *)
-type constantset = C.t
-
-type lblinfo = {
- mutable l_name: string;
- (** Name of this label *)
- mutable aliases: constantset;
- (** Set of constants (tags) for checking aliases *)
- p_bounds: label boundset U.uref;
- (** Set of umatched (p) lower bounds *)
- n_bounds: label boundset U.uref;
- (** Set of unmatched (n) lower bounds *)
- mutable p_cached: bool;
- (** Flag indicating whether all reachable p edges have been locally cached *)
- mutable n_cached: bool;
- (** Flag indicating whether all reachable n edges have been locally cached *)
- mutable on_path: bool;
- (** For cycle detection during reachability queries *)
-}
-
-(** Constructor labels *)
-and label = lblinfo U.uref
-
-(** The type of lvalues. *)
-type lvalue = {
- l: label;
- contents: tau
-}
-
-(** Data for variables. *)
-and vinfo = {
- v_name: string;
- mutable v_global: bool;
- v_cache: cache
-}
-
-(** Data for ref constructors. *)
-and rinfo = {
- rl: label;
- mutable r_global: bool;
- points_to: tau;
- r_cache: cache
-}
-
-(** Data for fun constructors. *)
-and finfo = {
- fl: label;
- mutable f_global: bool;
- args: tau list ref;
- ret: tau;
- f_cache: cache
-}
-
-(* Data for pairs. Note there is no label. *)
-and pinfo = {
- mutable p_global: bool;
- ptr: tau;
- lam: tau;
- p_cache: cache
-}
-
-(** Type constructors discovered by type inference *)
-and tinfo = Wild
- | Var of vinfo
- | Ref of rinfo
- | Fun of finfo
- | Pair of pinfo
-
-(** The top-level points-to type. *)
-and tau = tinfo U.uref
-
-(** The instantiation constraint cache. The index is used as a key. *)
-and cache = (int,polarity * tau) H.t
-
-(* Type of semi-unification constraints *)
-type su_constraint = Instantiation of tau * (int * polarity) * tau
- | Unification of tau * tau
-
-(** Association lists, used for printing recursive types. The first element
- is a type that has been visited. The second element is the string
- representation of that type (so far). If the string option is set, then
- this type occurs within itself, and is associated with the recursive var
- name stored in the option. When walking a type, add it to an association
- list.
-
- Example : suppose we have the constraint 'a = ref('a). The type is unified
- via cyclic unification, and would loop infinitely if we attempted to print
- it. What we want to do is print the type u rv. ref(rv). This is accomplished
- in the following manner:
-
- -- ref('a) is visited. It is not in the association list, so it is added
- and the string "ref(" is stored in the second element. We recurse to print
- the first argument of the constructor.
-
- -- In the recursive call, we see that 'a (or ref('a)) is already in the
- association list, so the type is recursive. We check the string option,
- which is None, meaning that this is the first recurrence of the type. We
- create a new recursive variable, rv and set the string option to 'rv. Next,
- we prepend u rv. to the string representation we have seen before, "ref(",
- and return "rv" as the string representation of this type.
-
- -- The string so far is "u rv.ref(". The recursive call returns, and we
- complete the type by printing the result of the call, "rv", and ")"
-
- In a type where the recursive variable appears twice, e.g. 'a = pair('a,'a),
- the second time we hit 'a, the string option will be set, so we know to
- reuse the same recursive variable name.
-*)
-type association = tau * string ref * string option ref
-
-(***********************************************************************)
-(* *)
-(* Global Variables *)
-(* *)
-(***********************************************************************)
-
-(** Print the instantiations constraints (loops with cyclic structures). *)
-let print_constraints : bool ref = ref false
-
-(** Solve constraints as they are introduced. If this is false, constraints
- are solved in batch fashion at calls to solveConstraints. *)
-let solve_online : bool ref = ref true
-
-(** If true, print all constraints (including induced) and show additional
- debug output. *)
-let debug = ref false
-let debug_constraints = debug
-
-(** If true, print out extra verbose debug information (including contents
- of label sets *)
-let verbose_debug = ref false
-
-
-(** If true, make the flow step a no-op *)
-let no_flow = ref false
-
-let no_sub = ref false
-
-(** If true, do not add instantiation constraints *)
-let analyze_mono = ref false
-
-(** A counter for generating unique integers. *)
-let counter : int ref = ref 0
-
-(** A list of equality constraints. *)
-let eq_worklist : su_constraint Q.t = Q.create()
-
-(** A list of instantiation constraints. *)
-let inst_worklist : su_constraint Q.t = Q.create()
-
-(***********************************************************************)
-(* *)
-(* Utility Functions *)
-(* *)
-(***********************************************************************)
-
-(** Consistency check for inferred types *)
-let pair_or_var (t : tau) =
- match (U.deref t) with
- | Pair _ -> true
- | Var _ -> true
- | _ -> false
-
-let ref_or_var (t : tau) =
- match (U.deref t) with
- | Ref _ -> true
- | Var _ -> true
- | _ -> false
-
-let fun_or_var (t : tau) =
- match (U.deref t) with
- | Fun _ -> true
- | Var _ -> true
- | _ -> false
-
-(** Generate a unique integer. *)
-let fresh_index () : int =
- incr counter;
- !counter
-
-(** Negate a polarity. *)
-let negate (p : polarity) : polarity =
- match p with
- | Pos -> Neg
- | Neg -> Pos
- | Non -> Non
-
-(** Compute the least-upper-bounds of two polarities. *)
-let lub (p,p' : polarity * polarity) : polarity =
- match p with
- | Pos ->
- begin
- match p' with
- | Pos -> Pos
- | _ -> Non
- end
- | Neg ->
- begin
- match p' with
- | Neg -> Neg
- | _ -> Non
- end
- | Non -> Non
-
-(** Extract the cache from a type *)
-let get_cache (t : tau) : cache =
- match U.deref t with
- | Wild -> raise Bad_cache
- | Var v -> v.v_cache
- | Ref r -> r.r_cache
- | Pair p -> p.p_cache
- | Fun f -> f.f_cache
-
-(** Determine whether or not a type is global *)
-let get_global (t : tau) : bool =
- match U.deref t with
- | Wild -> false
- | Var v -> v.v_global
- | Ref r -> r.r_global
- | Pair p -> p.p_global
- | Fun f -> f.f_global
-
-(** Return true if a type is monomorphic (global). *)
-let global_tau = get_global
-
-let global_lvalue lv = get_global lv.contents
-
-(** Return true if e is a member of l (according to uref equality) *)
-let rec ulist_mem e l =
- match l with
- | [] -> false
- | h :: t -> if (U.equal(h,e)) then true else ulist_mem e t
-
-(** Convert a polarity to a string *)
-let string_of_polarity p =
- match p with
- | Pos -> "+"
- | Neg -> "-"
- | Non -> "T"
-
-(** Convert a label to a string, short representation *)
-let string_of_label2 (l : label) : string =
- "\"" ^ (U.deref l).l_name ^ "\""
-
-(** Convert a label to a string, long representation *)
-let string_of_label (l : label ) : string =
- let rec constset_to_string = function
- | (_,s) :: [] -> s
- | (_,s) :: t -> s ^ "," ^ (constset_to_string t)
- | [] -> ""
- in
- let aliases = constset_to_string (C.elements ((U.deref l).aliases))
- in
- if ( (aliases = "") || (not !verbose_debug))
- then string_of_label2 l
- else aliases
-
-(** Return true if the element [e] is present in the association list *)
-let rec assoc_list_mem (e : tau) (l : association list) =
- match l with
- | [] -> None
- | (h,s,so) :: t ->
- if (U.equal(h,e)) then (Some (s,so)) else assoc_list_mem e t
-
-(** Given a tau, create a unique recursive variable name. This should always
- return the same name for a given tau *)
-let fresh_recvar_name (t : tau) : string =
- match U.deref t with
- | Pair p -> "rvp" ^ string_of_int((Hashtbl.hash p))
- | Ref r -> "rvr" ^ string_of_int((Hashtbl.hash r))
- | Fun f -> "rvf" ^ string_of_int((Hashtbl.hash f))
- | _ -> raise (Inconsistent ("recvar_name"))
-
-(** Return a string representation of a tau, using association lists. *)
-let string_of_tau (t : tau ) : string =
- let tau_map : association list ref = ref [] in
- let rec string_of_tau' t =
- match (assoc_list_mem t (!tau_map)) with
- | Some (s,so) -> (* recursive type. see if a var name has been set *)
- begin
- match (!so) with
- | None ->
- begin
- let rv = fresh_recvar_name(t) in
- s := "u " ^ rv ^ "." ^ (!s);
- so := Some (rv);
- rv
- end
- | Some rv -> rv
- end
- | None -> (* type's not recursive. Add it to the assoc list and cont. *)
- let s = ref "" in
- let so : string option ref = ref None in
- begin
- tau_map := (t,s,so) :: (!tau_map);
-
- (match (U.deref t) with
- | Wild -> s := "_";
- | Var v -> s := v.v_name;
- | Pair p ->
- begin
- assert (ref_or_var(p.ptr));
- assert (fun_or_var(p.lam));
- s := "{";
- s := (!s) ^ (string_of_tau' p.ptr);
- s := (!s) ^ ",";
- s := (!s) ^ (string_of_tau' p.lam);
- s := (!s) ^"}"
-
- end
- | Ref r ->
- begin
- assert(pair_or_var(r.points_to));
- s := "ref(|";
- s := (!s) ^ (string_of_label r.rl);
- s := (!s) ^ "|,";
- s := (!s) ^ (string_of_tau' r.points_to);
- s := (!s) ^ ")"
-
- end
- | Fun f ->
- begin
- assert(pair_or_var(f.ret));
- let rec string_of_args = function
- | h :: [] ->
- begin
- assert(pair_or_var(h));
- s := (!s) ^ (string_of_tau' h)
- end
- | h :: t ->
- begin
- assert(pair_or_var(h));
- s := (!s) ^ (string_of_tau' h) ^ ",";
- string_of_args t
- end
- | [] -> ()
- in
- s := "fun(|";
- s := (!s) ^ (string_of_label f.fl);
- s := (!s) ^ "|,";
- s := (!s) ^ "<";
- if (List.length !(f.args) > 0)
- then
- string_of_args !(f.args)
- else
- s := (!s) ^ "void";
- s := (!s) ^">,";
- s := (!s) ^ (string_of_tau' f.ret);
- s := (!s) ^ ")"
- end);
- tau_map := List.tl (!tau_map);
- !s
- end
- in
- string_of_tau' t
-
-(** Convert an lvalue to a string *)
-let rec string_of_lvalue (lv : lvalue) : string =
- let contents = (string_of_tau(lv.contents)) in
- let l = (string_of_label lv.l) in
- assert(pair_or_var(lv.contents));
- Printf.sprintf "[%s]^(%s)" contents l
-
-(** Print a list of tau elements, comma separated *)
-let rec print_tau_list (l : tau list) : unit =
- let t_strings = List.map string_of_tau l in
- let rec print_t_strings = function
- | h :: [] -> print_string h; print_newline();
- | h :: t -> print_string h; print_string ", "; print_t_strings t
- | [] -> ()
- in
- print_t_strings t_strings
-
-(** Print a constraint. *)
-let print_constraint (c : su_constraint) =
- match c with
- | Unification (t,t') ->
- let lhs = string_of_tau t in
- let rhs = string_of_tau t' in
- Printf.printf "%s == %s\n" lhs rhs
- | Instantiation (t,(i,p),t') ->
- let lhs = string_of_tau t in
- let rhs = string_of_tau t' in
- let index = string_of_int i in
- let pol = string_of_polarity p in
- Printf.printf "%s <={%s,%s} %s\n" lhs index pol rhs
-
-(* If [positive] is true, return the p-edge bounds, otherwise, return
- the n-edge bounds. *)
-let get_bounds (positive : bool) (l : label) : label boundset U.uref =
- if (positive) then
- (U.deref l).p_bounds
- else
- (U.deref l).n_bounds
-
-(** Used for cycle detection during the flow step. Returns true if the
- label [l] is found on the current path. *)
-let on_path (l : label) : bool =
- (U.deref l).on_path
-
-(** Used for cycle detection during the flow step. Identifies [l] as being
- on/off the current path. *)
-let set_on_path (l : label) (b : bool) : unit =
- (U.deref l).on_path <- b
-
-(** Make the type a global type *)
-let set_global (t : tau) (b : bool) : bool =
- if (!debug && b)
- then
- Printf.printf "Setting a new global : %s\n" (string_of_tau t);
- begin
- assert ( (not (get_global(t)) ) || b );
- (match U.deref t with
- | Wild -> ()
- | Var v -> v.v_global <- b
- | Ref r -> r.r_global <- b
- | Pair p -> p.p_global <- b
- | Fun f -> f.f_global <- b);
- b
- end
-
-(** Return a label's bounds as a string *)
-let string_of_bounds (is_pos : bool) (l : label) : string =
- let bounds =
- if (is_pos) then
- U.deref ((U.deref l).p_bounds)
- else
- U.deref ((U.deref l).n_bounds)
- in
- B.fold (fun b -> fun res -> res ^ (string_of_label2 b.info) ^ " "
- ) bounds ""
-
-(***********************************************************************)
-(* *)
-(* Type Operations -- these do not create any constraints *)
-(* *)
-(***********************************************************************)
-
-let wild_val = U.uref Wild
-
-(** The wild (don't care) value. *)
-let wild () : tau =
- wild_val
-
-(** Create an lvalue with label [lbl] and tau contents [t]. *)
-let make_lval (lbl,t : label * tau) : lvalue =
- {l = lbl; contents = t}
-
-(** Create a new label with name [name]. Also adds a fresh constant
- with name [name] to this label's aliases set. *)
-let make_label (name : string) : label =
- U.uref {
- l_name = name;
- aliases = (C.add (fresh_index(),name) C.empty);
- p_bounds = U.uref (B.empty);
- n_bounds = U.uref (B.empty);
- p_cached = false;
- n_cached = false;
- on_path = false
- }
-
-(** Create a new label with an unspecified name and an empty alias set. *)
-let fresh_label () : label =
- U.uref {
- l_name = "l_" ^ (string_of_int (fresh_index()));
- aliases = (C.empty);
- p_bounds = U.uref (B.empty);
- n_bounds = U.uref (B.empty);
- p_cached = false;
- n_cached = false;
- on_path = false
- }
-
-(** Create a fresh bound. *)
-let make_bound (i,a : int * 'a) : 'a bound =
- {index = i; info = a }
-
-(** Create a fresh named variable with name '[name]. *)
-let make_var (b: bool) (name : string) : tau =
- U.uref (Var {v_name = ("'" ^name);
- v_global = b;
- v_cache = H.create 4})
-
-(** Create a fresh unnamed variable (name will be 'fv). *)
-let fresh_var () : tau =
- make_var false ("fv" ^ (string_of_int (fresh_index())) )
-
-(** Create a fresh unnamed variable (name will be 'fi). *)
-let fresh_var_i () : tau =
- make_var false ("fi" ^ (string_of_int (fresh_index())) )
-
-(** Create a Fun constructor. *)
-let make_fun (lbl,a,r : label * (tau list) * tau) : tau =
- U.uref (Fun {fl = lbl ;
- f_global = false;
- args = ref a;
- ret = r;
- f_cache = H.create 4})
-
-(** Create a Ref constructor. *)
-let make_ref (lbl,pt : label * tau) : tau =
- U.uref (Ref {rl = lbl ;
- r_global = false;
- points_to = pt;
- r_cache = H.create 4})
-
-(** Create a Pair constructor. *)
-let make_pair (p,f : tau * tau) : tau =
- U.uref (Pair {ptr = p;
- p_global = false;
- lam = f;
- p_cache = H.create 4})
-
-(** Copy the toplevel constructor of [t], putting fresh variables in each
- argement of the constructor. *)
-let copy_toplevel (t : tau) : tau =
- match U.deref t with
- | Pair _ ->
- make_pair (fresh_var_i(), fresh_var_i())
- | Ref _ ->
- make_ref (fresh_label(),fresh_var_i())
- | Fun f ->
- let fresh_fn = fun _ -> fresh_var_i()
- in
- make_fun (fresh_label(), List.map fresh_fn !(f.args) , fresh_var_i())
- | _ -> raise Bad_type_copy
-
-let pad_args (l,l' : (tau list ref) * (tau list ref)) : unit =
- let padding = ref ((List.length (!l)) - (List.length (!l')))
- in
- if (!padding == 0) then ()
- else
- let to_pad =
- if (!padding > 0) then l' else (padding := -(!padding);l)
- in
- for i = 1 to (!padding) do
- to_pad := (!to_pad) @ [fresh_var()]
- done
-
-(***********************************************************************)
-(* *)
-(* Constraint Generation/ Resolution *)
-(* *)
-(***********************************************************************)
-
-(** Returns true if the constraint has no effect, i.e. either the left-hand
- side or the right-hand side is wild. *)
-let wild_constraint (t,t' : tau * tau) : bool =
- let ti,ti' = U.deref t, U.deref t' in
- match ti,ti' with
- | Wild, _ -> true
- | _, Wild -> true
- | _ -> false
-
-exception Cycle_found
-
-(** Cycle detection between instantiations. Returns true if there is a cycle
- from t to t' *)
-let exists_cycle (t,t' : tau * tau) : bool =
- let visited : tau list ref = ref [] in
- let rec exists_cycle' t =
- if (ulist_mem t (!visited))
- then
- begin (*
- print_string "Instantiation cycle found :";
- print_tau_list (!visited);
- print_newline();
- print_string (string_of_tau t);
- print_newline(); *)
- (* raise Instantiation_cycle *)
- (* visited := List.tl (!visited) *) (* check *)
- end
- else
- begin
- visited := t :: (!visited);
- if (U.equal(t,t'))
- then raise Cycle_found
- else
- H.iter (fun _ -> fun (_,t'') ->
- if (U.equal (t,t'')) then ()
- else
- ignore (exists_cycle' t'')
- ) (get_cache t) ;
- visited := List.tl (!visited)
- end
- in
- try
- exists_cycle' t;
- false
- with
- | Cycle_found -> true
-
-exception Subterm
-
-(** Returns true if [t'] is a proper subterm of [t] *)
-let proper_subterm (t,t') =
- let visited : tau list ref = ref [] in
- let rec proper_subterm' t =
- if (ulist_mem t (!visited))
- then () (* recursive type *)
- else
- if (U.equal (t,t'))
- then raise Subterm
- else
- begin
- visited := t :: (!visited);
- (
- match (U.deref t) with
- | Wild -> ()
- | Var _ -> ()
- | Ref r ->
- proper_subterm' r.points_to
- | Pair p ->
- proper_subterm' p.ptr;
- proper_subterm' p.lam
- | Fun f ->
- proper_subterm' f.ret;
- List.iter (proper_subterm') !(f.args)
- );
- visited := List.tl (!visited)
- end
- in
- try
- if (U.equal(t,t')) then false
- else
- begin
- proper_subterm' t;
- false
- end
- with
- | Subterm -> true
-
-(** The extended occurs check. Search for a cycle of instantiations from [t]
- to [t']. If such a cycle exists, check to see that [t'] is a proper subterm
- of [t]. If it is, then return true *)
-let eoc (t,t') : bool =
- if (exists_cycle(t,t') && proper_subterm(t,t'))
- then
- begin
- if (!debug)
- then
- Printf.printf "Occurs check : %s occurs within %s\n" (string_of_tau t')
- (string_of_tau t)
- else
- ();
- true
- end
- else
- false
-
-(** Resolve an instantiation constraint *)
-let rec instantiate_int (t,(i,p),t' : tau * (int * polarity) * tau) =
- if ( wild_constraint(t,t') || (not (store(t,(i,p),t'))) ||
- U.equal(t,t') )
- then ()
- else
- let ti,ti' = U.deref t, U.deref t' in
- match ti,ti' with
- | Ref r, Ref r' ->
- instantiate_ref(r,(i,p),r')
- | Fun f, Fun f' ->
- instantiate_fun(f,(i,p),f')
- | Pair pr, Pair pr' ->
- begin
- add_constraint_int (Instantiation (pr.ptr,(i,p),pr'.ptr));
- add_constraint_int (Instantiation (pr.lam,(i,p),pr'.lam))
- end
- | Var v, _ -> ()
- | _,Var v' ->
- if eoc(t,t')
- then
- add_constraint_int (Unification (t,t'))
- else
- begin
- unstore(t,i);
- add_constraint_int (Unification ((copy_toplevel t),t'));
- add_constraint_int (Instantiation (t,(i,p),t'))
- end
- | _ -> raise (Inconsistent("instantiate"))
-
-(** Apply instantiations to the ref's label, and structurally down the type.
- Contents of ref constructors are instantiated with polarity Non. *)
-and instantiate_ref (ri,(i,p),ri') : unit =
- add_constraint_int (Instantiation(ri.points_to,(i,Non),ri'.points_to));
- instantiate_label (ri.rl,(i,p),ri'.rl)
-
-(** Apply instantiations to the fun's label, and structurally down the type.
- Flip the polarity for the function's args. If the lengths of the argument
- lists don't match, extend the shorter list as necessary. *)
-and instantiate_fun (fi,(i,p),fi') : unit =
- pad_args (fi.args, fi'.args);
- assert(List.length !(fi.args) == List.length !(fi'.args));
- add_constraint_int (Instantiation (fi.ret,(i,p),fi'.ret));
- List.iter2 (fun t ->fun t' ->
- add_constraint_int (Instantiation(t,(i,negate p),t')))
- !(fi.args) !(fi'.args);
- instantiate_label (fi.fl,(i,p),fi'.fl)
-
-(** Instantiate a label. Update the label's bounds with new flow edges.
- *)
-and instantiate_label (l,(i,p),l' : label * (int * polarity) * label) : unit =
- if (!debug) then
- Printf.printf "%s <= {%d,%s} %s\n" (string_of_label l) i
- (string_of_polarity p) (string_of_label l');
- let li,li' = U.deref l, U.deref l' in
- match p with
- | Pos ->
- U.update (li'.p_bounds,
- B.add(make_bound (i,l)) (U.deref li'.p_bounds)
- )
- | Neg ->
- U.update (li.n_bounds,
- B.add(make_bound (i,l')) (U.deref li.n_bounds)
- )
- | Non ->
- begin
- U.update (li'.p_bounds,
- B.add(make_bound (i,l)) (U.deref li'.p_bounds)
- );
- U.update (li.n_bounds,
- B.add(make_bound (i,l')) (U.deref li.n_bounds)
- )
- end
-
-(** Resolve a unification constraint. Does the uref unification after grabbing
- a copy of the information before the two infos are unified. The other
- interesting feature of this function is the way 'globalness' is propagated.
- If a non-global is unified with a global, the non-global becomes global.
- If the ecr became global, there is a problem because none of its cached
- instantiations know that the type became monomorphic. In this case, they
- must be re-inserted via merge-cache. Merge-cache always reinserts cached
- instantiations from the non-ecr type, i.e. the type that was 'killed' by the
- unification. *)
-and unify_int (t,t' : tau * tau) : unit =
- if (wild_constraint(t,t') || U.equal(t,t'))
- then ()
- else
- let ti, ti' = U.deref t, U.deref t' in
- begin
- U.unify combine (t,t');
- match ti,ti' with
- | Var v, _ ->
- begin
- if (set_global t' (v.v_global || (get_global t')))
- then (H.iter (merge_cache t') (get_cache t'))
- else ();
- H.iter (merge_cache t') v.v_cache
- end
- | _, Var v ->
- begin
- if (set_global t (v.v_global || (get_global t)))
- then (H.iter (merge_cache t) (get_cache t))
- else ();
- H.iter (merge_cache t) v.v_cache
- end
- | Ref r, Ref r' ->
- begin
- if (set_global t (r.r_global || r'.r_global))
- then (H.iter (merge_cache t) (get_cache t))
- else ();
- H.iter (merge_cache t) r'.r_cache;
- unify_ref(r,r')
- end
- | Fun f, Fun f' ->
- begin
- if (set_global t (f.f_global || f'.f_global))
- then (H.iter (merge_cache t) (get_cache t))
- else ();
- H.iter (merge_cache t) f'.f_cache;
- unify_fun (f,f');
- end
- | Pair p, Pair p' ->
- begin
- if (set_global t (p.p_global || p'.p_global))
- then (H.iter (merge_cache t) (get_cache t))
- else ();
- H.iter (merge_cache t) p'.p_cache;
- add_constraint_int (Unification (p.ptr,p'.ptr));
- add_constraint_int (Unification (p.lam,p'.lam))
- end
- | _ -> raise (Inconsistent("unify"))
- end
-
-(** Unify the ref's label, and apply unification structurally down the type. *)
-and unify_ref (ri,ri' : rinfo * rinfo) : unit =
- add_constraint_int (Unification (ri.points_to,ri'.points_to));
- unify_label(ri.rl,ri'.rl)
-
-(** Unify the fun's label, and apply unification structurally down the type,
- at arguments and return value. When combining two lists of different lengths,
- always choose the longer list for the representative. *)
-and unify_fun (li,li' : finfo * finfo) : unit =
- let rec union_args = function
- | _, [] -> false
- | [], _ -> true
- | h :: t, h' :: t' ->
- add_constraint_int (Unification (h,h')); union_args(t,t')
- in
- begin
- unify_label(li.fl,li'.fl);
- add_constraint_int (Unification (li.ret,li'.ret));
- if (union_args(!(li.args),!(li'.args)))
- then li.args := !(li'.args);
- end
-
-(** Unify two labels, combining the set of constants denoting aliases. *)
-and unify_label (l,l' : label * label) : unit =
- let pick_name (li,li' : lblinfo * lblinfo) =
- if ( (String.length li.l_name) > 1 && (String.sub (li.l_name) 0 2) = "l_")
- then
- li.l_name <- li'.l_name
- else ()
- in
- let combine_label (li,li' : lblinfo *lblinfo) : lblinfo =
- let p_bounds = U.deref (li.p_bounds) in
- let p_bounds' = U.deref (li'.p_bounds) in
- let n_bounds = U.deref (li.n_bounds) in
- let n_bounds' = U.deref (li'.n_bounds) in
- begin
- pick_name(li,li');
- li.aliases <- C.union (li.aliases) (li'.aliases);
- U.update (li.p_bounds, (B.union p_bounds p_bounds'));
- U.update (li.n_bounds, (B.union n_bounds n_bounds'));
- li
- end
- in(*
- if (!debug) then
- begin
- Printf.printf "Unifying %s with %s...\n"
- (string_of_label l) (string_of_label l');
- Printf.printf "pbounds : %s\n" (string_of_bounds true l);
- Printf.printf "nbounds : %s\n" (string_of_bounds false l);
- Printf.printf "pbounds : %s\n" (string_of_bounds true l');
- Printf.printf "nbounds : %s\n\n" (string_of_bounds false l')
- end; *)
- U.unify combine_label (l,l')
- (* if (!debug) then
- begin
- Printf.printf "pbounds : %s\n" (string_of_bounds true l);
- Printf.printf "nbounds : %s\n" (string_of_bounds false l)
- end *)
-
-(** Re-assert a cached instantiation constraint, since the old type was
- killed by a unification *)
-and merge_cache (rep : tau) (i : int) (p,t' : polarity * tau) : unit =
- add_constraint_int (Instantiation (rep,(i,p),t'))
-
-(** Pick the representative info for two tinfo's. This function prefers the
- first argument when both arguments are the same structure, but when
- one type is a structure and the other is a var, it picks the structure. *)
-and combine (ti,ti' : tinfo * tinfo) : tinfo =
- match ti,ti' with
- | Var _, _ -> ti'
- | _,_ -> ti
-
-(** Add a new constraint induced by other constraints. *)
-and add_constraint_int (c : su_constraint) =
- if (!print_constraints && !debug) then print_constraint c else ();
- begin
- match c with
- | Instantiation _ ->
- Q.add c inst_worklist
- | Unification _ ->
- Q.add c eq_worklist
- end;
- if (!debug) then solve_constraints() else ()
-
-(** Add a new constraint introduced through this module's interface (a
- top-level constraint). *)
-and add_constraint (c : su_constraint) =
- begin
- add_constraint_int (c);
- if (!print_constraints && not (!debug)) then print_constraint c else ();
- if (!solve_online) then solve_constraints() else ()
- end
-
-
-(* Fetch constraints, preferring equalities. *)
-and fetch_constraint () : su_constraint option =
- if (Q.length eq_worklist > 0)
- then
- Some (Q.take eq_worklist)
- else if (Q.length inst_worklist > 0)
- then
- Some (Q.take inst_worklist)
- else
- None
-
-(** Returns the target of a cached instantiation, if it exists. *)
-and target (t,i,p : tau * int * polarity) : (polarity * tau) option =
- let cache = get_cache t in
- if (global_tau t) then Some (Non,t)
- else
- try
- Some (H.find cache i)
- with
- | Not_found -> None
-
-(** Caches a new instantiation, or applies well-formedness. *)
-and store ( t,(i,p),t' : tau * (int * polarity) * tau) : bool =
- let cache = get_cache t in
- match target(t,i,p) with
- | Some (p'',t'') ->
- if (U.equal (t',t'') && (lub(p,p'') = p''))
- then
- false
- else
- begin
- add_constraint_int (Unification (t',t''));
- H.replace cache i (lub(p,p''),t'');
- (* add a new forced instantiation as well *)
- if (lub(p,p'') = p'')
- then ()
- else
- begin
- unstore(t,i);
- add_constraint_int (Instantiation (t,(i,lub(p,p'')),t''))
- end;
- false
- end
- | None ->
- begin
- H.add cache i (p,t');
- true
- end
-
-(** Remove a cached instantiation. Used when type structure changes *)
-and unstore (t,i : tau * int) =
-let cache = get_cache t in
- H.remove cache i
-
-(** The main solver loop. *)
-and solve_constraints () : unit =
- match fetch_constraint () with
- | Some c ->
- begin
- (match c with
- | Instantiation (t,(i,p),t') -> instantiate_int (t,(i,p),t')
- | Unification (t,t') -> unify_int (t,t')
- );
- solve_constraints()
- end
- | None -> ()
-
-
-(***********************************************************************)
-(* *)
-(* Interface Functions *)
-(* *)
-(***********************************************************************)
-
-(** Return the contents of the lvalue. *)
-let rvalue (lv : lvalue) : tau =
- lv.contents
-
-(** Dereference the rvalue. If it does not have enough structure to support
- the operation, then the correct structure is added via new unification
- constraints. *)
-let rec deref (t : tau) : lvalue =
- match U.deref t with
- | Pair p ->
- (
- match U.deref (p.ptr) with
- | Var _ ->
- begin
- (* let points_to = make_pair(fresh_var(),fresh_var()) in *)
- let points_to = fresh_var() in
- let l = fresh_label() in
- let r = make_ref(l,points_to)
- in
- add_constraint (Unification (p.ptr,r));
- make_lval(l, points_to)
- end
- | Ref r -> make_lval(r.rl, r.points_to)
- | _ -> raise (Inconsistent("deref"))
- )
- | Var v ->
- begin
- add_constraint (Unification (t,make_pair(fresh_var(),fresh_var())));
- deref t
- end
- | _ -> raise (Inconsistent("deref -- no top level pair"))
-
-(** Form the union of [t] and [t']. *)
-let join (t : tau) (t' : tau) : tau =
- let t'' = fresh_var() in
- add_constraint (Unification (t,t''));
- add_constraint (Unification (t',t''));
- t''
-
-(** Form the union of a list [tl], expected to be the initializers of some
- structure or array type. *)
-let join_inits (tl : tau list) : tau =
- let t' = fresh_var() in
- begin
- List.iter (function t'' -> add_constraint (Unification(t',t''))) tl;
- t'
- end
-
-(** Take the address of an lvalue. Does not add constraints. *)
-let address (lv : lvalue) : tau =
- make_pair (make_ref (lv.l, lv.contents), fresh_var() )
-
-(** Instantiate a type with index i. By default, uses positive polarity.
- Adds an instantiation constraint. *)
-let instantiate (lv : lvalue) (i : int) : lvalue =
- if (!analyze_mono) then lv
- else
- begin
- let l' = fresh_label () in
- let t' = fresh_var_i () in
- instantiate_label(lv.l,(i,Pos),l');
- add_constraint (Instantiation (lv.contents,(i,Pos),t'));
- make_lval(l',t') (* check -- fresh label ?? *)
- end
-
-(** Constraint generated from assigning [t] to [lv]. *)
-let assign (lv : lvalue) (t : tau) : unit =
- add_constraint (Unification (lv.contents,t))
-
-
-(** Project out the first (ref) component or a pair. If the argument [t] has
- no discovered structure, raise No_contents. *)
-let proj_ref (t : tau) : tau =
- match U.deref t with
- | Pair p -> p.ptr
- | Var v -> raise No_contents
- | _ -> raise Bad_proj
-
-(* Project out the second (fun) component of a pair. If the argument [t] has
- no discovered structure, create it on the fly by adding constraints. *)
-let proj_fun (t : tau) : tau =
- match U.deref t with
- | Pair p -> p.lam
- | Var v ->
- let p,f = fresh_var(), fresh_var() in
- add_constraint (Unification (t,make_pair(p,f)));
- f
- | _ -> raise Bad_proj
-
-let get_args (t : tau) : tau list ref =
- match U.deref t with
- | Fun f -> f.args
- | _ -> raise (Inconsistent("get_args"))
-
-(** Function type [t] is applied to the arguments [actuals]. Unifies the
- actuals with the formals of [t]. If no functions have been discovered for
- [t] yet, create a fresh one and unify it with t. The result is the return
- value of the function. *)
-let apply (t : tau) (al : tau list) : tau =
- let f = proj_fun(t) in
- let actuals = ref al in
- let formals,ret =
- match U.deref f with
- | Fun fi -> (fi.args),fi.ret
- | Var v ->
- let new_l,new_ret,new_args =
- fresh_label(), fresh_var (),
- List.map (function _ -> fresh_var()) (!actuals)
- in
- let new_fun = make_fun(new_l,new_args,new_ret) in
- add_constraint (Unification(new_fun,f));
- (get_args new_fun,new_ret)
- | Ref _ -> raise (Inconsistent ("apply_ref"))
- | Pair _ -> raise (Inconsistent ("apply_pair"))
- | Wild -> raise (Inconsistent("apply_wild"))
- in
- pad_args(formals,actuals);
- List.iter2 (fun actual -> fun formal ->
- add_constraint (Unification (actual,formal))
- ) !actuals !formals;
- ret
-
-(** Create a new function type with name [name], list of formal arguments
- [formals], and return value [ret]. Adds no constraints. *)
-let make_function (name : string) (formals : lvalue list) (ret : tau) : tau =
- let
- f = make_fun(make_label(name),List.map (fun x -> rvalue x) formals, ret)
- in
- make_pair(fresh_var(),f)
-
-(** Create an lvalue. If [is_global] is true, the lvalue will be treated
- monomorphically. *)
-let make_lvalue (is_global : bool) (name : string) : lvalue =
- if (!debug && is_global)
- then
- Printf.printf "Making global lvalue : %s\n" name
- else ();
- make_lval(make_label(name), make_var is_global name)
-
-
-(** Create a fresh non-global named variable. *)
-let make_fresh (name : string) : tau =
- make_var false (name)
-
-(** The default type for constants. *)
-let bottom () : tau =
- make_var false ("bottom")
-
-(** Unify the result of a function with its return value. *)
-let return (t : tau) (t' : tau) =
- add_constraint (Unification (t,t'))
-
-
-(***********************************************************************)
-(* *)
-(* Query/Extract Solutions *)
-(* *)
-(***********************************************************************)
-
-(** Unify the data stored in two label bounds. *)
-let combine_lbounds (s,s' : label boundset * label boundset) =
- B.union s s'
-
-(** Truncates a list of urefs [l] to those elements up to and including the
- first occurence of the specified element [elt]. *)
-let truncate l elt =
- let keep = ref true in
- List.filter
- (fun x ->
- if (not (!keep))
- then
- false
- else
- begin
- if (U.equal(x,elt))
- then
- keep := false
- else ();
- true
- end
- ) l
-
-let debug_cycle_bounds is_pos c =
- let rec debug_cycle_bounds' = function
- | h :: [] ->
- Printf.printf "%s --> %s\n" (string_of_bounds is_pos h)
- (string_of_label2 h)
- | h :: t ->
- begin
- Printf.printf "%s --> %s\n" (string_of_bounds is_pos h)
- (string_of_label2 h);
- debug_cycle_bounds' t
- end
- | [] -> ()
- in
- debug_cycle_bounds' c
-
-(** For debugging, print a cycle of instantiations *)
-let debug_cycle (is_pos,c,l,p) =
- let kind = if is_pos then "P" else "N" in
- let rec string_of_cycle = function
- | h :: [] -> string_of_label2 h
- | [] -> ""
- | h :: t -> Printf.sprintf "%s,%s" (string_of_label2 h) (string_of_cycle t)
- in
- Printf.printf "Collapsing %s cycle around %s:\n" kind (string_of_label2 l);
- Printf.printf "Elements are: %s\n" (string_of_cycle c);
- Printf.printf "Per-element bounds:\n";
- debug_cycle_bounds is_pos c;
- Printf.printf "Full path is: %s" (string_of_cycle p);
- print_newline()
-
-(** Compute pos or neg flow, depending on [is_pos]. Searches for cycles in the
- instantiations (can these even occur?) and unifies either the positive or
- negative edge sets for the labels on the cycle. Note that this does not
- ever unify the labels themselves. The return is the new bounds of the
- argument label *)
-let rec flow (is_pos : bool) (path : label list) (l : label) : label boundset =
- let collapse_cycle () =
- let cycle = truncate path l in
- debug_cycle (is_pos,cycle,l,path);
- List.iter (fun x -> U.unify combine_lbounds
- ((get_bounds is_pos x),get_bounds is_pos l)
- ) cycle
- in
- if (on_path l)
- then
- begin
- collapse_cycle ();
- (* set_on_path l false; *)
- B.empty
- end
- else
- if ( (is_pos && (U.deref l).p_cached) ||
- ( (not is_pos) && (U.deref l).n_cached) ) then
- begin
- U.deref (get_bounds is_pos l)
- end
- else
- begin
- let newbounds = ref B.empty in
- let base = get_bounds is_pos l in
- set_on_path l true;
- if (is_pos) then
- (U.deref l).p_cached <- true
- else
- (U.deref l).n_cached <- true;
- B.iter
- (fun x ->
- if (U.equal(x.info,l)) then ()
- else
- (newbounds :=
- (B.union (!newbounds) (flow is_pos (l :: path) x.info)))
- ) (U.deref base);
- set_on_path l false;
- U.update (base,(B.union (U.deref base) !newbounds));
- U.deref base
- end
-
-(** Compute and cache any positive flow. *)
-let pos_flow l : constantset =
- let result = ref C.empty in
- begin
- ignore (flow true [] l);
- B.iter (fun x -> result := C.union (!result) (U.deref(x.info)).aliases )
- (U.deref (get_bounds true l));
- !result
- end
-
-(** Compute and cache any negative flow. *)
-let neg_flow l : constantset =
- let result = ref C.empty in
- begin
- ignore (flow false [] l);
- B.iter (fun x -> result := C.union (!result) (U.deref(x.info)).aliases )
- (U.deref (get_bounds false l));
- !result
- end
-
-(** Compute and cache any pos-neg flow. Assumes that both pos_flow and
- neg_flow have been computed for the label [l]. *)
-let pos_neg_flow(l : label) : constantset =
- let result = ref C.empty in
- begin
- B.iter (fun x -> result := C.union (!result) (pos_flow x.info))
- (U.deref (get_bounds false l));
- !result
- end
-
-(** Compute a points-to set by computing positive, then negative, then
- positive-negative flow for a label. *)
-let points_to_int (lv : lvalue) : constantset =
- let visited_caches : cache list ref = ref [] in
- let rec points_to_tau (t : tau) : constantset =
- try
- begin
- match U.deref (proj_ref t) with
- | Var v -> C.empty
- | Ref r ->
- begin
- let pos = pos_flow r.rl in
- let neg = neg_flow r.rl in
- let interproc = C.union (pos_neg_flow r.rl) (C.union pos neg)
- in
- C.union ((U.deref(r.rl)).aliases) interproc
- end
- | _ -> raise (Inconsistent ("points_to"))
- end
- with
- | No_contents ->
- begin
- match (U.deref t) with
- | Var v -> rebuild_flow v.v_cache
- | _ -> raise (Inconsistent ("points_to"))
- end
- and rebuild_flow (c : cache) : constantset =
- if (List.mem c (!visited_caches) ) (* cyclic instantiations *)
- then
- begin
- (* visited_caches := List.tl (!visited_caches); *) (* check *)
- C.empty
- end
- else
- begin
- visited_caches := c :: (!visited_caches);
- let result = ref (C.empty) in
- H.iter (fun _ -> fun(p,t) ->
- match p with
- | Pos -> ()
- | _ -> result := C.union (!result) (points_to_tau t)
- ) c;
- visited_caches := List.tl (!visited_caches);
- !result
- end
- in
- if (!no_flow) then
- (U.deref lv.l).aliases
- else
- points_to_tau (lv.contents)
-
-let points_to (lv : lvalue) : string list =
- List.map snd (C.elements (points_to_int lv))
-
-let alias_query (a_progress : bool) (lv : lvalue list) : int * int =
- (0,0) (* todo *)
-(*
- let a_count = ref 0 in
- let ptsets = List.map points_to_int lv in
- let total_sets = List.length ptsets in
- let counted_sets = ref 0 in
- let record_alias s s' =
- if (C.is_empty (C.inter s s'))
- then ()
- else (incr a_count)
- in
- let rec check_alias = function
- | h :: t ->
- begin
- List.iter (record_alias h) ptsets;
- check_alias t
- end
- | [] -> ()
- in
- check_alias ptsets;
- !a_count
-*)
diff --git a/cil/src/ext/pta/steensgaard.mli b/cil/src/ext/pta/steensgaard.mli
deleted file mode 100644
index f009e7e0b0842e263df8732a6be9fca9a2a2a41d..0000000000000000000000000000000000000000
--- a/cil/src/ext/pta/steensgaard.mli
+++ /dev/null
@@ -1,71 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * John Kodumal <jkodumal@eecs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(***********************************************************************)
-(* *)
-(* *)
-(* This file is currently unused by CIL. It is included in the *)
-(* distribution for reference only. *)
-(* *)
-(* *)
-(***********************************************************************)
-
-type lvalue
-type tau
-val debug : bool ref
-val debug_constraints : bool ref
-val print_constraints : bool ref
-val no_flow : bool ref
-val no_sub : bool ref
-val analyze_mono : bool ref
-val solve_online : bool ref
-val solve_constraints : unit -> unit
-val rvalue : lvalue -> tau
-val deref : tau -> lvalue
-val join : tau -> tau -> tau
-val join_inits : tau list -> tau
-val address : lvalue -> tau
-val instantiate : lvalue -> int -> lvalue
-val assign : lvalue -> tau -> unit
-val apply : tau -> tau list -> tau
-val make_function : string -> lvalue list -> tau -> tau
-val make_lvalue : bool -> string -> lvalue
-val bottom : unit -> tau
-val return : tau -> tau -> unit
-val make_fresh : string -> tau
-val points_to : lvalue -> string list
-val string_of_lvalue : lvalue -> string
-val global_lvalue : lvalue -> bool
-val alias_query : bool -> lvalue list -> int * int
diff --git a/cil/src/ext/pta/uref.ml b/cil/src/ext/pta/uref.ml
deleted file mode 100644
index 53f36400c8735d8373b08c056a635ad65db68a89..0000000000000000000000000000000000000000
--- a/cil/src/ext/pta/uref.ml
+++ /dev/null
@@ -1,94 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * John Kodumal <jkodumal@eecs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-exception Bad_find
-
-type 'a urefC =
- Ecr of 'a * int
- | Link of 'a uref
-and 'a uref = 'a urefC ref
-
-let rec find p =
- match !p with
- | Ecr _ -> p
- | Link p' ->
- let p'' = find p'
- in p := Link p''; p''
-
-let uref x = ref (Ecr(x,0))
-
-let equal (p,p') = (find p == find p')
-
-let deref p =
- match ! (find p) with
- | Ecr (x,_) -> x
- | _ -> raise Bad_find
-
-let update (p,x) =
- let p' = find p
- in
- match !p' with
- | Ecr (_,rank) -> p' := Ecr(x,rank)
- | _ -> raise Bad_find
-
-let unify f (p,q) =
- let p',q' = find p, find q in
- match (!p',!q') with
- | (Ecr(px,pr),Ecr(qx,qr)) ->
- let x = f(px,qx) in
- if (p' == q') then
- p' := Ecr(x,pr)
- else if pr == qr then
- (q' := Ecr(x,qr+1); p' := Link q')
- else if pr < qr then
- (q' := Ecr(x,qr); p' := Link q')
- else (* pr > qr *)
- (p' := Ecr(x,pr); q' := Link p')
- | _ -> raise Bad_find
-
-let union (p,q) =
- let p',q' = find p, find q in
- match (!p',!q') with
- | (Ecr(px,pr),Ecr(qx,qr)) ->
- if (p' == q') then
- ()
- else if pr == qr then
- (q' := Ecr(qx, qr+1); p' := Link q')
- else if pr < qr then
- p' := Link q'
- else (* pr > qr *)
- q' := Link p'
- | _ -> raise Bad_find
-
-
diff --git a/cil/src/ext/pta/uref.mli b/cil/src/ext/pta/uref.mli
deleted file mode 100644
index 1dee5036dd8af57775f59aa0a556afea43e3da23..0000000000000000000000000000000000000000
--- a/cil/src/ext/pta/uref.mli
+++ /dev/null
@@ -1,65 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * John Kodumal <jkodumal@eecs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-type 'a uref
-
-(** Union-find with union by rank and path compression
-
- This is an implementation of Tarjan's union-find data structure using
- generics. The interface is analagous to standard references, with the
- addition of a union operation which makes two references indistinguishable.
-
-*)
-
-val uref: 'a -> 'a uref
- (** Create a new uref *)
-
-val equal: 'a uref * 'a uref -> bool
- (** Test whether two urefs share the same equivalence class *)
-
-val deref: 'a uref -> 'a
- (** Extract the contents of this reference *)
-
-val update: 'a uref * 'a -> unit
- (** Update the value stored in this reference *)
-
-val unify: ('a * 'a -> 'a) -> 'a uref * 'a uref -> unit
- (** [unify f (p,q)] unifies references [p] and [q], making them
- indistinguishable. The contents of the reference are the result of
- [f] *)
-
-val union: 'a uref * 'a uref -> unit
- (** [unify (p,q)] unifies references [p] and [q], making them
- indistinguishable. The contents of the reference are the contents of
- one of the first or second arguments (unspecified) *)
diff --git a/cil/src/ext/reachingdefs.ml b/cil/src/ext/reachingdefs.ml
deleted file mode 100644
index b6af37cbd54f5d3cd50fce784badefcac3d07bcd..0000000000000000000000000000000000000000
--- a/cil/src/ext/reachingdefs.ml
+++ /dev/null
@@ -1,511 +0,0 @@
-(* Calculate reaching definitions for each instruction.
- * Determine when it is okay to replace some variables with
- * expressions.
- *
- * After calling computeRDs on a fundec,
- * ReachingDef.stmtStartData will contain a mapping from
- * statement ids to data about which definitions reach each
- * statement. ReachingDef.defIdStmtHash will contain a
- * mapping from definition ids to the statement in which
- * that definition takes place.
- *
- * instrRDs takes a list of instructions, and the
- * definitions that reach the first instruction, and
- * for each instruction figures out which definitions
- * reach into or out of each instruction.
- *
- *)
-
-open Cil
-open Pretty
-
-module E = Errormsg
-module DF = Dataflow
-module UD = Usedef
-module IH = Inthash
-module U = Util
-module S = Stats
-
-let debug_fn = ref ""
-
-module IOS =
- Set.Make(struct
- type t = int option
- let compare io1 io2 =
- match io1, io2 with
- Some i1, Some i2 -> Pervasives.compare i1 i2
- | Some i1, None -> 1
- | None, Some i2 -> -1
- | None, None -> 0
- end)
-
-let debug = ref false
-
-(* return the intersection of
- Inthashes ih1 and ih2 *)
-let ih_inter ih1 ih2 =
- let ih' = IH.copy ih1 in
- IH.iter (fun id vi ->
- if not(IH.mem ih2 id) then
- IH.remove ih' id else
- ()) ih1;
- ih'
-
-let ih_union ih1 ih2 =
- let ih' = IH.copy ih1 in
- IH.iter (fun id vi ->
- if not(IH.mem ih' id)
- then IH.add ih' id vi
- else ()) ih2;
- ih'
-
-(* Lookup varinfo in iosh. If the set contains None
- or is not a singleton, return None, otherwise
- return Some of the singleton *)
-(* IOS.t IH.t -> varinfo -> int option *)
-let iosh_singleton_lookup iosh vi =
- if IH.mem iosh vi.vid then
- let ios = IH.find iosh vi.vid in
- if not (IOS.cardinal ios = 1) then None
- else IOS.choose ios
- else None
-
-(* IOS.t IH.t -> varinfo -> IOS.t *)
-let iosh_lookup iosh vi =
- if IH.mem iosh vi.vid
- then Some(IH.find iosh vi.vid)
- else None
-
-(* return Some(vid) if iosh contains defId.
- return None otherwise *)
-(* IOS.t IH.t -> int -> int option *)
-let iosh_defId_find iosh defId =
- (* int -> IOS.t -> int option -> int option*)
- let get_vid vid ios io =
- match io with
- Some(i) -> Some(i)
- | None ->
- let there = IOS.exists
- (function None -> false
- | Some(i') -> defId = i') ios in
- if there then Some(vid) else None
- in
- IH.fold get_vid iosh None
-
-(* The resulting iosh will contain the
- union of the same entries from iosh1 and
- iosh2. If iosh1 has an entry that iosh2
- does not, then the result will contain
- None in addition to the things from the
- entry in iosh1. *)
-(* XXX this function is a performance bottleneck *)
-let iosh_combine iosh1 iosh2 =
- let iosh' = IH.copy iosh1 in
- IH.iter (fun id ios1 ->
- try let ios2 = IH.find iosh2 id in
- let newset = IOS.union ios1 ios2 in
- IH.replace iosh' id newset;
- with Not_found ->
- let newset = IOS.add None ios1 in
- IH.replace iosh' id newset) iosh1;
- IH.iter (fun id ios2 ->
- if not(IH.mem iosh1 id) then
- let newset = IOS.add None ios2 in
- IH.add iosh' id newset) iosh2;
- iosh'
-
-
-(* determine if two IOS.t IH.t s are the same *)
-let iosh_equals iosh1 iosh2 =
-(* if IH.length iosh1 = 0 && not(IH.length iosh2 = 0) ||
- IH.length iosh2 = 0 && not(IH.length iosh1 = 0)*)
- if not(IH.length iosh1 = IH.length iosh2)
- then
- (if !debug then ignore(E.log "iosh_equals: length not same\n");
- false)
- else
- IH.fold (fun vid ios b ->
- if not b then b else
- try let ios2 = IH.find iosh2 vid in
- if not(IOS.compare ios ios2 = 0) then
- (if !debug then ignore(E.log "iosh_equals: sets for vid %d not equal\n" vid);
- false)
- else true
- with Not_found ->
- (if !debug then ignore(E.log "iosh_equals: vid %d not in iosh2\n" vid);
- false)) iosh1 true
-
-(* replace an entire set with a singleton.
- if nothing was there just add the singleton *)
-(* IOS.t IH.t -> int -> varinfo -> unit *)
-let iosh_replace iosh i vi =
- if IH.mem iosh vi.vid then
- let newset = IOS.singleton (Some i) in
- IH.replace iosh vi.vid newset
- else
- let newset = IOS.singleton (Some i) in
- IH.add iosh vi.vid newset
-
-(* remove definitions that are killed.
- add definitions that are gend *)
-(* Takes the defs, the data, and a function for
- obtaining the next def id *)
-(* VS.t -> IOS.t IH.t -> (unit->int) -> unit *)
-let proc_defs vs iosh f =
- let pd vi =
- let newi = f() in
- (*if !debug then
- ignore (E.log "proc_defs: genning %d\n" newi);*)
- iosh_replace iosh newi vi
- in
- UD.VS.iter pd vs
-
-let idMaker () start =
- let counter = ref start in
- fun () ->
- let ret = !counter in
- counter := !counter + 1;
- ret
-
-(* given reaching definitions into a list of
- instructions, figure out the definitions that
- reach in/out of each instruction *)
-(* if out is true then calculate the definitions that
- go out of each instruction, if it is false then
- calculate the definitions reaching into each instruction *)
-(* instr list -> int -> (varinfo IH.t * int) -> bool -> (varinfo IH.t * int) list *)
-let iRDsHtbl = Hashtbl.create 128
-let instrRDs il sid (ivih, s, iosh) out =
- if Hashtbl.mem iRDsHtbl (sid,out) then Hashtbl.find iRDsHtbl (sid,out) else
-
-(* let print_instr i (_,s', iosh') = *)
-(* let d = d_instr () i ++ line in *)
-(* fprint stdout 80 d; *)
-(* flush stdout *)
-(* in *)
-
- let proc_one hil i =
- match hil with
- | [] ->
- let _, defd = UD.computeUseDefInstr i in
- if UD.VS.is_empty defd
- then ((*if !debug then print_instr i ((), s, iosh);*)
- [((), s, iosh)])
- else
- let iosh' = IH.copy iosh in
- proc_defs defd iosh' (idMaker () s);
- (*if !debug then
- print_instr i ((), s + UD.VS.cardinal defd, iosh');*)
- ((), s + UD.VS.cardinal defd, iosh')::hil
- | (_, s', iosh')::hrst as l ->
- let _, defd = UD.computeUseDefInstr i in
- if UD.VS.is_empty defd
- then
- ((*if !debug then
- print_instr i ((),s', iosh');*)
- ((), s', iosh')::l)
- else let iosh'' = IH.copy iosh' in
- proc_defs defd iosh'' (idMaker () s');
- (*if !debug then
- print_instr i ((), s' + UD.VS.cardinal defd, iosh'');*)
- ((),s' + UD.VS.cardinal defd, iosh'')::l
- in
- let folded = List.fold_left proc_one [((),s,iosh)] il in
- let foldedout = List.tl (List.rev folded) in
- let foldednotout = List.rev (List.tl folded) in
- Hashtbl.add iRDsHtbl (sid,true) foldedout;
- Hashtbl.add iRDsHtbl (sid,false) foldednotout;
- if out then foldedout else foldednotout
-
-
-
-(* The right hand side of an assignment is either
- a function call or an expression *)
-type rhs = RDExp of exp | RDCall of instr
-
-(* take the id number of a definition and return
- the rhs of the definition if there is one.
- Returns None if, for example, the definition is
- caused by an assembly instruction *)
-(* stmt IH.t -> (()*int*IOS.t IH.t) IH.t -> int -> (rhs * int * IOS.t IH.t) option *)
-let rhsHtbl = IH.create 64 (* to avoid recomputation *)
-let getDefRhs didstmh stmdat defId =
- if IH.mem rhsHtbl defId then IH.find rhsHtbl defId else
- let stm =
- try IH.find didstmh defId
- with Not_found -> E.s (E.error "getDefRhs: defId %d not found\n" defId) in
- let (_,s,iosh) =
- try IH.find stmdat stm.sid
- with Not_found -> E.s (E.error "getDefRhs: sid %d not found \n" stm.sid) in
- match stm.skind with
- Instr il ->
- let ivihl = instrRDs il stm.sid ((),s,iosh) true in (* defs that reach out of each instr *)
- let ivihl_in = instrRDs il stm.sid ((),s,iosh) false in (* defs that reach into each instr *)
- let iihl = List.combine (List.combine il ivihl) ivihl_in in
- (try let ((i,(_,_,diosh)),(_,_,iosh_in)) = List.find (fun ((i,(_,_,iosh')),_) ->
- match S.time "iosh_defId_find" (iosh_defId_find iosh') defId with
- Some vid ->
- (match i with
- Set((Var vi',NoOffset),_,_) -> vi'.vid = vid (* _ -> NoOffset *)
- | Call(Some(Var vi',NoOffset),_,_,_) -> vi'.vid = vid (* _ -> NoOffset *)
- | Call(None,_,_,_) -> false
- | Asm(_,_,sll,_,_,_) -> List.exists
- (function (_,(Var vi',NoOffset)) -> vi'.vid = vid | _ -> false) sll
- | _ -> false)
- | None -> false) iihl in
- (match i with
- Set((lh,_),e,_) ->
- (match lh with
- Var(vi') ->
- (IH.add rhsHtbl defId (Some(RDExp(e),stm.sid,iosh_in));
- Some(RDExp(e), stm.sid, iosh_in))
- | _ -> E.s (E.error "Reaching Defs getDefRhs: right vi not first\n"))
- | Call(lvo,e,el,_) ->
- (IH.add rhsHtbl defId (Some(RDCall(i),stm.sid,iosh_in));
- Some(RDCall(i), stm.sid, iosh_in))
- | Asm(a,sl,slvl,sel,sl',_) -> None) (* ? *)
- with Not_found ->
- (if !debug then ignore (E.log "getDefRhs: No instruction defines %d\n" defId);
- IH.add rhsHtbl defId None;
- None))
- | _ -> E.s (E.error "getDefRhs: defining statement not an instruction list %d\n" defId)
- (*None*)
-
-let prettyprint didstmh stmdat () (_,s,iosh) = text ""
- (*seq line (fun (vid,ios) ->
- num vid ++ text ": " ++
- IOS.fold (fun io d -> match io with
- None -> d ++ text "None "
- | Some i ->
- let stm = IH.find didstmh i in
- match getDefRhs didstmh stmdat i with
- None -> d ++ num i
- | Some(RDExp(e),_,_) ->
- d ++ num i ++ text " " ++ (d_exp () e)
- | Some(RDCall(c),_,_) ->
- d ++ num i ++ text " " ++ (d_instr () c))
- ios nil)
- (IH.tolist iosh)*)
-
-module ReachingDef =
- struct
-
- let name = "Reaching Definitions"
-
- let debug = debug
-
- (* Should the analysis calculate may-reach
- or must-reach *)
- let mayReach = ref false
-
-
- (* An integer that tells the id number of
- the first definition *)
- (* Also a hash from variable ids to a set of
- definition ids that reach this statement.
- None means there is a path to this point on which
- there is no definition of the variable *)
- type t = (unit * int * IOS.t IH.t)
-
- let copy (_, i, iosh) = ((), i, IH.copy iosh)
-
- (* entries for starting statements must
- be added before calling compute *)
- let stmtStartData = IH.create 32
-
- (* a mapping from definition ids to
- the statement corresponding to that id *)
- let defIdStmtHash = IH.create 32
-
- (* mapping from statement ids to statements
- for better performance of ok_to_replace *)
- let sidStmtHash = IH.create 64
-
- (* pretty printer *)
- let pretty = prettyprint defIdStmtHash stmtStartData
-
-
- (* The first id to use when computeFirstPredecessor
- is next called *)
- let nextDefId = ref 0
-
- (* Count the number of variable definitions in
- a statement *)
- let num_defs stm =
- match stm.skind with
- Instr(il) -> List.fold_left (fun s i ->
- let _, d = UD.computeUseDefInstr i in
- s + UD.VS.cardinal d) 0 il
- | _ -> let _, d = UD.computeUseDefStmtKind stm.skind in
- UD.VS.cardinal d
-
- (* the first predecessor is just the data in along with
- the id of the first definition of the statement,
- which we get from nextDefId *)
- let computeFirstPredecessor stm (_, s, iosh) =
- let startDefId = max !nextDefId s in
- let numds = num_defs stm in
- let rec loop n =
- if n < 0
- then ()
- else
- (if !debug then
- ignore (E.log "RD: defId %d -> stm %d\n" (startDefId + n) stm.sid);
- IH.add defIdStmtHash (startDefId + n) stm;
- loop (n-1))
- in
- loop (numds - 1);
- nextDefId := startDefId + numds;
- ((), startDefId, IH.copy iosh)
-
-
- let combinePredecessors (stm:stmt) ~(old:t) ((_, s, iosh):t) =
- match old with (_, os, oiosh) ->
- if S.time "iosh_equals" (iosh_equals oiosh) iosh then None else
- Some((), os, S.time "iosh_combine" (iosh_combine oiosh) iosh)
-
- (* return an action that removes things that
- are redefinied and adds the generated defs *)
- let doInstr inst (_, s, iosh) =
- let transform (_, s', iosh') =
- let _, defd = UD.computeUseDefInstr inst in
- proc_defs defd iosh' (idMaker () s');
- ((), s' + UD.VS.cardinal defd, iosh')
- in
- DF.Post transform
-
- (* all the work gets done at the instruction level *)
- let doStmt stm (_, s, iosh) =
- if not(IH.mem sidStmtHash stm.sid) then
- IH.add sidStmtHash stm.sid stm;
- if !debug then ignore(E.log "RD: looking at %a\n" d_stmt stm);
- DF.SDefault
-
- let doGuard condition _ = DF.GDefault
-
- let filterStmt stm = true
-
-end
-
-module RD = DF.ForwardsDataFlow(ReachingDef)
-
-(* map all variables in vil to a set containing
- None in iosh *)
-(* IOS.t IH.t -> varinfo list -> () *)
-let iosh_none_fill iosh vil =
- List.iter (fun vi ->
- IH.add iosh vi.vid (IOS.singleton None))
- vil
-
-(* Computes the reaching definitions for a
- function. *)
-(* Cil.fundec -> unit *)
-let computeRDs fdec =
- try
- if compare fdec.svar.vname (!debug_fn) = 0 then
- (debug := true;
- ignore (E.log "%s =\n%a\n" (!debug_fn) d_block fdec.sbody));
- let bdy = fdec.sbody in
- let slst = bdy.bstmts in
- let _ = IH.clear ReachingDef.stmtStartData in
- let _ = IH.clear ReachingDef.defIdStmtHash in
- let _ = IH.clear rhsHtbl in
- let _ = Hashtbl.clear iRDsHtbl in
- let _ = ReachingDef.nextDefId := 0 in
- let fst_stm = List.hd slst in
- let fst_iosh = IH.create 32 in
- let _ = UD.onlyNoOffsetsAreDefs := false in
- (*let _ = iosh_none_fill fst_iosh fdec.sformals in*)
- let _ = IH.add ReachingDef.stmtStartData fst_stm.sid ((), 0, fst_iosh) in
- let _ = ReachingDef.computeFirstPredecessor fst_stm ((), 0, fst_iosh) in
- if !debug then
- ignore (E.log "computeRDs: fst_stm.sid=%d\n" fst_stm.sid);
- RD.compute [fst_stm];
- if compare fdec.svar.vname (!debug_fn) = 0 then
- debug := false
- (* now ReachingDef.stmtStartData has the reaching def data in it *)
- with Failure "hd" -> if compare fdec.svar.vname (!debug_fn) = 0 then
- debug := false
-
-(* return the definitions that reach the statement
- with statement id sid *)
-let getRDs sid =
- try
- Some (IH.find ReachingDef.stmtStartData sid)
- with Not_found ->
- None
-(* E.s (E.error "getRDs: sid %d not found\n" sid) *)
-
-let getDefIdStmt defid =
- try
- Some(IH.find ReachingDef.defIdStmtHash defid)
- with Not_found ->
- None
-
-let getStmt sid =
- try Some(IH.find ReachingDef.sidStmtHash sid)
- with Not_found -> None
-
-(* Pretty print the reaching definition data for
- a function *)
-let ppFdec fdec =
- seq line (fun stm ->
- let ivih = IH.find ReachingDef.stmtStartData stm.sid in
- ReachingDef.pretty () ivih) fdec.sbody.bstmts
-
-
-(* If this class is extended with a visitor on expressions,
- then the current rd data is available at each expression *)
-class rdVisitorClass = object (self)
- inherit nopCilVisitor
-
- (* the statement being worked on *)
- val mutable sid = -1
-
- (* if a list of instructions is being processed,
- then this is the corresponding list of
- reaching definitions *)
- val mutable rd_dat_lst = []
-
- (* these are the reaching defs for the current
- instruction if there is one *)
- val mutable cur_rd_dat = None
-
- method vstmt stm =
- sid <- stm.sid;
- match getRDs sid with
- None ->
- if !debug then ignore(E.log "rdVis: stm %d had no data\n" sid);
- cur_rd_dat <- None;
- DoChildren
- | Some(_,s,iosh) ->
- match stm.skind with
- Instr il ->
- if !debug then ignore(E.log "rdVis: visit il\n");
- rd_dat_lst <- instrRDs il stm.sid ((),s,iosh) false;
- DoChildren
- | _ ->
- if !debug then ignore(E.log "rdVis: visit non-il\n");
- cur_rd_dat <- None;
- DoChildren
-
- method vinst i =
- if !debug then ignore(E.log "rdVis: before %a, rd_dat_lst is %d long\n"
- d_instr i (List.length rd_dat_lst));
- try
- cur_rd_dat <- Some(List.hd rd_dat_lst);
- rd_dat_lst <- List.tl rd_dat_lst;
- DoChildren
- with Failure "hd" ->
- if !debug then ignore(E.log "rdVis: il rd_dat_lst mismatch\n");
- DoChildren
-
- method get_cur_iosh () =
- match cur_rd_dat with
- None -> (match getRDs sid with
- None -> None
- | Some(_,_,iosh) -> Some iosh)
- | Some(_,_,iosh) -> Some iosh
-
-end
-
diff --git a/cil/src/ext/sfi.ml b/cil/src/ext/sfi.ml
deleted file mode 100755
index 9886526cd91dcc3094b2c26856f1b5de84f137f9..0000000000000000000000000000000000000000
--- a/cil/src/ext/sfi.ml
+++ /dev/null
@@ -1,337 +0,0 @@
-(*
- *
- * Copyright (c) 2005,
- * George C. Necula <necula@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(** This is a module that inserts runtime checks for memory reads/writes and
- * allocations *)
-
-open Pretty
-open Cil
-module E = Errormsg
-module H = Hashtbl
-
-let doSfi = ref false
-let doSfiReads = ref false
-let doSfiWrites = ref true
-
-(* A number of functions to be skipped *)
-let skipFunctions : (string, unit) H.t = H.create 13
-let mustSfiFunction (f: fundec) : bool =
- not (H.mem skipFunctions f.svar.vname)
-
-(** Some functions are known to be allocators *)
-type dataLocation =
- InResult (* Interesting data is in the return value *)
- | InArg of int (* in the nth argument. Starts from 1. *)
- | InArgTimesArg of int * int (* (for size) data is the product of two
- * arguments *)
- | PointedToByArg of int (* pointed to by nth argument *)
-
-(** Compute the data based on the location and the actual argument list *)
-let extractData (dl: dataLocation) (args: exp list) (res: lval option) : exp =
- let getArg (n: int) =
- try List.nth args (n - 1) (* Args are based at 1 *)
- with _ -> E.s (E.bug "Cannot extract argument %d at %a"
- n d_loc !currentLoc)
- in
- match dl with
- InResult -> begin
- match res with
- None ->
- E.s (E.bug "Cannot extract InResult data (at %a)" d_loc !currentLoc)
- | Some r -> Lval r
- end
- | InArg n -> getArg n
- | InArgTimesArg (n1, n2) ->
- let a1 = getArg n1 in
- let a2 = getArg n2 in
- BinOp(Mult, mkCast ~e:a1 ~newt:longType,
- mkCast ~e:a2 ~newt:longType, longType)
- | PointedToByArg n ->
- let a = getArg n in
- Lval (mkMem a NoOffset)
-
-
-
-(* for each allocator, where is the length and where is the result *)
-let allocators: (string, (dataLocation * dataLocation)) H.t = H.create 13
-let _ =
- H.add allocators "malloc" (InArg 1, InResult);
- H.add allocators "calloc" (InArgTimesArg (1, 2), InResult);
- H.add allocators "realloc" (InArg 2, InResult)
-
-(* for each deallocator, where is the data being deallocated *)
-let deallocators: (string, dataLocation) H.t = H.create 13
-let _=
- H.add deallocators "free" (InArg 1);
- H.add deallocators "realloc" (InArg 1)
-
-(* Returns true if the given lvalue offset ends in a bitfield access. *)
-let rec is_bitfield lo = match lo with
- | NoOffset -> false
- | Field(fi,NoOffset) -> not (fi.fbitfield = None)
- | Field(_,lo) -> is_bitfield lo
- | Index(_,lo) -> is_bitfield lo
-
-(* Return an expression that evaluates to the address of the given lvalue.
- * For most lvalues, this is merely AddrOf(lv). However, for bitfields
- * we do some offset gymnastics.
- *)
-let addr_of_lv (lv: lval) =
- let lh, lo = lv in
- if is_bitfield lo then begin
- (* we figure out what the address would be without the final bitfield
- * access, and then we add in the offset of the bitfield from the
- * beginning of its enclosing comp *)
- let rec split_offset_and_bitfield lo = match lo with
- | NoOffset -> failwith "logwrites: impossible"
- | Field(fi,NoOffset) -> (NoOffset,fi)
- | Field(e,lo) -> let a,b = split_offset_and_bitfield lo in
- ((Field(e,a)),b)
- | Index(e,lo) -> let a,b = split_offset_and_bitfield lo in
- ((Index(e,a)),b)
- in
- let new_lv_offset, bf = split_offset_and_bitfield lo in
- let new_lv = (lh, new_lv_offset) in
- let enclosing_type = TComp(bf.fcomp, []) in
- let bits_offset, bits_width =
- bitsOffset enclosing_type (Field(bf,NoOffset)) in
- let bytes_offset = bits_offset / 8 in
- let lvPtr = mkCast ~e:(mkAddrOf (new_lv)) ~newt:(charPtrType) in
- (BinOp(PlusPI, lvPtr, (integer bytes_offset), ulongType))
- end else
- (mkAddrOf (lh,lo))
-
-
-let mustLogLval (forwrite: bool) (lv: lval) : bool =
- match lv with
- Var v, off -> (* Inside a variable. We assume the array offsets are fine *)
- false
- | Mem e, off ->
- if forwrite && not !doSfiWrites then
- false
- else if not forwrite && not !doSfiReads then
- false
-
- (* If this is an lval of function type, we do not log it *)
- else if isFunctionType (typeOfLval lv) then
- false
- else
- true
-
-(* Create prototypes for the logging functions *)
-let mkProto (name: string) (args: (string * typ * attributes) list) =
- let fdec = emptyFunction name in
- fdec.svar.vtype <- TFun(voidType,
- Some args, false, []);
- fdec
-
-
-let logReads = mkProto "logRead" [ ("addr", voidPtrType, []);
- ("what", charPtrType, []);
- ("file", charPtrType, []);
- ("line", intType, []) ]
-let callLogRead (lv: lval) =
- let what = Pretty.sprint 80 (d_lval () lv) in
- Call(None,
- Lval(Var(logReads.svar),NoOffset),
- [ addr_of_lv lv; mkString what; mkString !currentLoc.file;
- integer !currentLoc.line], !currentLoc )
-
-let logWrites = mkProto "logWrite" [ ("addr", voidPtrType, []);
- ("what", charPtrType, []);
- ("file", charPtrType, []);
- ("line", intType, []) ]
-let callLogWrite (lv: lval) =
- let what = Pretty.sprint 80 (d_lval () lv) in
- Call(None,
- Lval(Var(logWrites.svar), NoOffset),
- [ addr_of_lv lv; mkString what; mkString !currentLoc.file;
- integer !currentLoc.line], !currentLoc )
-
-let logStackFrame = mkProto "logStackFrame" [ ("func", charPtrType, []) ]
-let callLogStack (fname: string) =
- Call(None,
- Lval(Var(logStackFrame.svar), NoOffset),
- [ mkString fname; ], !currentLoc )
-
-let logAlloc = mkProto "logAlloc" [ ("addr", voidPtrType, []);
- ("size", intType, []);
- ("file", charPtrType, []);
- ("line", intType, []) ]
-let callLogAlloc (szloc: dataLocation)
- (resLoc: dataLocation)
- (args: exp list)
- (res: lval option) =
- let sz = extractData szloc args res in
- let res = extractData resLoc args res in
- Call(None,
- Lval(Var(logAlloc.svar), NoOffset),
- [ res; sz; mkString !currentLoc.file;
- integer !currentLoc.line ], !currentLoc )
-
-
-let logFree = mkProto "logFree" [ ("addr", voidPtrType, []);
- ("file", charPtrType, []);
- ("line", intType, []) ]
-let callLogFree (dataloc: dataLocation)
- (args: exp list)
- (res: lval option) =
- let data = extractData dataloc args res in
- Call(None,
- Lval(Var(logFree.svar), NoOffset),
- [ data; mkString !currentLoc.file;
- integer !currentLoc.line ], !currentLoc )
-
-class sfiVisitorClass : Cil.cilVisitor = object (self)
- inherit nopCilVisitor
-
- method vexpr (e: exp) : exp visitAction =
- match e with
- Lval lv when mustLogLval false lv -> (* A read *)
- self#queueInstr [ callLogRead lv ];
- DoChildren
-
- | _ -> DoChildren
-
-
- method vinst (i: instr) : instr list visitAction =
- match i with
- Set(lv, e, l) when mustLogLval true lv ->
- self#queueInstr [ callLogWrite lv ];
- DoChildren
-
- | Call(lvo, f, args, l) ->
- (* Instrument the write *)
- (match lvo with
- Some lv when mustLogLval true lv ->
- self#queueInstr [ callLogWrite lv ]
- | _ -> ());
- (* Do the expressions in the call, and then see if we need to
- * instrument the function call *)
- ChangeDoChildrenPost
- ([i],
- (fun il ->
- currentLoc := l;
- match f with
- Lval (Var fv, NoOffset) -> begin
- (* Is it an allocator? *)
- try
- let szloc, resloc = H.find allocators fv.vname in
- il @ [callLogAlloc szloc resloc args lvo]
- with Not_found -> begin
- (* Is it a deallocator? *)
- try
- let resloc = H.find deallocators fv.vname in
- il @ [ callLogFree resloc args lvo ]
- with Not_found ->
- il
- end
- end
- | _ -> il))
-
- | _ -> DoChildren
-
- method vfunc (fdec: fundec) =
- (* Instead a stack log at the start of a function *)
- ChangeDoChildrenPost
- (fdec,
- fun fdec ->
- fdec.sbody <-
- mkBlock
- [ mkStmtOneInstr (callLogStack fdec.svar.vname);
- mkStmt (Block fdec.sbody) ];
- fdec)
-
-end
-
-let doit (f: file) =
- let sfiVisitor = new sfiVisitorClass in
- let compileLoc (l: location) = function
- ACons("inres", []) -> InResult
- | ACons("inarg", [AInt n]) -> InArg n
- | ACons("inargxarg", [AInt n1; AInt n2]) -> InArgTimesArg (n1, n2)
- | ACons("pointedby", [AInt n]) -> PointedToByArg n
- | _ -> E.warn "Invalid location at %a" d_loc l;
- InResult
- in
- iterGlobals f
- (fun glob ->
- match glob with
- GFun(fdec, _) when mustSfiFunction fdec ->
- ignore (visitCilFunction sfiVisitor fdec)
- | GPragma(Attr("sfiignore", al), l) ->
- List.iter
- (function AStr fn -> H.add skipFunctions fn ()
- | _ -> E.warn "Invalid argument in \"sfiignore\" pragma at %a"
- d_loc l)
- al
-
- | GPragma(Attr("sfialloc", al), l) -> begin
- match al with
- AStr fname :: locsz :: locres :: [] ->
- H.add allocators fname (compileLoc l locsz, compileLoc l locres)
- | _ -> E.warn "Invalid sfialloc pragma at %a" d_loc l
- end
-
- | GPragma(Attr("sfifree", al), l) -> begin
- match al with
- AStr fname :: locwhat :: [] ->
- H.add deallocators fname (compileLoc l locwhat)
- | _ -> E.warn "Invalid sfifree pragma at %a" d_loc l
- end
-
-
- | _ -> ());
- (* Now add the prototypes for the instrumentation functions *)
- f.globals <-
- GVarDecl (logReads.svar, locUnknown) ::
- GVarDecl (logWrites.svar, locUnknown) ::
- GVarDecl (logStackFrame.svar, locUnknown) ::
- GVarDecl (logAlloc.svar, locUnknown) ::
- GVarDecl (logFree.svar, locUnknown) :: f.globals
-
-
-let feature : featureDescr =
- { fd_name = "sfi";
- fd_enabled = doSfi;
- fd_description = "instrument memory operations";
- fd_extraopt = [
- "--sfireads", Arg.Set doSfiReads, "SFI for reads";
- "--sfiwrites", Arg.Set doSfiWrites, "SFI for writes";
- ];
- fd_doit = doit;
- fd_post_check = true;
- }
-
diff --git a/cil/src/ext/simplemem.ml b/cil/src/ext/simplemem.ml
deleted file mode 100644
index 1b27815c3061829c747ed7b979bcb25b0fb511e0..0000000000000000000000000000000000000000
--- a/cil/src/ext/simplemem.ml
+++ /dev/null
@@ -1,132 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(*
- * Simplemem: Transform a program so that all memory expressions are
- * "simple". Introduce well-typed temporaries to hold intermediate values
- * for expressions that would normally involve more than one memory
- * reference.
- *
- * If simplemem succeeds, each lvalue should contain only one Mem()
- * constructor.
- *)
-open Cil
-
-(* current context: where should we put our temporaries? *)
-let thefunc = ref None
-
-(* build up a list of assignments to temporary variables *)
-let assignment_list = ref []
-
-(* turn "int a[5][5]" into "int ** temp" *)
-let rec array_to_pointer tau =
- match unrollType tau with
- TArray(dest,_,al) -> TPtr(array_to_pointer dest,al)
- | _ -> tau
-
-(* create a temporary variable in the current function *)
-let make_temp tau =
- let tau = array_to_pointer tau in
- match !thefunc with
- Some(fundec) -> makeTempVar fundec ~name:("mem_") tau
- | None -> failwith "simplemem: temporary needed outside a function"
-
-(* separate loffsets into "scalar addition parts" and "memory parts" *)
-let rec separate_loffsets lo =
- match lo with
- NoOffset -> NoOffset, NoOffset
- | Field(fi,rest) ->
- let s,m = separate_loffsets rest in
- Field(fi,s) , m
- | Index(_) -> NoOffset, lo
-
-(* Recursively decompose the lvalue so that what is under a "Mem()"
- * constructor is put into a temporary variable. *)
-let rec handle_lvalue (lb,lo) =
- let s,m = separate_loffsets lo in
- match lb with
- Var(vi) ->
- handle_loffset (lb,s) m
- | Mem(Lval(Var(_),NoOffset)) ->
- (* special case to avoid generating "tmp = ptr;" *)
- handle_loffset (lb,s) m
- | Mem(e) ->
- begin
- let new_vi = make_temp (typeOf e) in
- assignment_list := (Set((Var(new_vi),NoOffset),e,!currentLoc))
- :: !assignment_list ;
- handle_loffset (Mem(Lval(Var(new_vi),NoOffset)),NoOffset) lo
- end
-and handle_loffset lv lo =
- match lo with
- NoOffset -> lv
- | Field(f,o) -> handle_loffset (addOffsetLval (Field(f,NoOffset)) lv) o
- | Index(exp,o) -> handle_loffset (addOffsetLval (Index(exp,NoOffset)) lv) o
-
-(* the transformation is implemented as a Visitor *)
-class simpleVisitor = object
- inherit nopCilVisitor
-
- method vfunc fundec = (* we must record the current context *)
- thefunc := Some(fundec) ;
- DoChildren
-
- method vlval lv = ChangeDoChildrenPost(lv,
- (fun lv -> handle_lvalue lv))
-
- method unqueueInstr () =
- let result = List.rev !assignment_list in
- assignment_list := [] ;
- result
-end
-
-(* Main entry point: apply the transformation to a file *)
-let simplemem (f : file) =
- try
- visitCilFileSameGlobals (new simpleVisitor) f;
- f
- with e -> Printf.printf "Exception in Simplemem.simplemem: %s\n"
- (Printexc.to_string e) ; raise e
-
-let feature : featureDescr =
- { fd_name = "simpleMem";
- fd_enabled = Cilutil.doSimpleMem;
- fd_description = "simplify all memory expressions" ;
- fd_extraopt = [];
- fd_doit = (function (f: file) -> ignore (simplemem f)) ;
- fd_post_check = true;
- }
diff --git a/cil/src/ext/simplify.ml b/cil/src/ext/simplify.ml
deleted file mode 100755
index 776d491633f8288f3bd3b061adbf2720cf28d7d6..0000000000000000000000000000000000000000
--- a/cil/src/ext/simplify.ml
+++ /dev/null
@@ -1,845 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * Sumit Gulwani <gulwani@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* This module simplifies the expressions in a program in the following ways:
-
-1. All expressions are either
-
- basic::=
- Const _
- Addrof(Var v, NoOffset)
- StartOf(Var v, NoOffset)
- Lval(Var v, off), where v is a variable whose address is not taken
- and off contains only "basic"
-
- exp::=
- basic
- Lval(Mem basic, NoOffset)
- BinOp(bop, basic, basic)
- UnOp(uop, basic)
- CastE(t, basic)
-
- lval ::=
- Mem basic, NoOffset
- Var v, off, where v is a variable whose address is not taken and off
- contains only "basic"
-
- - all sizeof and alignof are turned into constants
- - accesses to variables whose address is taken is turned into "Mem" accesses
- - same for accesses to arrays
- - all field and index computations are turned into address arithmetic,
- including bitfields.
-
-*)
-
-
-open Pretty
-open Cil
-module E = Errormsg
-module H = Hashtbl
-
-type taExp = exp (* Three address expression *)
-type bExp = exp (* Basic expression *)
-
-let debug = true
-
-(* Whether to split structs *)
-let splitStructs = ref true
-
-let onlyVariableBasics = ref false
-let noStringConstantsBasics = ref false
-
-exception BitfieldAccess
-
-(* Turn an expression into a three address expression (and queue some
- * instructions in the process) *)
-let rec makeThreeAddress
- (setTemp: taExp -> bExp) (* Given an expression save it into a temp and
- * return that temp *)
- (e: exp) : taExp =
- match e with
- SizeOf _ | SizeOfE _ | AlignOf _ | AlignOfE _ | SizeOfStr _ ->
- constFold true e
- | Const _ -> e
- | AddrOf (Var _, NoOffset) -> e
- | Lval lv -> Lval (simplifyLval setTemp lv)
- | BinOp(bo, e1, e2, tres) ->
- BinOp(bo, makeBasic setTemp e1, makeBasic setTemp e2, tres)
- | UnOp(uo, e1, tres) ->
- UnOp(uo, makeBasic setTemp e1, tres)
- | CastE(t, e) ->
- CastE(t, makeBasic setTemp e)
- | AddrOf lv -> begin
- match simplifyLval setTemp lv with
- Mem a, NoOffset -> a
- | _ -> (* This is impossible, because we are taking the address
- * of v and simplifyLval should turn it into a Mem, except if the
- * sizeof has failed. *)
- E.s (bug "Simplify: makeThreeAddress for AddrOf(LV=%a, LVT=%a)"
- d_lval lv d_type (typeOfLval lv))
- end
- | StartOf lv ->
- makeThreeAddress setTemp (AddrOf (addOffsetLval (Index(zero, NoOffset))
- lv))
-
-(* Make a basic expression *)
-and makeBasic (setTemp: taExp -> bExp) (e: exp) : bExp =
- let dump = false (* !currentLoc.line = 395 *) in
- if dump then
- ignore (E.log "makeBasic %a\n" d_plainexp e);
- (* Make it a three address expression first *)
- let e' = makeThreeAddress setTemp e in
- if dump then
- ignore (E.log " e'= %a\n" d_plainexp e);
- (* See if it is a basic one *)
- match e' with
- | Lval (Var _, _) -> e'
- | Const _ | AddrOf (Var _, NoOffset) | StartOf (Var _, NoOffset) ->
- if !onlyVariableBasics then setTemp e' else e'
- | SizeOf _ | SizeOfE _ | AlignOf _ | AlignOfE _ | SizeOfStr _ ->
- E.s (bug "Simplify: makeBasic found SizeOf: %a" d_exp e')
-
- (* We cannot make a function to be Basic, unless it actually is a variable
- * already. If this is a function pointer the best we can do is to make
- * the address of the function basic *)
- | Lval (Mem a, NoOffset) when isFunctionType (typeOf e') ->
- if dump then
- ignore (E.log " a function type\n");
- let a' = makeBasic setTemp a in
- Lval (Mem a', NoOffset)
-
- | _ -> setTemp e' (* Put it into a temporary otherwise *)
-
-
-and simplifyLval
- (setTemp: taExp -> bExp)
- (lv: lval) : lval =
- (* Add, watching for a zero *)
- let add (e1: exp) (e2: exp) =
- if isZero e2 then e1 else BinOp(PlusA, e1, e2, !upointType)
- in
- (* Convert an offset to an integer, and possibly a residual bitfield offset*)
- let rec offsetToInt
- (t: typ) (* The type of the host *)
- (off: offset) : exp * offset =
- match off with
- NoOffset -> zero, NoOffset
- | Field(fi, off') -> begin
- let start =
- try
- let start, _ = bitsOffset t (Field(fi, NoOffset)) in
- start
- with SizeOfError (whystr, t') ->
- E.s (E.bug "%a: Cannot compute sizeof: %s: %a"
- d_loc !currentLoc whystr d_type t')
- in
- if start land 7 <> 0 then begin
- (* We have a bitfield *)
- assert (off' = NoOffset);
- zero, Field(fi, off')
- end else begin
- let next, restoff = offsetToInt fi.ftype off' in
- add (integer (start / 8)) next, restoff
- end
- end
- | Index(ei, off') -> begin
- let telem = match unrollType t with
- TArray(telem, _, _) -> telem
- | _ -> E.s (bug "Simplify: simplifyLval: index on a non-array")
- in
- let next, restoff = offsetToInt telem off' in
- add
- (BinOp(Mult, ei, SizeOf telem, !upointType))
- next,
- restoff
- end
- in
- let tres = TPtr(typeOfLval lv, []) in
- match lv with
- Mem a, off ->
- let offidx, restoff = offsetToInt (typeOfLval (Mem a, NoOffset)) off in
- let a' =
- if offidx <> zero then
- add (mkCast a !upointType) offidx
- else
- a
- in
- let a' = makeBasic setTemp a' in
- Mem (mkCast a' tres), restoff
-
- | Var v, off when v.vaddrof -> (* We are taking this variable's address *)
- let offidx, restoff = offsetToInt v.vtype off in
- (* We cannot call makeBasic recursively here, so we must do it
- * ourselves *)
- let a = mkAddrOrStartOf (Var v, NoOffset) in
- let a' =
- if offidx = zero then a else
- add (mkCast a !upointType) (makeBasic setTemp offidx)
- in
- let a' = setTemp a' in
- Mem (mkCast a' tres), restoff
-
- | Var v, off ->
- (Var v, simplifyOffset setTemp off)
-
-
-(* Simplify an offset and make sure it has only three address expressions in
- * indices *)
-and simplifyOffset (setTemp: taExp -> bExp) = function
- NoOffset -> NoOffset
- | Field(fi, off) -> Field(fi, simplifyOffset setTemp off)
- | Index(ei, off) ->
- let ei' = makeBasic setTemp ei in
- Index(ei', simplifyOffset setTemp off)
-
-
-
-
-(** This is a visitor that will turn all expressions into three address code *)
-class threeAddressVisitor (fi: fundec) = object (self)
- inherit nopCilVisitor
-
- method private makeTemp (e1: exp) : exp =
- let t = makeTempVar fi (typeOf e1) in
- (* Add this instruction before the current statement *)
- self#queueInstr [Set(var t, e1, !currentLoc)];
- Lval(var t)
-
- (* We'll ensure that this gets called only for top-level expressions
- * inside functions. We must turn them into three address code. *)
- method vexpr (e: exp) =
- let e' = makeThreeAddress self#makeTemp e in
- ChangeTo e'
-
-
- (** We want the argument in calls to be simple variables *)
- method vinst (i: instr) =
- match i with
- Call (someo, f, args, loc) ->
- let someo' =
- match someo with
- Some lv -> Some (simplifyLval self#makeTemp lv)
- | _ -> None
- in
- let f' = makeBasic self#makeTemp f in
- let args' = List.map (makeBasic self#makeTemp) args in
- ChangeTo [ Call (someo', f', args', loc) ]
- | _ -> DoChildren
-
- (* This method will be called only on top-level "lvals" (those on the
- * left of assignments and function calls) *)
- method vlval (lv: lval) =
- ChangeTo (simplifyLval self#makeTemp lv)
-end
-
-(********************
- Next is an old version of the code that was splitting structs into
- * variables. It was not working on variables that are arguments or returns
- * of function calls.
-(** This is a visitor that splits structured variables into separate
- * variables. *)
-let isStructType (t: typ): bool =
- match unrollType t with
- TComp (ci, _) -> ci.cstruct
- | _ -> false
-
-(* Keep track of how we change the variables. For each variable id we keep a
- * hash table that maps an offset (a sequence of fieldinfo) into a
- * replacement variable. We also keep track of the splittable vars: those
- * with structure type but whose address is not take and which do not appear
- * as the argument to a Return *)
-let splittableVars: (int, unit) H.t = H.create 13
-let replacementVars: (int * offset, varinfo) H.t = H.create 13
-
-let findReplacement (fi: fundec) (v: varinfo) (off: offset) : varinfo =
- try
- H.find replacementVars (v.vid, off)
- with Not_found -> begin
- let t = typeOfLval (Var v, off) in
- (* make a name for this variable *)
- let rec mkName = function
- | Field(fi, off) -> "_" ^ fi.fname ^ mkName off
- | _ -> ""
- in
- let v' = makeTempVar fi ~name:(v.vname ^ mkName off ^ "_") t in
- H.add replacementVars (v.vid, off) v';
- if debug then
- ignore (E.log "Simplify: %s (%a) replace %a with %s\n"
- fi.svar.vname
- d_loc !currentLoc
- d_lval (Var v, off)
- v'.vname);
- v'
- end
-
- (* Now separate the offset into a sequence of field accesses and the
- * rest of the offset *)
-let rec separateOffset (off: offset): offset * offset =
- match off with
- NoOffset -> NoOffset, NoOffset
- | Field(fi, off') when fi.fcomp.cstruct ->
- let off1, off2 = separateOffset off' in
- Field(fi, off1), off2
- | _ -> NoOffset, off
-
-
-class splitStructVisitor (fi: fundec) = object (self)
- inherit nopCilVisitor
-
- method vlval (lv: lval) =
- match lv with
- Var v, off when H.mem splittableVars v.vid ->
- (* The type of this lval better not be a struct *)
- if isStructType (typeOfLval lv) then
- E.s (unimp "Simplify: found lval of struct type %a : %a\n"
- d_lval lv d_type (typeOfLval lv));
- let off1, restoff = separateOffset off in
- let lv' =
- if off1 <> NoOffset then begin
- (* This is a splittable variable and we have an offset that makes
- * it a scalar. Find the replacement variable for this *)
- let v' = findReplacement fi v off1 in
- if restoff = NoOffset then
- Var v', NoOffset
- else (* We have some more stuff. Use Mem *)
- Mem (mkAddrOrStartOf (Var v', NoOffset)), restoff
- end else begin (* off1 = NoOffset *)
- if restoff = NoOffset then
- E.s (bug "Simplify: splitStructVisitor:lval")
- else
- simplifyLval
- (fun e1 ->
- let t = makeTempVar fi (typeOf e1) in
- (* Add this instruction before the current statement *)
- self#queueInstr [Set(var t, e1, !currentLoc)];
- Lval(var t))
- (Mem (mkAddrOrStartOf (Var v, NoOffset)), restoff)
- end
- in
- ChangeTo lv'
-
- | _ -> DoChildren
-
- method vinst (i: instr) =
- (* Accumulate to the list of instructions a number of assignments of
- * non-splittable lvalues *)
- let rec accAssignment (ci: compinfo) (dest: lval) (what: lval)
- (acc: instr list) : instr list =
- List.fold_left
- (fun acc f ->
- let dest' = addOffsetLval (Field(f, NoOffset)) dest in
- let what' = addOffsetLval (Field(f, NoOffset)) what in
- match unrollType f.ftype with
- TComp(ci, _) when ci.cstruct ->
- accAssignment ci dest' what' acc
- | TArray _ -> (* We must copy the array *)
- (Set((Mem (AddrOf dest'), NoOffset),
- Lval (Mem (AddrOf what'), NoOffset), !currentLoc)) :: acc
- | _ -> (* If the type of f is not a struct then leave this alone *)
- (Set(dest', Lval what', !currentLoc)) :: acc)
- acc
- ci.cfields
- in
- let doAssignment (ci: compinfo) (dest: lval) (what: lval) : instr list =
- let il' = accAssignment ci dest what [] in
- List.concat (List.map (visitCilInstr (self :> cilVisitor)) il')
- in
- match i with
- Set(((Var v, off) as lv), what, _) when H.mem splittableVars v.vid ->
- let off1, restoff = separateOffset off in
- if restoff <> NoOffset then (* This means that we are only assigning
- * part of a replacement variable. Leave
- * this alone because the vlval will take
- * care of it *)
- DoChildren
- else begin
- (* The type of the replacement has to be a structure *)
- match unrollType (typeOfLval lv) with
- TComp (ci, _) when ci.cstruct ->
- (* The assigned thing better be an lvalue *)
- let whatlv =
- match what with
- Lval lv -> lv
- | _ -> E.s (unimp "Simplify: assigned struct is not lval")
- in
- ChangeTo (doAssignment ci (Var v, off) whatlv)
-
- | _ -> (* vlval will take care of it *)
- DoChildren
- end
-
- | Set(dest, Lval (Var v, off), _) when H.mem splittableVars v.vid ->
- let off1, restoff = separateOffset off in
- if restoff <> NoOffset then (* vlval will do this *)
- DoChildren
- else begin
- (* The type of the replacement has to be a structure *)
- match unrollType (typeOfLval dest) with
- TComp (ci, _) when ci.cstruct ->
- ChangeTo (doAssignment ci dest (Var v, off))
-
- | _ -> (* vlval will take care of it *)
- DoChildren
- end
-
- | _ -> DoChildren
-
-end
-*)
-
-(* Whether to split the arguments of functions *)
-let splitArguments = true
-
-(* Whether we try to do the splitting all in one pass. The advantage is that
- * it is faster and it generates nicer names *)
-let lu = locUnknown
-
-(* Go over the code and split some temporary variables of stucture type into
- * several separate variables. The hope is that the compiler will have an
- * easier time to do standard optimizations with the resulting scalars *)
-(* Unfortunately, implementing this turns out to be more complicated than I
- * thought *)
-
-(** Iterate over the fields of a structured type. Returns the empty list if
- * no splits. The offsets are in order in which they appear in the structure
- * type. Along with the offset we pass a string that identifies the
- * meta-component, and the type of that component. *)
-let rec foldRightStructFields
- (doit: offset -> string -> typ -> 'a) (* Invoked on non-struct fields *)
- (off: offset)
- (post: 'a list) (** A suffix to what you compute *)
- (fields: fieldinfo list) : 'a list =
- List.fold_right
- (fun f post ->
- let off' = addOffset (Field(f, NoOffset)) off in
- match unrollType f.ftype with
- TComp (comp, _) when comp.cstruct -> (* struct type: recurse *)
- foldRightStructFields doit off' post comp.cfields
- | _ ->
- (doit off' f.fname f.ftype) :: post)
- fields
- post
-
-
-let rec foldStructFields
- (t: typ)
- (doit: offset -> string -> typ -> 'a)
- : 'a list =
- match unrollType t with
- TComp (comp, _) when comp.cstruct ->
- foldRightStructFields doit NoOffset [] comp.cfields
- | _ -> []
-
-
-(* Map a variable name to a list of component variables, along with the
- * accessor offset. The fields are in the order in which they appear in the
- * structure. *)
-let newvars : (string, (offset * varinfo) list) H.t = H.create 13
-
-(* Split a variable and return the replacements, in the proper order. If this
- * variable is not split, then return just the variable. *)
-let splitOneVar (v: varinfo)
- (mknewvar: string -> typ -> varinfo) : varinfo list =
- try
- (* See if we have already split it *)
- List.map snd (H.find newvars v.vname)
- with Not_found -> begin
- let vars: (offset * varinfo) list =
- foldStructFields v.vtype
- (fun off n t -> (* make a new one *)
- let newname = v.vname ^ "_" ^ n in
- let v'= mknewvar newname t in
- (off, v'))
- in
- if vars = [] then
- [ v ]
- else begin
- (* Now remember the newly created vars *)
- H.add newvars v.vname vars;
- List.map snd vars (* Return just the vars *)
- end
- end
-
-
-(* A visitor that finds all locals that appear in a call or have their
- * address taken *)
-let dontSplitLocals : (string, bool) H.t = H.create 111
-class findVarsCantSplitClass : cilVisitor = object (self)
- inherit nopCilVisitor
-
- (* expressions, to see the address being taken *)
- method vexpr (e: exp) : exp visitAction =
- match e with
- AddrOf (Var v, NoOffset) ->
- H.add dontSplitLocals v.vname true; SkipChildren
- (* See if we take the address of the "_ms" field in a variable *)
- | _ -> DoChildren
-
-
- (* variables involved in call instructions *)
- method vinst (i: instr) : instr list visitAction =
- match i with
- Call (res, f, args, _) ->
- (match res with
- Some (Var v, NoOffset) -> H.add dontSplitLocals v.vname true
- | _ -> ());
- if not splitArguments then
- List.iter (fun a ->
- match a with
- Lval (Var v, NoOffset) -> H.add dontSplitLocals v.vname true
- | _ -> ()) args;
- (* Now continue the visit *)
- DoChildren
-
- | _ -> DoChildren
-
- (* Variables used in return should not be split *)
- method vstmt (s: stmt) : stmt visitAction =
- match s.skind with
- Return (Some (Lval (Var v, NoOffset)), _) ->
- H.add dontSplitLocals v.vname true; DoChildren
- | Return (Some e, _) ->
- DoChildren
- | _ -> DoChildren
-
- method vtype t = SkipChildren
-
-end
-let findVarsCantSplit = new findVarsCantSplitClass
-
-let isVar lv =
- match lv with
- (Var v, NoOffset) -> true
- | _ -> false
-
-
-class splitVarVisitorClass(func:fundec option) : cilVisitor = object (self)
- inherit nopCilVisitor
-
- method private makeTemp (e1: exp) : exp =
- let fi:fundec = match func with
- Some f -> f
- | None ->
- E.s (bug "You can't create a temporary if you're not in a function.")
- in
- let t = makeTempVar fi (typeOf e1) in
- (* Add this instruction before the current statement *)
- self#queueInstr [Set(var t, e1, !currentLoc)];
- Lval(var t)
-
-
- (* We must process the function types *)
- method vtype t =
- (* We invoke the visitor first and then we fix it *)
- let postProcessFunType (t: typ) : typ =
- match t with
- TFun(rt, Some params, isva, a) ->
- let rec loopParams = function
- [] -> []
- | ((pn, pt, pa) :: rest) as params ->
- let rest' = loopParams rest in
- let res: (string * typ * attributes) list =
- foldStructFields pt
- (fun off n t ->
- (* Careful with no-name parameters, or we end up with
- * many parameters named _p ! *)
- ((if pn <> "" then pn ^ n else ""), t, pa))
- in
- if res = [] then (* Not a fat *)
- if rest' == rest then
- params (* No change at all. Try not to reallocate so that
- * the visitor does not allocate. *)
- else
- (pn, pt, pa) :: rest'
- else (* Some change *)
- res @ rest'
- in
- let params' = loopParams params in
- if params == params' then
- t
- else
- TFun(rt, Some params', isva, a)
-
- | t -> t
- in
- if splitArguments then
- ChangeDoChildrenPost(t, postProcessFunType)
- else
- SkipChildren
-
- (* Whenever we see a variable with a field access we try to replace it
- * by its components *)
- method vlval ((b, off) : lval) : lval visitAction =
- try
- match b, off with
- Var v, (Field _ as off) ->
- (* See if this variable has some splits.Might throw Not_found *)
- let splits = H.find newvars v.vname in
- (* Now find among the splits one that matches this offset. And
- * return the remaining offset *)
- let rec find = function
- [] ->
- E.s (E.bug "Cannot find component %a of %s\n"
- (d_offset nil) off v.vname)
- | (splitoff, splitvar) :: restsplits ->
- let rec matches = function
- Field(f1, rest1), Field(f2, rest2)
- when f1.fname = f2.fname ->
- matches (rest1, rest2)
- | off, NoOffset ->
- (* We found a match *)
- (Var splitvar, off)
- | NoOffset, restoff ->
- ignore (warn "Found aggregate lval %a\n"
- d_lval (b, off));
- find restsplits
-
- | _, _ -> (* We did not match this one; go on *)
- find restsplits
- in
- matches (off, splitoff)
- in
- ChangeTo (find splits)
- | _ -> DoChildren
- with Not_found -> DoChildren
-
- (* Sometimes we pass the variable as a whole to a function or we
- * assign it to something *)
- method vinst (i: instr) : instr list visitAction =
- match i with
- (* Split into several instructions and then do children inside
- * the rhs. Howver, v might appear in the rhs and if we
- * duplicate the instruction we might get bad
- * results. (e.g. test/small1/simplify_Structs2.c). So first copy
- * the rhs to temp variables, then to v.
- *
- * Optimization: if the rhs is a variable, skip the temporary vars.
- * Either the rhs = lhs, in which case this is all a nop, or it's not,
- * in which case the rhs and lhs don't overlap.*)
-
- Set ((Var v, NoOffset), Lval lv, l) when H.mem newvars v.vname -> begin
- let needTemps = not (isVar lv) in
- let vars4v = H.find newvars v.vname in
- if vars4v = [] then E.s (errorLoc l "No fields in split struct");
- ChangeTo
- (List.map
- (fun (off, newv) ->
- let lv' =
- visitCilLval (self :> cilVisitor)
- (addOffsetLval off lv) in
- (* makeTemp creates a temp var and puts (Lval lv') in it,
- before any instructions in this ChangeTo list are handled.*)
- let lv_tmp = if needTemps then
- self#makeTemp (Lval lv')
- else
- (Lval lv')
- in
- Set((Var newv, NoOffset), lv_tmp, l))
- vars4v)
- end
-
- | Set (lv, Lval (Var v, NoOffset), l) when H.mem newvars v.vname -> begin
- (* Split->NonSplit assignment. no overlap between lhs and rhs
- is possible*)
- let vars4v = H.find newvars v.vname in
- if vars4v = [] then E.s (errorLoc l "No fields in split struct");
- ChangeTo
- (List.map
- (fun (off, newv) ->
- let lv' =
- visitCilLval (self :> cilVisitor)
- (addOffsetLval off lv) in
- Set(lv', Lval (Var newv, NoOffset), l))
- vars4v)
- end
-
- (* Split all function arguments in calls *)
- | Call (ret, f, args, l) when splitArguments ->
- (* Visit the children first and then see if we must change the
- * arguments *)
- let finishArgs = function
- [Call (ret', f', args', l')] as i' ->
- let mustChange = ref false in
- let newargs =
- (* Look for opportunities to split arguments. If we can
- * split, we must split the original argument (in args).
- * Otherwise, we use the result of processing children
- * (in args'). *)
- List.fold_right2
- (fun a a' acc ->
- match a with
- Lval (Var v, NoOffset) when H.mem newvars v.vname ->
- begin
- mustChange := true;
- (List.map
- (fun (_, newv) ->
- Lval (Var newv, NoOffset))
- (H.find newvars v.vname))
- @ acc
- end
- | Lval lv -> begin
- let newargs =
- foldStructFields (typeOfLval lv)
- (fun off n t ->
- let lv' = addOffsetLval off lv in
- Lval lv') in
- if newargs = [] then
- a' :: acc (* not a split var *)
- else begin
- mustChange := true;
- newargs @ acc
- end
- end
- | _ -> (* only lvals are split, right? *)
- a' :: acc)
- args args'
- []
- in
- if !mustChange then
- [Call (ret', f', newargs, l')]
- else
- i'
- | _ -> E.s (E.bug "splitVarVisitorClass: expecting call")
- in
- ChangeDoChildrenPost ([i], finishArgs)
-
- | _ -> DoChildren
-
-
- method vfunc (func: fundec) : fundec visitAction =
- H.clear newvars;
- H.clear dontSplitLocals;
- (* Visit the type of the function itself *)
- if splitArguments then
- func.svar.vtype <- visitCilType (self :> cilVisitor) func.svar.vtype;
-
- (* Go over the block and find the candidates *)
- ignore (visitCilBlock findVarsCantSplit func.sbody);
-
- (* Now go over the formals and create the splits *)
- if splitArguments then begin
- (* Split all formals because we will split all arguments in function
- * types *)
- let newformals =
- List.fold_right
- (fun form acc ->
- (* Process the type first *)
- form.vtype <-
- visitCilType (self : #cilVisitor :> cilVisitor) form.vtype;
- let form' =
- splitOneVar form
- (fun s t -> makeLocalVar func ~insert:false s t)
- in
- (* Now it is a good time to check if we actually can split this
- * one *)
- if List.length form' > 1 &&
- H.mem dontSplitLocals form.vname then
- ignore (warn "boxsplit: can't split formal \"%s\" in %s. Make sure you never take the address of a formal.\n"
- form.vname func.svar.vname);
- form' @ acc)
- func.sformals []
- in
- (* Now make sure we fix the type. *)
- setFormals func newformals
- end;
- (* Now go over the locals and create the splits *)
- List.iter
- (fun l ->
- (* Process the type of the local *)
- l.vtype <- visitCilType (self :> cilVisitor) l.vtype;
- (* Now see if we must split it *)
- if not (H.mem dontSplitLocals l.vname) then begin
- ignore (splitOneVar l (fun s t -> makeTempVar func ~name:s t))
- end)
- func.slocals;
- (* Now visit the body and change references to these variables *)
- ignore (visitCilBlock (self :> cilVisitor) func.sbody);
- H.clear newvars;
- H.clear dontSplitLocals;
- SkipChildren (* We are done with this function *)
-
- (* Try to catch the occurrences of the variable in a sizeof expression *)
- method vexpr (e: exp) =
- match e with
- | SizeOfE (Lval(Var v, NoOffset)) -> begin
- try
- let splits = H.find newvars v.vname in
- (* We cound here on no padding between the elements ! *)
- ChangeTo
- (List.fold_left
- (fun acc (_, thisv) ->
- BinOp(PlusA, SizeOfE(Lval(Var thisv, NoOffset)),
- acc, uintType))
- zero
- splits)
- with Not_found -> DoChildren
- end
- | _ -> DoChildren
-end
-
-let doGlobal = function
- GFun(fi, _) ->
- (* Visit the body and change all expressions into three address code *)
- let v = new threeAddressVisitor fi in
- fi.sbody <- visitCilBlock v fi.sbody;
- if !splitStructs then begin
- H.clear dontSplitLocals;
- let splitVarVisitor = new splitVarVisitorClass (Some fi) in
- ignore (visitCilFunction splitVarVisitor fi);
- end
- | GVarDecl(vi, _) when isFunctionType vi.vtype ->
- (* we might need to split the args/return value in the function type. *)
- if !splitStructs then begin
- H.clear dontSplitLocals;
- let splitVarVisitor = new splitVarVisitorClass None in
- ignore (visitCilVarDecl splitVarVisitor vi);
- end
- | _ -> ()
-
-let feature : featureDescr =
- { fd_name = "simplify";
- fd_enabled = ref false;
- fd_description = "compiles CIL to 3-address code";
- fd_extraopt = [
- ("--no-split-structs", Arg.Unit (fun _ -> splitStructs := false),
- "do not split structured variables");
- ];
- fd_doit = (function f -> iterGlobals f doGlobal);
- fd_post_check = true;
-}
-
diff --git a/cil/src/ext/ssa.ml b/cil/src/ext/ssa.ml
deleted file mode 100644
index 942c92b6489920c1eadab72f22352a765546915d..0000000000000000000000000000000000000000
--- a/cil/src/ext/ssa.ml
+++ /dev/null
@@ -1,696 +0,0 @@
-module B=Bitmap
-module E = Errormsg
-
-open Cil
-open Pretty
-
-let debug = false
-
-(* Globalsread, Globalswritten should be closed under call graph *)
-
-module StringOrder =
- struct
- type t = string
- let compare s1 s2 =
- if s1 = s2 then 0 else
- if s1 < s2 then -1 else 1
- end
-
-module StringSet = Set.Make (StringOrder)
-
-module IntOrder =
- struct
- type t = int
- let compare i1 i2 =
- if i1 = i2 then 0 else
- if i1 < i2 then -1 else 1
- end
-
-module IntSet = Set.Make (IntOrder)
-
-
-type cfgInfo = {
- name: string; (* The function name *)
- start : int;
- size : int;
- blocks: cfgBlock array; (** Dominating blocks must come first *)
- successors: int list array; (* block indices *)
- predecessors: int list array;
- mutable nrRegs: int;
- mutable regToVarinfo: varinfo array; (** Map register IDs to varinfo *)
- }
-
-(** A block corresponds to a statement *)
-and cfgBlock = {
- bstmt: Cil.stmt;
-
- (* We abstract the statement as a list of def/use instructions *)
- instrlist: instruction list;
- mutable livevars: (reg * int) list;
- (** For each variable ID that is live at the start of the block, the
- * block whose definition reaches this point. If that block is the same
- * as the current one, then the variable is a phi variable *)
- mutable reachable: bool;
- }
-
-and instruction = (reg list * reg list)
- (* lhs variables, variables on rhs. *)
-
-
-and reg = int
-
-type idomInfo = int array (* immediate dominator *)
-
-and dfInfo = (int list) array (* dominance frontier *)
-
-and oneSccInfo = {
- nodes: int list;
- headers: int list;
- backEdges: (int*int) list;
- }
-
-and sccInfo = oneSccInfo list
-
-(* Muchnick's Domin_Fast, 7.16 *)
-
-let compute_idom (flowgraph: cfgInfo): idomInfo =
- let start = flowgraph.start in
- let size = flowgraph.size in
- let successors = flowgraph.successors in
- let predecessors = flowgraph.predecessors in
- let n0 = size in (* a new node (not in the flowgraph) *)
- let idom = Array.make size (-1) in (* Make an array of immediate dominators *)
- let nnodes = size + 1 in
- let nodeSet = B.init nnodes (fun i -> true) in
-
- let ndfs = Array.create nnodes 0 in (* mapping from depth-first
- * number to nodes. DForder
- * starts at 1, with 0 used as
- * an invalid entry *)
- let parent = Array.create nnodes 0 in (* the parent in depth-first
- * spanning tree *)
-
- (* A semidominator of w is the node v with the minimal DForder such
- * that there is a path from v to w containing only nodes with the
- * DForder larger than w. *)
- let sdno = Array.create nnodes 0 in (* depth-first number of
- * semidominator *)
-
- (* The set of nodes whose
- * semidominator is ndfs(i) *)
- let bucket = Array.init nnodes (fun _ -> B.cloneEmpty nodeSet) in
-
- (* The functions link and eval maintain a forest within the
- * depth-first spanning tree. Ancestor is n0 is the node is a root in
- * the forest. Label(v) is the node in the ancestor chain with the
- * smallest depth-first number of its semidominator. Child and Size
- * are used to keep the trees in the forest balanced *)
- let ancestor = Array.create nnodes 0 in
- let label = Array.create nnodes 0 in
- let child = Array.create nnodes 0 in
- let size = Array.create nnodes 0 in
-
-
- let n = ref 0 in (* depth-first scan and numbering.
- * Initialize data structures. *)
- ancestor.(n0) <- n0;
- label.(n0) <- n0;
- let rec depthFirstSearchDom v =
- incr n;
- sdno.(v) <- !n;
- ndfs.(!n) <- v; label.(v) <- v;
- ancestor.(v) <- n0; (* All nodes are roots initially *)
- child.(v) <- n0; size.(v) <- 1;
- List.iter
- (fun w ->
- if sdno.(w) = 0 then begin
- parent.(w) <- v; depthFirstSearchDom w
- end)
- successors.(v);
- in
- (* Determine the ancestor of v whose semidominator has the the minimal
- * DFnumber. In the process, compress the paths in the forest. *)
- let eval v =
- let rec compress v =
- if ancestor.(ancestor.(v)) <> n0 then
- begin
- compress ancestor.(v);
- if sdno.(label.(ancestor.(v))) < sdno.(label.(v)) then
- label.(v) <- label.(ancestor.(v));
- ancestor.(v) <- ancestor.(ancestor.(v))
- end
- in
- if ancestor.(v) = n0 then label.(v)
- else begin
- compress v;
- if sdno.(label.(ancestor.(v))) >= sdno.(label.(v)) then
- label.(v)
- else label.(ancestor.(v))
- end
- in
-
- let link v w =
- let s = ref w in
- while sdno.(label.(w)) < sdno.(label.(child.(!s))) do
- if size.(!s) + size.(child.(child.(!s))) >= 2* size.(child.(!s)) then
- (ancestor.(child.(!s)) <- !s;
- child.(!s) <- child.(child.(!s)))
- else
- (size.(child.(!s)) <- size.(!s);
- ancestor.(!s) <- child.(!s); s := child.(!s));
- done;
- label.(!s) <- label.(w);
- size.(v) <- size.(v) + size.(w);
- if size.(v) < 2 * size.(w) then begin
- let tmp = !s in
- s := child.(v);
- child.(v) <- tmp;
- end;
- while !s <> n0 do
- ancestor.(!s) <- v;
- s := child.(!s);
- done;
- in
- (* Start now *)
- depthFirstSearchDom start;
- for i = !n downto 2 do
- let w = ndfs.(i) in
- List.iter (fun v ->
- let u = eval v in
- if sdno.(u) < sdno.(w) then sdno.(w) <- sdno.(u);)
- predecessors.(w);
- B.set bucket.(ndfs.(sdno.(w))) w true;
- link parent.(w) w;
- while not (B.empty bucket.(parent.(w))) do
- let v =
- match B.toList bucket.(parent.(w)) with
- x :: _ -> x
- | [] -> ignore(print_string "Error in dominfast");0 in
- B.set bucket.(parent.(w)) v false;
- let u = eval v in
- idom.(v) <- if sdno.(u) < sdno.(v) then u else parent.(w);
- done;
- done;
-
- for i=2 to !n do
- let w = ndfs.(i) in
- if idom.(w) <> ndfs.(sdno.(w)) then begin
- let newDom = idom.(idom.(w)) in
- idom.(w) <- newDom;
- end
- done;
- idom
-
-
-
-
-
-let dominance_frontier (flowgraph: cfgInfo) : dfInfo =
- let idom = compute_idom flowgraph in
- let size = flowgraph.size in
- let children = Array.create size [] in
- for i = 0 to size - 1 do
- if (idom.(i) != -1) then children.(idom.(i)) <- i :: children.(idom.(i));
- done;
-
- let size = flowgraph.size in
- let start = flowgraph.start in
- let successors = flowgraph.successors in
-
- let df = Array.create size [] in
- (* Compute the dominance frontier *)
-
- let bottom = Array.make size true in (* bottom of the dominator tree *)
- for i = 0 to size - 1 do
- if (i != start) && idom.(i) <> -1 then bottom.(idom.(i)) <- false;
- done;
-
- let processed = Array.make size false in (* to record the nodes added to work_list *)
- let workList = ref ([]) in (* to iterate in a bottom-up traversal of the dominator tree *)
- for i = 0 to size - 1 do
- if (bottom.(i)) then workList := i :: !workList;
- done;
- while (!workList != []) do
- let x = List.hd !workList in
- let update y = if idom.(y) <> x then df.(x) <- y::df.(x) in
- (* compute local component *)
-
-(* We use whichPred instead of whichSucc because ultimately this info is
- * needed by control dependence dag which is constructed from REVERSE
- * dominance frontier *)
- List.iter (fun succ -> update succ) successors.(x);
- (* add on up component *)
- List.iter (fun z -> List.iter (fun y -> update y) df.(z)) children.(x);
- processed.(x) <- true;
- workList := List.tl !workList;
- if (x != start) then begin
- let i = idom.(x) in
- if i <> -1 &&
- (List.for_all (fun child -> processed.(child)) children.(i)) then workList := i :: !workList;
- end;
- done;
- df
-
-
-(* Computes for each register, the set of nodes that need a phi definition
- * for the register *)
-
-let add_phi_functions_info (flowgraph: cfgInfo) : unit =
- let df = dominance_frontier flowgraph in
- let size = flowgraph.size in
- let nrRegs = flowgraph.nrRegs in
-
-
- let defs = Array.init size (fun i -> B.init nrRegs (fun j -> false)) in
- for i = 0 to size-1 do
- List.iter
- (fun (lhs,rhs) ->
- List.iter (fun (r: reg) -> B.set defs.(i) r true) lhs;
- )
- flowgraph.blocks.(i).instrlist
- done;
- let iterCount = ref 0 in
- let hasAlready = Array.create size 0 in
- let work = Array.create size 0 in
- let w = ref ([]) in
- let dfPlus = Array.init nrRegs (
- fun i ->
- let defIn = B.make size in
- for j = 0 to size - 1 do
- if B.get defs.(j) i then B.set defIn j true
- done;
- let res = ref [] in
- incr iterCount;
- B.iter (fun x -> work.(x) <- !iterCount; w := x :: !w;) defIn;
- while (!w != []) do
- let x = List.hd !w in
- w := List.tl !w;
- List.iter (fun y ->
- if (hasAlready.(y) < !iterCount) then begin
- res := y :: !res;
- hasAlready.(y) <- !iterCount;
- if (work.(y) < !iterCount) then begin
- work.(y) <- !iterCount;
- w := y :: !w;
- end;
- end;
- ) df.(x)
- done;
- (* res := List.filter (fun blkId -> B.get liveIn.(blkId) i) !res; *)
- !res
- ) in
- let result = Array.create size ([]) in
- for i = 0 to nrRegs - 1 do
- List.iter (fun node -> result.(node) <- i::result.(node);) dfPlus.(i)
- done;
-(* result contains for each node, the list of variables that need phi
- * definition *)
- for i = 0 to size-1 do
- flowgraph.blocks.(i).livevars <-
- List.map (fun r -> (r, i)) result.(i);
- done
-
-
-
-(* add dominating definitions info *)
-
-let add_dom_def_info (f: cfgInfo): unit =
- let blocks = f.blocks in
- let start = f.start in
- let size = f.size in
- let nrRegs = f.nrRegs in
-
- let idom = compute_idom f in
- let children = Array.create size [] in
- for i = 0 to size - 1 do
- if (idom.(i) != -1) then children.(idom.(i)) <- i :: children.(idom.(i));
- done;
-
- if debug then begin
- ignore (E.log "Immediate dominators\n");
- for i = 0 to size - 1 do
- ignore (E.log " block %d: idom=%d, children=%a\n"
- i idom.(i)
- (docList num) children.(i));
- done
- end;
-
- (* For each variable, maintain a stack of blocks that define it. When you
- * process a block, the top of the stack is the closest dominator that
- * defines the variable *)
- let s = Array.make nrRegs ([start]) in
-
- (* Search top-down in the idom tree *)
- let rec search (x: int): unit = (* x is a graph node *)
- (* Push the current block for the phi variables *)
- List.iter
- (fun ((r: reg), dr) ->
- if x = dr then s.(r) <- x::s.(r))
- blocks.(x).livevars;
-
- (* Clear livevars *)
- blocks.(x).livevars <- [];
-
- (* Compute livevars *)
- for i = 0 to nrRegs-1 do
- match s.(i) with
- | [] -> assert false
- | fst :: _ ->
- blocks.(x).livevars <- (i, fst) :: blocks.(x).livevars
- done;
-
-
- (* Update s for the children *)
- List.iter
- (fun (lhs,rhs) ->
- List.iter (fun (lreg: reg) -> s.(lreg) <- x::s.(lreg) ) lhs;
- )
- blocks.(x).instrlist;
-
-
- (* Go and do the children *)
- List.iter search children.(x);
-
- (* Then we pop x, whenever it is on top of a stack *)
- Array.iteri
- (fun i istack ->
- let rec dropX = function
- [] -> []
- | x' :: rest when x = x' -> dropX rest
- | l -> l
- in
- s.(i) <- dropX istack)
- s;
- in
- search(start)
-
-
-
-let prune_cfg (f: cfgInfo): cfgInfo =
- let size = f.size in
- if size = 0 then f else
- let reachable = Array.make size false in
- let worklist = ref([f.start]) in
- while (!worklist != []) do
- let h = List.hd !worklist in
- worklist := List.tl !worklist;
- reachable.(h) <- true;
- List.iter (fun s -> if (reachable.(s) = false) then worklist := s::!worklist;
- ) f.successors.(h);
- done;
-(*
- let dummyblock = { bstmt = mkEmptyStmt ();
- instrlist = [];
- livevars = [] }
- in
-*)
- let successors = Array.init size (fun i -> List.filter (fun s -> reachable.(s)) f.successors.(i)) in
- let predecessors = Array.init size (fun i -> List.filter (fun s -> reachable.(s)) f.predecessors.(i)) in
- Array.iteri (fun i b -> b.reachable <- reachable.(i)) f.blocks;
- let result: cfgInfo =
- { name = f.name;
- start = f.start;
- size = f.size;
- successors = successors;
- predecessors = predecessors;
- blocks = f.blocks;
- nrRegs = f.nrRegs;
- regToVarinfo = f.regToVarinfo;
- }
- in
- result
-
-
-let add_ssa_info (f: cfgInfo): unit =
- let f = prune_cfg f in
- let d_reg () (r: int) =
- dprintf "%s(%d)" f.regToVarinfo.(r).vname r
- in
- if debug then begin
- ignore (E.log "Doing SSA for %s. Initial data:\n" f.name);
- Array.iteri (fun i b ->
- ignore (E.log " block %d:\n succs=@[%a@]\n preds=@[%a@]\n instr=@[%a@]\n"
- i
- (docList num) f.successors.(i)
- (docList num) f.predecessors.(i)
- (docList ~sep:line (fun (lhs, rhs) ->
- dprintf "%a := @[%a@]"
- (docList (d_reg ())) lhs (docList (d_reg ())) rhs))
- b.instrlist))
- f.blocks;
- end;
-
- add_phi_functions_info f;
- add_dom_def_info f;
-
- if debug then begin
- ignore (E.log "After SSA\n");
- Array.iter (fun b ->
- ignore (E.log " block %d livevars: @[%a@]\n"
- b.bstmt.sid
- (docList (fun (i, fst) ->
- dprintf "%a def at %d" d_reg i fst))
- b.livevars))
- f.blocks;
- end
-
-
-let set2list s =
- let result = ref([]) in
- IntSet.iter (fun element -> result := element::!result) s;
- !result
-
-
-
-
-let preorderDAG (nrNodes: int) (successors: (int list) array): int list =
- let processed = Array.make nrNodes false in
- let revResult = ref ([]) in
- let predecessorsSet = Array.make nrNodes (IntSet.empty) in
- for i = 0 to nrNodes -1 do
- List.iter (fun s -> predecessorsSet.(s) <- IntSet.add i predecessorsSet.(s)) successors.(i);
- done;
- let predecessors = Array.init nrNodes (fun i -> set2list predecessorsSet.(i)) in
- let workList = ref([]) in
- for i = 0 to nrNodes - 1 do
- if (predecessors.(i) = []) then workList := i::!workList;
- done;
- while (!workList != []) do
- let x = List.hd !workList in
- workList := List.tl !workList;
- revResult := x::!revResult;
- processed.(x) <- true;
- List.iter (fun s ->
- if (List.for_all (fun p -> processed.(p)) predecessors.(s)) then
- workList := s::!workList;
- ) successors.(x);
- done;
- List.rev !revResult
-
-
-(* Muchnick Fig 7.12 *)
-(* takes an SCC description as an input and returns prepares the appropriate SCC *)
-let preorder (nrNodes: int) (successors: (int list) array) (r: int): oneSccInfo =
- if debug then begin
- ignore (E.log "Inside preorder \n");
- for i = 0 to nrNodes - 1 do
- ignore (E.log "succ(%d) = %a" i (docList (fun i -> num i)) successors.(i));
- done;
- end;
- let i = ref(0) in
- let j = ref(0) in
- let pre = Array.make nrNodes (-1) in
- let post = Array.make nrNodes (-1) in
- let visit = Array.make nrNodes (false) in
- let backEdges = ref ([]) in
- let headers = ref(IntSet.empty) in
- let rec depth_first_search_pp (x:int) =
- visit.(x) <- true;
- pre.(x) <- !j;
- incr j;
- List.iter (fun (y:int) ->
- if (not visit.(y)) then
- (depth_first_search_pp y)
- else
- if (post.(y) = -1) then begin
- backEdges := (x,y)::!backEdges;
- headers := IntSet.add y !headers;
- end;
- ) successors.(x);
- post.(x) <- !i;
- incr i;
- in
- depth_first_search_pp r;
- let nodes = Array.make nrNodes (-1) in
- for y = 0 to nrNodes - 1 do
- if (pre.(y) != -1) then nodes.(pre.(y)) <- y;
- done;
- let nodeList = List.filter (fun i -> (i != -1)) (Array.to_list nodes) in
- let result = { headers = set2list !headers; backEdges = !backEdges; nodes = nodeList; } in
- result
-
-
-exception Finished
-
-
-let strong_components (f: cfgInfo) (debug: bool) =
- let size = f.size in
- let parent = Array.make size (-1) in
- let color = Array.make size (-1) in
- let finish = Array.make size (-1) in
- let root = Array.make size (-1) in
-
-(* returns a list of SCC. Each SCC is a tuple of SCC root and SCC nodes *)
- let dfs (successors: (int list) array) (order: int array) =
- let time = ref(-1) in
- let rec dfs_visit u =
- color.(u) <- 1;
- incr time;
- (* d.(u) <- time; *)
- List.iter (fun v ->
- if color.(v) = 0 then (parent.(v) <- u; dfs_visit v)
- ) successors.(u);
- color.(u) <- 2;
- incr time;
- finish.(u) <- !time
- in
- for u = 0 to size - 1 do
- color.(u) <- 0; (* white = 0, gray = 1, black = 2 *)
- parent.(u) <- -1; (* nil = -1 *)
- root.(u) <- 0; (* Is u a root? *)
- done;
- time := 0;
- Array.iter (fun u ->
- if (color.(u) = 0) then begin
- root.(u) <- 1;
- dfs_visit u;
- end;
- ) order;
- in
-
- let simpleOrder = Array.init size (fun i -> i) in
- dfs f.successors simpleOrder;
- Array.sort (fun i j -> if (finish.(i) > finish.(j)) then -1 else 1) simpleOrder;
-
- dfs f.predecessors simpleOrder;
-(* SCCs have been computed. (The trees represented by non-null parent edges
- * represent the SCCS. We call the black nodes as the roots). Now put the
- * result in the ouput format *)
- let allScc = ref([]) in
- for u = 0 to size - 1 do
- if root.(u) = 1 then begin
- let sccNodes = ref(IntSet.empty) in
- let workList = ref([u]) in
- while (!workList != []) do
- let h=List.hd !workList in
- workList := List.tl !workList;
- sccNodes := IntSet.add h !sccNodes;
- List.iter (fun s -> if parent.(s)=h then workList := s::!workList;) f.predecessors.(h);
- done;
- allScc := (u,!sccNodes)::!allScc;
- if (debug) then begin
- ignore (E.log "Got an SCC with root %d and nodes %a" u (docList num) (set2list !sccNodes));
- end;
- end;
- done;
- !allScc
-
-
-let stronglyConnectedComponents (f: cfgInfo) (debug: bool): sccInfo =
- let size = f.size in
- if (debug) then begin
- ignore (E.log "size = %d\n" size);
- for i = 0 to size - 1 do
- ignore (E.log "Successors(%d): %a\n" i (docList (fun n -> num n)) f.successors.(i));
- done;
- end;
-
- let allScc = strong_components f debug in
- let all_sccArray = Array.of_list allScc in
-
- if (debug) then begin
- ignore (E.log "Computed SCCs\n");
- for i = 0 to (Array.length all_sccArray) - 1 do
- ignore(E.log "SCC #%d: " i);
- let (_,sccNodes) = all_sccArray.(i) in
- IntSet.iter (fun i -> ignore(E.log "%d, " i)) sccNodes;
- ignore(E.log "\n");
- done;
- end;
-
-
- (* Construct sccId: Node -> Scc Id *)
- let sccId = Array.make size (-1) in
- Array.iteri (fun i (r,sccNodes) ->
- IntSet.iter (fun n -> sccId.(n) <- i) sccNodes;
- ) all_sccArray;
-
- if (debug) then begin
- ignore (E.log "\nComputed SCC IDs: ");
- for i = 0 to size - 1 do
- ignore (E.log "SCCID(%d) = %d " i sccId.(i));
- done;
- end;
-
-
- (* Construct sccCFG *)
- let nrScc = Array.length all_sccArray in
- let successors = Array.make nrScc [] in
- for x = 0 to nrScc - 1 do
- successors.(x) <-
- let s = ref(IntSet.empty) in
- IntSet.iter (fun y ->
- List.iter (fun z ->
- let sy = sccId.(y) in
- let sz = sccId.(z) in
- if (not(sy = sz)) then begin
- s := IntSet.add sz !s;
- end
- ) f.successors.(y)
- ) (snd all_sccArray.(x));
- set2list !s
- done;
-
- if (debug) then begin
- ignore (E.log "\nComputed SCC CFG, which should be a DAG:");
- ignore (E.log "nrSccs = %d " nrScc);
- for i = 0 to nrScc - 1 do
- ignore (E.log "successors(%d) = [%a] " i (docList (fun j -> num j)) successors.(i));
- done;
- end;
-
-
- (* Order SCCs. The graph is a DAG here *)
- let sccorder = preorderDAG nrScc successors in
-
- if (debug) then begin
- ignore (E.log "\nComputed SCC Preorder: ");
- ignore (E.log "Nodes in Preorder = [%a]" (docList (fun i -> num i)) sccorder);
- end;
-
- (* Order nodes of each SCC. The graph is a SCC here.*)
- let scclist = List.map (fun i ->
- let successors = Array.create size [] in
- for j = 0 to size - 1 do
- successors.(j) <- List.filter (fun x -> IntSet.mem x (snd all_sccArray.(i))) f.successors.(j);
- done;
- preorder f.size successors (fst all_sccArray.(i))
- ) sccorder in
- if (debug) then begin
- ignore (E.log "Computed Preorder for Nodes of each SCC\n");
- List.iter (fun scc ->
- ignore (E.log "BackEdges = %a \n"
- (docList (fun (src,dest) -> dprintf "(%d,%d)" src dest))
- scc.backEdges);)
- scclist;
- end;
- scclist
-
-
-
-
-
-
-
-
-
diff --git a/cil/src/ext/ssa.mli b/cil/src/ext/ssa.mli
deleted file mode 100644
index be244d811dc840fae0ecaddf745e99ee87749dd6..0000000000000000000000000000000000000000
--- a/cil/src/ext/ssa.mli
+++ /dev/null
@@ -1,45 +0,0 @@
-type cfgInfo = {
- name: string; (* The function name *)
- start : int;
- size : int;
- blocks: cfgBlock array; (** Dominating blocks must come first *)
- successors: int list array; (* block indices *)
- predecessors: int list array;
- mutable nrRegs: int;
- mutable regToVarinfo: Cil.varinfo array; (** Map register IDs to varinfo *)
- }
-
-(** A block corresponds to a statement *)
-and cfgBlock = {
- bstmt: Cil.stmt;
-
- (* We abstract the statement as a list of def/use instructions *)
- instrlist: instruction list;
- mutable livevars: (reg * int) list;
- (** For each variable ID that is live at the start of the block, the
- * block whose definition reaches this point. If that block is the same
- * as the current one, then the variable is a phi variable *)
- mutable reachable: bool;
- }
-
-and instruction = (reg list * reg list)
- (* lhs variables, variables on rhs. *)
-
-
-and reg = int
-
-type idomInfo = int array (* immediate dominator *)
-
-and dfInfo = (int list) array (* dominance frontier *)
-
-and oneSccInfo = {
- nodes: int list;
- headers: int list;
- backEdges: (int*int) list;
- }
-
-and sccInfo = oneSccInfo list
-
-val add_ssa_info: cfgInfo -> unit
-val stronglyConnectedComponents: cfgInfo -> bool -> sccInfo
-val prune_cfg: cfgInfo -> cfgInfo
diff --git a/cil/src/ext/stackoverflow.ml b/cil/src/ext/stackoverflow.ml
deleted file mode 100644
index da2c4018305fc0c47bd0c6cd2993af7952242de3..0000000000000000000000000000000000000000
--- a/cil/src/ext/stackoverflow.ml
+++ /dev/null
@@ -1,246 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-module H = Hashtbl
-open Cil
-open Pretty
-module E = Errormsg
-
-let debug = false
-
-
-(* For each function we have a node *)
-type node = { name: string;
- mutable scanned: bool;
- mutable mustcheck: bool;
- mutable succs: node list }
-(* We map names to nodes *)
-let functionNodes: (string, node) H.t = H.create 113
-let getFunctionNode (n: string) : node =
- Util.memoize
- functionNodes
- n
- (fun _ -> { name = n; mustcheck = false; scanned = false; succs = [] })
-
-(** Dump the function call graph. Assume that there is a main *)
-let dumpGraph = true
-let dumpFunctionCallGraph () =
- H.iter (fun _ x -> x.scanned <- false) functionNodes;
- let rec dumpOneNode (ind: int) (n: node) : unit =
- output_string !E.logChannel "\n";
- for i = 0 to ind do
- output_string !E.logChannel " "
- done;
- output_string !E.logChannel (n.name ^ " ");
- if n.scanned then (* Already dumped *)
- output_string !E.logChannel " <rec> "
- else begin
- n.scanned <- true;
- List.iter (dumpOneNode (ind + 1)) n.succs
- end
- in
- try
- let main = H.find functionNodes "main" in
- dumpOneNode 0 main
- with Not_found -> begin
- ignore (E.log
- "I would like to dump the function graph but there is no main");
- end
-
-(* We add a dummy function whose name is "@@functionPointer@@" that is called
- * at all invocations of function pointers and itself calls all functions
- * whose address is taken. *)
-let functionPointerName = "@@functionPointer@@"
-
-let checkSomeFunctions = ref false
-
-let init () =
- H.clear functionNodes;
- checkSomeFunctions := false
-
-
-let addCall (caller: string) (callee: string) =
- let callerNode = getFunctionNode caller in
- let calleeNode = getFunctionNode callee in
- if not (List.exists (fun n -> n.name = callee) callerNode.succs) then begin
- if debug then
- ignore (E.log "found call from %s to %s\n" caller callee);
- callerNode.succs <- calleeNode :: callerNode.succs;
- end;
- ()
-
-
-class findCallsVisitor (host: string) : cilVisitor = object
- inherit nopCilVisitor
-
- method vinst i =
- match i with
- | Call(_,Lval(Var(vi),NoOffset),_,l) ->
- addCall host vi.vname;
- SkipChildren
-
- | Call(_,e,_,l) -> (* Calling a function pointer *)
- addCall host functionPointerName;
- SkipChildren
-
- | _ -> SkipChildren (* No calls in other instructions *)
-
- (* There are no calls in expressions and types *)
- method vexpr e = SkipChildren
- method vtype t = SkipChildren
-
-end
-
-(* Now detect the cycles in the call graph. Do a depth first search of the
- * graph (stack is the list of nodes already visited in the current path).
- * Return true if we have found a cycle. *)
-let rec breakCycles (stack: node list) (n: node) : bool =
- if n.scanned then (* We have already scanned this node. There are no cycles
- * going through this node *)
- false
- else if n.mustcheck then
- (* We are reaching a node that we already know we much check. Return with
- * no new cycles. *)
- false
- else if List.memq n stack then begin
- (* We have found a cycle. Mark the node n to be checked and return *)
- if debug then
- ignore (E.log "Will place an overflow check in %s\n" n.name);
- checkSomeFunctions := true;
- n.mustcheck <- true;
- n.scanned <- true;
- true
- end else begin
- let res = List.exists (fun nd -> breakCycles (n :: stack) nd) n.succs in
- n.scanned <- true;
- if res && n.mustcheck then
- false
- else
- res
- end
-let findCheckPlacement () =
- H.iter (fun _ nd ->
- if nd.name <> functionPointerName
- && not nd.scanned && not nd.mustcheck then begin
- ignore (breakCycles [] nd)
- end)
- functionNodes
-
-let makeFunctionCallGraph (f: Cil.file) : unit =
- init ();
- (* Scan the file and construct the control-flow graph *)
- List.iter
- (function
- GFun(fdec, _) ->
- if fdec.svar.vaddrof then
- addCall functionPointerName fdec.svar.vname;
- let vis = new findCallsVisitor fdec.svar.vname in
- ignore (visitCilBlock vis fdec.sbody)
-
- | _ -> ())
- f.globals
-
-let makeAndDumpFunctionCallGraph (f: file) =
- makeFunctionCallGraph f;
- dumpFunctionCallGraph ()
-
-
-let addCheck (f: Cil.file) : unit =
- makeFunctionCallGraph f;
- findCheckPlacement ();
- if !checkSomeFunctions then begin
- (* Add a declaration for the stack threshhold variable. The program is
- * stopped when the stack top is less than this value. *)
- let stackThreshholdVar = makeGlobalVar "___stack_threshhold" !upointType in
- stackThreshholdVar.vstorage <- Extern;
- (* And the initialization function *)
- let computeStackThreshhold =
- makeGlobalVar "___compute_stack_threshhold"
- (TFun(!upointType, Some [], false, [])) in
- computeStackThreshhold.vstorage <- Extern;
- (* And the failure function *)
- let stackOverflow =
- makeGlobalVar "___stack_overflow"
- (TFun(voidType, Some [], false, [])) in
- stackOverflow.vstorage <- Extern;
- f.globals <-
- GVar(stackThreshholdVar, {init=None}, locUnknown) ::
- GVarDecl(computeStackThreshhold, locUnknown) ::
- GVarDecl(stackOverflow, locUnknown) :: f.globals;
- (* Now scan and instrument each function definition *)
- List.iter
- (function
- GFun(fdec, l) ->
- (* If this is main we must introduce the initialization of the
- * bottomOfStack *)
- let nd = getFunctionNode fdec.svar.vname in
- if fdec.svar.vname = "main" then begin
- if nd.mustcheck then
- E.s (E.error "The \"main\" function is recursive!!");
- let loc = makeLocalVar fdec "__a_local" intType in
- loc.vaddrof <- true;
- fdec.sbody <-
- mkBlock
- [ mkStmtOneInstr
- (Call (Some(var stackThreshholdVar),
- Lval(var computeStackThreshhold), [], l));
- mkStmt (Block fdec.sbody) ]
- end else if nd.mustcheck then begin
- let loc = makeLocalVar fdec "__a_local" intType in
- loc.vaddrof <- true;
- fdec.sbody <-
- mkBlock
- [ mkStmt
- (If(BinOp(Le,
- CastE(!upointType, AddrOf (var loc)),
- Lval(var stackThreshholdVar), intType),
- mkBlock [mkStmtOneInstr
- (Call(None, Lval(var stackOverflow),
- [], l))],
- mkBlock [],
- l));
- mkStmt (Block fdec.sbody) ]
- end else
- ()
-
- | _ -> ())
- f.globals;
- ()
- end
-
-
-
-
diff --git a/cil/src/ext/stackoverflow.mli b/cil/src/ext/stackoverflow.mli
deleted file mode 100644
index 6ec0200758b0eab0e82bc50da83d95c86a918364..0000000000000000000000000000000000000000
--- a/cil/src/ext/stackoverflow.mli
+++ /dev/null
@@ -1,43 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* This module inserts code to check for stack overflow. It saves the address
- * of the top of the stack in "main" and then it picks one function *)
-
-val addCheck: Cil.file -> unit
-
-val makeAndDumpFunctionCallGraph: Cil.file -> unit
diff --git a/cil/src/ext/usedef.ml b/cil/src/ext/usedef.ml
deleted file mode 100755
index 57f226aac3fe01cb632be6abd8a299e24b508902..0000000000000000000000000000000000000000
--- a/cil/src/ext/usedef.ml
+++ /dev/null
@@ -1,188 +0,0 @@
-(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-
-
-open Cil
-open Pretty
-
-(** compute use/def information *)
-
-module VS = Set.Make (struct
- type t = Cil.varinfo
- let compare v1 v2 = Pervasives.compare v1.vid v2.vid
- end)
-
-(** Set this global to how you want to handle function calls *)
-let getUseDefFunctionRef: (exp -> VS.t * VS.t) ref =
- ref (fun _ -> (VS.empty, VS.empty))
-
-(** Say if you want to consider a variable use *)
-let considerVariableUse: (varinfo -> bool) ref =
- ref (fun _ -> true)
-
-
-(** Say if you want to consider a variable def *)
-let considerVariableDef: (varinfo -> bool) ref =
- ref (fun _ -> true)
-
-(** Save if you want to consider a variable addrof as a use *)
-let considerVariableAddrOfAsUse: (varinfo -> bool) ref =
- ref (fun _ -> true)
-
-(* When this is true, only definitions of a variable without
- an offset are counted as definitions. So:
- a = 5; would be a definition, but
- a[1] = 5; would not *)
-let onlyNoOffsetsAreDefs: bool ref = ref false
-
-let varUsed: VS.t ref = ref VS.empty
-let varDefs: VS.t ref = ref VS.empty
-
-class useDefVisitorClass : cilVisitor = object (self)
- inherit nopCilVisitor
-
- (** this will be invoked on variable definitions only because we intercept
- * all uses of variables in expressions ! *)
- method vvrbl (v: varinfo) =
- if (!considerVariableDef) v &&
- not(!onlyNoOffsetsAreDefs) then
- varDefs := VS.add v !varDefs;
- SkipChildren
-
- (** If onlyNoOffsetsAreDefs is true, then we need to see the
- * varinfo in an lval along with the offset. Otherwise just
- * DoChildren *)
- method vlval (l: lval) =
- if !onlyNoOffsetsAreDefs then
- match l with
- (Var vi, NoOffset) ->
- if (!considerVariableDef) vi then
- varDefs := VS.add vi !varDefs;
- SkipChildren
- | _ -> DoChildren
- else DoChildren
-
- method vexpr = function
- Lval (Var v, off) ->
- ignore (visitCilOffset (self :> cilVisitor) off);
- if (!considerVariableUse) v then
- varUsed := VS.add v !varUsed;
- SkipChildren (* So that we do not see the v *)
-
- | AddrOf (Var v, off)
- | StartOf (Var v, off) ->
- ignore (visitCilOffset (self :> cilVisitor) off);
- if (!considerVariableAddrOfAsUse) v then
- varUsed := VS.add v !varUsed;
- SkipChildren
-
- | _ -> DoChildren
-
- (* For function calls, do the transitive variable read/defs *)
- method vinst = function
- Call (_, f, _, _) -> begin
- (* we will call DoChildren to compute the use and def that appear in
- * this instruction. We also add in the stuff computed by
- * getUseDefFunctionRef *)
- let use, def = !getUseDefFunctionRef f in
- varUsed := VS.union !varUsed use;
- varDefs := VS.union !varDefs def;
- DoChildren;
- end
- | Asm(_,_,slvl,_,_,_) -> List.iter (fun (s,lv) ->
- match lv with (Var v, off) ->
- if s.[0] = '+' then
- varUsed := VS.add v !varUsed;
- | _ -> ()) slvl;
- DoChildren
- | _ -> DoChildren
-
-end
-
-let useDefVisitor = new useDefVisitorClass
-
-(** Compute the use information for an expression (accumulate to an existing
- * set) *)
-let computeUseExp ?(acc=VS.empty) (e: exp) : VS.t =
- varUsed := acc;
- ignore (visitCilExpr useDefVisitor e);
- !varUsed
-
-
-(** Compute the use/def information for an instruction *)
-let computeUseDefInstr ?(acc_used=VS.empty)
- ?(acc_defs=VS.empty)
- (i: instr) : VS.t * VS.t =
- varUsed := acc_used;
- varDefs := acc_defs;
- ignore (visitCilInstr useDefVisitor i);
- !varUsed, !varDefs
-
-
-(** Compute the use/def information for a statement kind. Do not descend into
- * the nested blocks. *)
-let computeUseDefStmtKind ?(acc_used=VS.empty)
- ?(acc_defs=VS.empty)
- (sk: stmtkind) : VS.t * VS.t =
- varUsed := acc_used;
- varDefs := acc_defs;
- let ve e = ignore (visitCilExpr useDefVisitor e) in
- let _ =
- match sk with
- Return (None, _) -> ()
- | Return (Some e, _) -> ve e
- | If (e, _, _, _) -> ve e
- | Break _ | Goto _ | Continue _ -> ()
-(*
- | Loop (_, _, _, _) -> ()
-*)
- | While _ | DoWhile _ | For _ -> ()
- | Switch (e, _, _, _) -> ve e
- | Instr il ->
- List.iter (fun i -> ignore (visitCilInstr useDefVisitor i)) il
- | TryExcept _ | TryFinally _ -> ()
- | Block _ -> ()
- in
- !varUsed, !varDefs
-
-(* Compute the use/def information for a statement kind.
- DO descend into nested blocks *)
-let rec computeDeepUseDefStmtKind ?(acc_used=VS.empty)
- ?(acc_defs=VS.empty)
- (sk: stmtkind) : VS.t * VS.t =
- let handle_block b =
- List.fold_left (fun (u,d) s ->
- let u',d' = computeDeepUseDefStmtKind s.skind in
- (VS.union u u', VS.union d d')) (VS.empty, VS.empty)
- b.bstmts
- in
- varUsed := acc_used;
- varDefs := acc_defs;
- let ve e = ignore (visitCilExpr useDefVisitor e) in
- match sk with
- Return (None, _) -> !varUsed, !varDefs
- | Return (Some e, _) ->
- let _ = ve e in
- !varUsed, !varDefs
- | If (e, tb, fb, _) ->
- let _ = ve e in
- let u, d = !varUsed, !varDefs in
- let u', d' = handle_block tb in
- let u'', d'' = handle_block fb in
- (VS.union (VS.union u u') u'', VS.union (VS.union d d') d'')
- | Break _ | Goto _ | Continue _ -> !varUsed, !varDefs
-(*
- | Loop (b, _, _, _) -> handle_block b
-*)
- | While (_, b, _) -> handle_block b
- | DoWhile (_, b, _) -> handle_block b
- | For (_, _, _, b, _) -> handle_block b
- | Switch (e, b, _, _) ->
- let _ = ve e in
- let u, d = !varUsed, !varDefs in
- let u', d' = handle_block b in
- (VS.union u u', VS.union d d')
- | Instr il ->
- List.iter (fun i -> ignore (visitCilInstr useDefVisitor i)) il;
- !varUsed, !varDefs
- | TryExcept _ | TryFinally _ -> !varUsed, !varDefs
- | Block b -> handle_block b
diff --git a/cil/src/formatcil.ml b/cil/src/formatcil.ml
deleted file mode 100644
index 33bc749f89ec5e7786bae18a38ed8f64551264c1..0000000000000000000000000000000000000000
--- a/cil/src/formatcil.ml
+++ /dev/null
@@ -1,215 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-open Cil
-open Pretty
-open Trace (* sm: 'trace' function *)
-module E = Errormsg
-module H = Hashtbl
-
-let noMemoize = ref false
-
-let expMemoTable :
- (string, (((string * formatArg) list -> exp) *
- (exp -> formatArg list option))) H.t = H.create 23
-
-let typeMemoTable :
- (string, (((string * formatArg) list -> typ) *
- (typ -> formatArg list option))) H.t = H.create 23
-
-let lvalMemoTable :
- (string, (((string * formatArg) list -> lval) *
- (lval -> formatArg list option))) H.t = H.create 23
-
-let instrMemoTable :
- (string, ((location -> (string * formatArg) list -> instr) *
- (instr -> formatArg list option))) H.t = H.create 23
-
-let stmtMemoTable :
- (string, ((string -> typ -> varinfo) ->
- location ->
- (string * formatArg) list -> stmt)) H.t = H.create 23
-
-let stmtsMemoTable :
- (string, ((string -> typ -> varinfo) ->
- location ->
- (string * formatArg) list -> stmt list)) H.t = H.create 23
-
-
-let doParse (prog: string)
- (theParser: (Lexing.lexbuf -> Formatparse.token)
- -> Lexing.lexbuf -> 'a)
- (memoTable: (string, 'a) H.t) : 'a =
- try
- if !noMemoize then raise Not_found else
- H.find memoTable prog
- with Not_found -> begin
- let lexbuf = Formatlex.init prog in
- try
- Formatparse.initialize Formatlex.initial lexbuf;
- let res = theParser Formatlex.initial lexbuf in
- H.add memoTable prog res;
- Formatlex.finish ();
- res
- with Parsing.Parse_error -> begin
- Formatlex.finish ();
- E.s (E.error "Parsing error: %s" prog)
- end
- | e -> begin
- ignore (E.log "Caught %s while parsing\n" (Printexc.to_string e));
- Formatlex.finish ();
- raise e
- end
- end
-
-
-let cExp (prog: string) : (string * formatArg) list -> exp =
- let cf = doParse prog Formatparse.expression expMemoTable in
- (fst cf)
-
-let cLval (prog: string) : (string * formatArg) list -> lval =
- let cf = doParse prog Formatparse.lval lvalMemoTable in
- (fst cf)
-
-let cType (prog: string) : (string * formatArg) list -> typ =
- let cf = doParse prog Formatparse.typename typeMemoTable in
- (fst cf)
-
-let cInstr (prog: string) : location -> (string * formatArg) list -> instr =
- let cf = doParse prog Formatparse.instr instrMemoTable in
- (fst cf)
-
-let cStmt (prog: string) : (string -> typ -> varinfo) ->
- location -> (string * formatArg) list -> stmt =
- let cf = doParse prog Formatparse.stmt stmtMemoTable in
- cf
-
-let cStmts (prog: string) :
- (string -> typ -> varinfo) ->
- location -> (string * formatArg) list -> stmt list =
- let cf = doParse prog Formatparse.stmt_list stmtsMemoTable in
- cf
-
-
-
-(* Match an expression *)
-let dExp (prog: string) : exp -> formatArg list option =
- let df = doParse prog Formatparse.expression expMemoTable in
- (snd df)
-
-(* Match an lvalue *)
-let dLval (prog: string) : lval -> formatArg list option =
- let df = doParse prog Formatparse.lval lvalMemoTable in
- (snd df)
-
-
-(* Match a type *)
-let dType (prog: string) : typ -> formatArg list option =
- let df = doParse prog Formatparse.typename typeMemoTable in
- (snd df)
-
-
-
-(* Match an instruction *)
-let dInstr (prog: string) : instr -> formatArg list option =
- let df = doParse prog Formatparse.instr instrMemoTable in
- (snd df)
-
-
-let test () =
- (* Construct a dummy function *)
- let func = emptyFunction "test_formatcil" in
- (* Construct a few varinfo *)
- let res = makeLocalVar func "res" (TPtr(intType, [])) in
- let fptr = makeLocalVar func "fptr"
- (TPtr(TFun(intType, None, false, []), [])) in
- (* Construct an instruction *)
- let makeInstr () =
- Call(Some (var res),
- Lval (Mem (CastE(TPtr(TFun(TPtr(intType, []),
- Some [ ("", intType, []);
- ("a2", TPtr(intType, []), []);
- ("a3", TPtr(TPtr(intType, []),
- []), []) ],
- false, []), []),
- Lval (var fptr))),
- NoOffset),
- [ ], locUnknown)
- in
- let times = 100000 in
- (* Make the instruction the regular way *)
- Stats.time "make instruction regular"
- (fun _ -> for i = 0 to times do ignore (makeInstr ()) done)
- ();
- (* Now make the instruction interpreted *)
- noMemoize := true;
- Stats.time "make instruction interpreted"
- (fun _ -> for i = 0 to times do
- let _ =
- cInstr "%v:res = (* ((int * (*)(int, int * a2, int * * a3))%v:fptr))();"
- locUnknown [ ("res", Fv res);
- ("fptr", Fv fptr) ]
- in
- ()
- done)
- ();
- (* Now make the instruction interpreted with memoization *)
- noMemoize := false;
- Stats.time "make instruction interpreted memoized"
- (fun _ -> for i = 0 to times do
- let _ =
- cInstr "%v:res = (* ((int * (*)(int, int * a2, int * * a3))%v:fptr))();"
- locUnknown [ ("res", Fv res); ("fptr", Fv fptr) ]
- in
- ()
- done)
- ();
- (* Now make the instruction interpreted with partial application *)
- let partInstr =
- cInstr "%v:res = (* ((int * (*)(int, int * a2, int * * a3))%v:fptr))();" in
- Stats.time "make instruction interpreted partial"
- (fun _ -> for i = 0 to times do
- let _ =
- partInstr
- locUnknown [ ("res", Fv res); ("fptr", Fv fptr) ]
- in
- ()
- done)
- ();
-
- ()
-
-
diff --git a/cil/src/formatcil.mli b/cil/src/formatcil.mli
deleted file mode 100644
index d353c5eb00e5369929c3c2cb1f56bcb762783028..0000000000000000000000000000000000000000
--- a/cil/src/formatcil.mli
+++ /dev/null
@@ -1,103 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-
-(** {b An Interpreter for constructing CIL constructs} *)
-
-
-(** Constructs an expression based on the program and the list of arguments.
- * Each argument consists of a name followed by the actual data. This
- * argument will be placed instead of occurrences of "%v:name" in the pattern
- * (where the "v" is dependent on the type of the data). The parsing of the
- * string is memoized. * Only the first expression is parsed. *)
-val cExp: string -> (string * Cil.formatArg) list -> Cil.exp
-
-(** Constructs an lval based on the program and the list of arguments.
- * Only the first lvalue is parsed.
- * The parsing of the string is memoized. *)
-val cLval: string -> (string * Cil.formatArg) list -> Cil.lval
-
-(** Constructs a type based on the program and the list of arguments.
- * Only the first type is parsed.
- * The parsing of the string is memoized. *)
-val cType: string -> (string * Cil.formatArg) list -> Cil.typ
-
-
-(** Constructs an instruction based on the program and the list of arguments.
- * Only the first instruction is parsed.
- * The parsing of the string is memoized. *)
-val cInstr: string -> Cil.location ->
- (string * Cil.formatArg) list -> Cil.instr
-
-(* Constructs a statement based on the program and the list of arguments. We
- * also pass a function that can be used to make new varinfo's for the
- * declared variables, and a location to be used for the statements. Only the
- * first statement is parsed. The parsing of the string is memoized. *)
-val cStmt: string ->
- (string -> Cil.typ -> Cil.varinfo) ->
- Cil.location -> (string * Cil.formatArg) list -> Cil.stmt
-
-(** Constructs a list of statements *)
-val cStmts: string ->
- (string -> Cil.typ -> Cil.varinfo) ->
- Cil.location -> (string * Cil.formatArg) list ->
- Cil.stmt list
-
-(** Deconstructs an expression based on the program. Produces an optional
- * list of format arguments. The parsing of the string is memoized. *)
-val dExp: string -> Cil.exp -> Cil.formatArg list option
-
-(** Deconstructs an lval based on the program. Produces an optional
- * list of format arguments. The parsing of the string is memoized. *)
-val dLval: string -> Cil.lval -> Cil.formatArg list option
-
-
-(** Deconstructs a type based on the program. Produces an optional list of
- * format arguments. The parsing of the string is memoized. *)
-val dType: string -> Cil.typ -> Cil.formatArg list option
-
-
-(** Deconstructs an instruction based on the program. Produces an optional
- * list of format arguments. The parsing of the string is memoized. *)
-val dInstr: string -> Cil.instr -> Cil.formatArg list option
-
-
-(** If set then will not memoize the parsed patterns *)
-val noMemoize: bool ref
-
-(** Just a testing function *)
-val test: unit -> unit
diff --git a/cil/src/formatlex.mll b/cil/src/formatlex.mll
deleted file mode 100644
index 584a060d52011a75490cfb4aec12811e7558616d..0000000000000000000000000000000000000000
--- a/cil/src/formatlex.mll
+++ /dev/null
@@ -1,308 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-(* A simple lexical analyzer for constructing CIL based on format strings *)
-{
-open Formatparse
-exception Eof
-exception InternalError of string
-module H = Hashtbl
-module E = Errormsg
-(*
-** Keyword hashtable
-*)
-let keywords = H.create 211
-
-(*
-** Useful primitives
-*)
-let scan_ident id =
- try H.find keywords id
- with Not_found -> IDENT id (* default to variable name *)
-
-(*
-** Buffer processor
-*)
-
-
-let init ~(prog: string) : Lexing.lexbuf =
- H.clear keywords;
- Lexerhack.currentPattern := prog;
- List.iter
- (fun (key, token) -> H.add keywords key token)
- [ ("const", CONST); ("__const", CONST); ("__const__", CONST);
- ("static", STATIC);
- ("extern", EXTERN);
- ("long", LONG);
- ("short", SHORT);
- ("signed", SIGNED);
- ("unsigned", UNSIGNED);
- ("volatile", VOLATILE);
- ("char", CHAR);
- ("int", INT);
- ("float", FLOAT);
- ("double", DOUBLE);
- ("void", VOID);
- ("enum", ENUM);
- ("struct", STRUCT);
- ("typedef", TYPEDEF);
- ("union", UNION);
- ("break", BREAK);
- ("continue", CONTINUE);
- ("goto", GOTO);
- ("return", RETURN);
- ("switch", SWITCH);
- ("case", CASE);
- ("default", DEFAULT);
- ("while", WHILE);
- ("do", DO);
- ("for", FOR);
- ("if", IF);
- ("else", ELSE);
- ("__attribute__", ATTRIBUTE); ("__attribute", ATTRIBUTE);
- ("__int64", INT64);
- ("__builtin_va_arg", BUILTIN_VA_ARG);
- ];
- E.startParsingFromString prog
-
-let finish () =
- E.finishParsing ()
-
-(*** Error handling ***)
-let error msg =
- E.parse_error msg
-
-
-(*** escape character management ***)
-let scan_escape str =
- match str with
- "n" -> "\n"
- | "r" -> "\r"
- | "t" -> "\t"
- | "b" -> "\b"
- | "f" -> "\012" (* ASCII code 12 *)
- | "v" -> "\011" (* ASCII code 11 *)
- | "a" -> "\007" (* ASCII code 7 *)
- | "e" -> "\027" (* ASCII code 27. This is a GCC extension *)
- | _ -> str
-
-let get_value chr =
- match chr with
- '0'..'9' -> (Char.code chr) - (Char.code '0')
- | 'a'..'z' -> (Char.code chr) - (Char.code 'a') + 10
- | 'A'..'Z' -> (Char.code chr) - (Char.code 'A') + 10
- | _ -> 0
-let scan_hex_escape str =
- String.make 1 (Char.chr (
- (get_value (String.get str 0)) * 16
- + (get_value (String.get str 1))
- ))
-let scan_oct_escape str =
- (* weimer: wide-character constants like L'\400' may be bigger than
- * 256 (in fact, may be up to 511), so Char.chr cannot be used directly *)
- let the_value = (get_value (String.get str 0)) * 64
- + (get_value (String.get str 1)) * 8
- + (get_value (String.get str 2)) in
- if the_value < 256 then String.make 1 (Char.chr the_value )
- else (String.make 1 (Char.chr (the_value / 256))) ^
- (String.make 1 (Char.chr (the_value mod 256)))
-
-(* ISO standard locale-specific function to convert a wide character
- * into a sequence of normal characters. Here we work on strings.
- * We convert L"Hi" to "H\000i\000" *)
-let wbtowc wstr =
- let len = String.length wstr in
- let dest = String.make (len * 2) '\000' in
- for i = 0 to len-1 do
- dest.[i*2] <- wstr.[i] ;
- done ;
- dest
-
-(* This function converst the "Hi" in L"Hi" to { L'H', L'i', L'\0' } *)
-let wstr_to_warray wstr =
- let len = String.length wstr in
- let res = ref "{ " in
- for i = 0 to len-1 do
- res := !res ^ (Printf.sprintf "L'%c', " wstr.[i])
- done ;
- res := !res ^ "}" ;
- !res
-
-let getArgName (l: Lexing.lexbuf) (prefixlen: int) =
- let lexeme = Lexing.lexeme l in
- let ll = String.length lexeme in
- if ll > prefixlen then
- String.sub lexeme (prefixlen + 1) (ll - prefixlen - 1)
- else
- ""
-}
-
-let decdigit = ['0'-'9']
-let octdigit = ['0'-'7']
-let hexdigit = ['0'-'9' 'a'-'f' 'A'-'F']
-let letter = ['a'- 'z' 'A'-'Z']
-
-let floatsuffix = ['f' 'F' 'l' 'L']
-
-let usuffix = ['u' 'U']
-let lsuffix = "l"|"L"|"ll"|"LL"
-let intsuffix = lsuffix | usuffix | usuffix lsuffix | lsuffix usuffix
-
-let intnum = decdigit+ intsuffix?
-let octnum = '0' octdigit+ intsuffix?
-let hexnum = '0' ['x' 'X'] hexdigit+ intsuffix?
-
-let exponent = ['e' 'E']['+' '-']? decdigit+
-let fraction = '.' decdigit+
-let floatraw = (intnum? fraction)
- |(intnum exponent)
- |(intnum? fraction exponent)
- |(intnum '.')
- |(intnum '.' exponent)
-let floatnum = floatraw floatsuffix?
-
-let ident = (letter|'_')(letter|decdigit|'_')*
-let attribident = (letter|'_')(letter|decdigit|'_'|':')
-let blank = [' ' '\t' '\012' '\r']
-let escape = '\\' _
-let hex_escape = '\\' ['x' 'X'] hexdigit hexdigit
-let oct_escape = '\\' octdigit octdigit octdigit
-
-
-(* The arguments are of the form %l:foo *)
-let argname = ':' ident
-
-rule initial =
- parse blank { initial lexbuf}
-| "/*" { let _ = comment lexbuf in
- initial lexbuf}
-| "//" { endline lexbuf }
-| "\n" { E.newline (); initial lexbuf}
-| floatnum {CST_FLOAT (Lexing.lexeme lexbuf)}
-| hexnum {CST_INT (Lexing.lexeme lexbuf)}
-| octnum {CST_INT (Lexing.lexeme lexbuf)}
-| intnum {CST_INT (Lexing.lexeme lexbuf)}
-
-| "<<=" {INF_INF_EQ}
-| ">>=" {SUP_SUP_EQ}
-| "*=" {STAR_EQ}
-| "/=" {SLASH_EQ}
-| "&=" {AND_EQ}
-| "|=" {PIPE_EQ}
-| "^=" {CIRC_EQ}
-| "%=" {PERCENT_EQ}
-
-
-| "..." {ELLIPSIS}
-| "-=" {MINUS_EQ}
-| "+=" {PLUS_EQ}
-| "*=" {STAR_EQ}
-| "<<" {INF_INF}
-| ">>" {SUP_SUP}
-| "==" {EQ_EQ}
-| "!=" {EXCLAM_EQ}
-| "<=" {INF_EQ}
-| ">=" {SUP_EQ}
-| "=" {EQ}
-| "<" {INF}
-| ">" {SUP}
-| "++" {PLUS_PLUS}
-| "--" {MINUS_MINUS}
-| "->" {ARROW}
-| '+' {PLUS}
-| '-' {MINUS}
-| '*' {STAR}
-| '/' {SLASH}
-| '!' {EXCLAM}
-| '&' {AND}
-| '|' {PIPE}
-| '^' {CIRC}
-| '~' {TILDE}
-| '[' {LBRACKET}
-| ']' {RBRACKET}
-| '{' {LBRACE}
-| '}' {RBRACE}
-| '(' {LPAREN}
-| ')' {RPAREN}
-| ';' {SEMICOLON}
-| ',' {COMMA}
-| '.' {DOT}
-| ':' {COLON}
-| '?' {QUEST}
-| "sizeof" {SIZEOF}
-
-| "%eo" argname {ARG_eo (getArgName lexbuf 3) }
-| "%e" argname {ARG_e (getArgName lexbuf 2) }
-| "%E" argname {ARG_E (getArgName lexbuf 2) }
-| "%u" argname {ARG_u (getArgName lexbuf 2) }
-| "%b" argname {ARG_b (getArgName lexbuf 2) }
-| "%t" argname {ARG_t (getArgName lexbuf 2) }
-| "%d" argname {ARG_d (getArgName lexbuf 2) }
-| "%lo" argname {ARG_lo (getArgName lexbuf 3) }
-| "%l" argname {ARG_l (getArgName lexbuf 2) }
-| "%i" argname {ARG_i (getArgName lexbuf 2) }
-| "%I" argname {ARG_I (getArgName lexbuf 2) }
-| "%o" argname {ARG_o (getArgName lexbuf 2) }
-| "%va" argname {ARG_va (getArgName lexbuf 3) }
-| "%v" argname {ARG_v (getArgName lexbuf 2) }
-| "%k" argname {ARG_k (getArgName lexbuf 2) }
-| "%f" argname {ARG_f (getArgName lexbuf 2) }
-| "%F" argname {ARG_F (getArgName lexbuf 2) }
-| "%p" argname {ARG_p (getArgName lexbuf 2) }
-| "%P" argname {ARG_P (getArgName lexbuf 2) }
-| "%s" argname {ARG_s (getArgName lexbuf 2) }
-| "%S" argname {ARG_S (getArgName lexbuf 2) }
-| "%g" argname {ARG_g (getArgName lexbuf 2) }
-| "%A" argname {ARG_A (getArgName lexbuf 2) }
-| "%c" argname {ARG_c (getArgName lexbuf 2) }
-
-| '%' {PERCENT}
-| ident {scan_ident (Lexing.lexeme lexbuf)}
-| eof {EOF}
-| _ {E.parse_error
- "Formatlex: Invalid symbol"
- }
-
-and comment =
- parse
- "*/" { () }
-| '\n' { E.newline (); comment lexbuf }
-| _ { comment lexbuf }
-
-
-and endline = parse
- '\n' { E.newline (); initial lexbuf}
-| _ { endline lexbuf}
diff --git a/cil/src/formatparse.mly b/cil/src/formatparse.mly
deleted file mode 100644
index 75bdbb33e73a8e349b119bbccf84ddfc668df0de..0000000000000000000000000000000000000000
--- a/cil/src/formatparse.mly
+++ /dev/null
@@ -1,1455 +0,0 @@
-/* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. */
-
-/*(* Parser for constructing CIL from format strings *)
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-*/
-%{
-open Cil
-open Pretty
-module E = Errormsg
-
-let parse_error msg : 'a = (* sm: c++-mode highlight hack: -> ' <- *)
- E.hadErrors := true;
- E.parse_error
- msg
-
-
-let getArg (argname: string) (args: (string * formatArg) list) =
- try
- snd (List.find (fun (n, a) -> n = argname) args)
- with _ ->
- E.s (error "Pattern string %s does not have argument with name %s\n"
- !Lexerhack.currentPattern argname)
-
-let wrongArgType (which: string) (expected: string) (found: formatArg) =
- E.s (bug "Expecting %s argument (%s) and found %a\n"
- expected which d_formatarg found)
-
-let doUnop (uo: unop) subexp =
- ((fun args ->
- let e = (fst subexp) args in
- UnOp(uo, e, typeOf e)),
-
- (fun e -> match e with
- UnOp(uo', e', _) when uo = uo' -> (snd subexp) e'
- | _ -> None))
-
-let buildPlus e1 e2 : exp =
- let t1 = typeOf e1 in
- if isPointerType t1 then
- BinOp(PlusPI, e1, e2, t1)
- else
- BinOp(PlusA, e1, e2, t1)
-
-let buildMinus e1 e2 : exp =
- let t1 = typeOf e1 in
- let t2 = typeOf e2 in
- if isPointerType t1 then
- if isPointerType t2 then
- BinOp(MinusPP, e1, e2, intType)
- else
- BinOp(MinusPI, e1, e2, t1)
- else
- BinOp(MinusA, e1, e2, t1)
-
-let doBinop bop e1t e2t =
- ((fun args ->
- let e1 = (fst e1t) args in
- let e2 = (fst e2t) args in
- let t1 = typeOf e1 in
- BinOp(bop, e1, e2, t1)),
-
- (fun e -> match e with
- BinOp(bop', e1, e2, _) when bop' = bop -> begin
- match (snd e1t) e1, (snd e2t) e2 with
- Some m1, Some m2 -> Some (m1 @ m2)
- | _, _ -> None
- end
- | _ -> None))
-
-(* Check the equivalence of two format lists *)
-let rec checkSameFormat (fl1: formatArg list) (fl2: formatArg list) =
- match fl1, fl2 with
- [], [] -> true
- | h1::t1, h2::t2 -> begin
- let rec checkOffsetEq o1 o2 =
- match o1, o2 with
- NoOffset, NoOffset -> true
- | Field(f1, o1'), Field(f2, o2') ->
- f1.fname = f2.fname && checkOffsetEq o1' o2'
- | Index(e1, o1'), Index(e2, o2') ->
- checkOffsetEq o1' o2' && checkExpEq e1 e2
- | _, _ -> false
-
- and checkExpEq e1 e2 =
- match e1, e2 with
- Const(CInt64(n1, _, _)), Const(CInt64(n2, _, _)) -> n1 = n2
- | Lval l1, Lval l2 -> checkLvalEq l1 l2
- | UnOp(uo1, e1, _), UnOp(uo2, e2, _) ->
- uo1 = uo2 && checkExpEq e1 e2
- | BinOp(bo1, e11, e12, _), BinOp(bo2, e21, e22, _) ->
- bo1 = bo2 && checkExpEq e11 e21 && checkExpEq e21 e22
- | AddrOf l1, AddrOf l2 -> checkLvalEq l1 l2
- | StartOf l1, StartOf l2 -> checkLvalEq l1 l2
- | SizeOf t1, SizeOf t2 -> typeSig t1 = typeSig t2
- | _, _ ->
- ignore (E.warn "checkSameFormat for Fe"); false
-
- and checkLvalEq l1 l2 =
- match l1, l2 with
- (Var v1, o1), (Var v2, o2) -> v1 == v2 && checkOffsetEq o1 o2
- | (Mem e1, o1), (Mem e2, o2) ->
- checkOffsetEq o1 o2 && checkExpEq e1 e2
- | _, _ -> false
- in
- let hdeq =
- match h1, h2 with
- Fv v1, Fv v2 -> v1 == v2
- | Fd n1, Fd n2 -> n1 = n2
- | Fe e1, Fe e2 -> checkExpEq e1 e2
- | Fi i1, Fi i2 -> ignore (E.warn "checkSameFormat for Fi"); false
- | Ft t1, Ft t2 -> typeSig t1 = typeSig t2
- | Fl l1, Fl l2 -> checkLvalEq l1 l2
- | Fo o1, Fo o2 -> checkOffsetEq o1 o2
- | Fc c1, Fc c2 -> c1 == c2
- | _, _ -> false
- in
- hdeq || checkSameFormat t1 t2
- end
- | _, _ -> false
-
-let matchBinopEq (bopeq: binop -> bool) lvt et =
- (fun i -> match i with
- Set (lv, BinOp(bop', Lval (lv'), e', _), l) when bopeq bop' -> begin
- match lvt lv, lvt lv', et e' with
- Some m1, Some m1', Some m2 ->
- (* Must check that m1 and m2 are the same *)
- if checkSameFormat m1 m1' then
- Some (m1 @ m2)
- else
- None
- | _, _, _ -> None
- end
- | _ -> None)
-
-let doBinopEq bop lvt et =
- ((fun loc args ->
- let l = (fst lvt) args in
- Set(l, BinOp(bop, (Lval l), (fst et) args, typeOfLval l), loc)),
-
- matchBinopEq (fun bop' -> bop = bop') (snd lvt) (snd et))
-
-
-let getField (bt: typ) (fname: string) : fieldinfo =
- match unrollType bt with
- TComp(ci, _) -> begin
- try
- List.find (fun f -> fname = f.fname) ci.cfields
- with Not_found ->
- E.s (bug "Cannot find field %s in %s\n" fname (compFullName ci))
- end
- | t -> E.s (bug "Trying to access field %s in non-struct\n" fname)
-
-
-let matchIntType (ik: ikind) (t:typ) : formatArg list option =
- match unrollType t with
- TInt(ik', _) when ik = ik' -> Some []
- | _ -> None
-
-let matchFloatType (fk: fkind) (t:typ) : formatArg list option =
- match unrollType t with
- TFloat(fk', _) when fk = fk' -> Some []
- | _ -> None
-
-let doAttr (id: string)
- (aargs: (((string * formatArg) list -> attrparam list) *
- (attrparam list -> formatArg list option)) option)
- =
- let t = match aargs with
- Some t -> t
- | None -> (fun _ -> []),
- (function [] -> Some [] | _ -> None)
- in
- ((fun args -> Attr (id, (fst t) args)),
-
- (fun attrs ->
- (* Find the attributes with the same ID *)
- List.fold_left
- (fun acc a ->
- match acc, a with
- Some _, _ -> acc (* We found one already *)
- | None, Attr(id', args) when id = id' ->
- (* Now match the arguments *)
- (snd t) args
- | None, _ -> acc)
- None
- attrs))
-
-
-type falist = formatArg list
-
-type maybeInit =
- NoInit
- | InitExp of exp
- | InitCall of lval * exp list
-
-%}
-
-%token <string> IDENT
-%token <string> CST_CHAR
-%token <string> CST_INT
-%token <string> CST_FLOAT
-%token <string> CST_STRING
-%token <string> CST_WSTRING
-%token <string> NAMED_TYPE
-
-%token EOF
-%token CHAR INT DOUBLE FLOAT VOID INT64 INT32
-%token ENUM STRUCT TYPEDEF UNION
-%token SIGNED UNSIGNED LONG SHORT
-%token VOLATILE EXTERN STATIC CONST RESTRICT AUTO REGISTER
-
-%token <string> ARG_e ARG_eo ARG_E ARG_u ARG_b ARG_t ARG_d ARG_lo ARG_l ARG_i
-%token <string> ARG_o ARG_va ARG_f ARG_F ARG_A ARG_v ARG_k ARG_c ARG_d
-%token <string> ARG_s ARG_p ARG_P ARG_I ARG_S ARG_g
-
-%token SIZEOF ALIGNOF
-
-%token EQ
-%token ARROW DOT
-
-%token EQ_EQ EXCLAM_EQ INF SUP INF_EQ SUP_EQ
-%token MINUS_EQ PLUS_EQ STAR_EQ
-%token PLUS MINUS STAR SLASH PERCENT
-%token TILDE AND PIPE CIRC
-%token EXCLAM AND_AND PIPE_PIPE
-%token INF_INF SUP_SUP
-%token PLUS_PLUS MINUS_MINUS
-
-%token RPAREN LPAREN RBRACE LBRACE LBRACKET RBRACKET
-%token COLON SEMICOLON COMMA ELLIPSIS QUEST
-
-%token BREAK CONTINUE GOTO RETURN
-%token SWITCH CASE DEFAULT
-%token WHILE DO FOR
-%token IF THEN ELSE
-
-%token PLUS_EQ MINUS_EQ STAR_EQ SLASH_EQ PERCENT_EQ
-%token AND_EQ PIPE_EQ CIRC_EQ INF_INF_EQ SUP_SUP_EQ
-
-%token ATTRIBUTE INLINE ASM TYPEOF FUNCTION__ PRETTY_FUNCTION__ LABEL__
-%token BUILTIN_VA_ARG BUILTIN_VA_LIST
-%token BLOCKATTRIBUTE
-%token DECLSPEC
-%token <string> MSASM MSATTR
-%token PRAGMA
-
-
-/* operator precedence */
-%nonassoc IF
-%nonassoc ELSE
-
-
-%left COMMA
-
- /*(* Set the following precedences higer than COMMA *)*/
-%nonassoc ARG_e ARG_d ARG_lo ARG_l ARG_i ARG_v ARG_I ARG_g
-%right EQ PLUS_EQ MINUS_EQ STAR_EQ SLASH_EQ PERCENT_EQ
- AND_EQ PIPE_EQ CIRC_EQ INF_INF_EQ SUP_SUP_EQ
-%right COLON
-%left PIPE_PIPE
-%left AND_AND
-%left ARG_b
-%left PIPE
-%left CIRC
-%left AND
-%left EQ_EQ EXCLAM_EQ
-%left INF SUP INF_EQ SUP_EQ
-%left INF_INF SUP_SUP
-%left PLUS MINUS
-%left STAR SLASH PERCENT CONST RESTRICT VOLATILE
-%right ARG_u EXCLAM TILDE PLUS_PLUS MINUS_MINUS CAST RPAREN ADDROF SIZEOF ALIGNOF
-%left LBRACKET
-%left DOT ARROW LPAREN LBRACE
-%nonassoc IDENT QUEST CST_INT
-
-%start initialize expression typename offset lval instr stmt stmt_list
-
-
-%type <unit> initialize
-%type <((string -> Cil.typ -> Cil.varinfo) -> Cil.location -> (string * Cil.formatArg) list -> Cil.stmt)> stmt
-%type <((string -> Cil.typ -> Cil.varinfo) -> Cil.location -> (string * Cil.formatArg) list -> Cil.stmt list)> stmt_list
-
-%type <((string * Cil.formatArg) list -> Cil.exp) * (Cil.exp -> Cil.formatArg list option)> expression
-
-%type <((string * Cil.formatArg) list -> Cil.exp) * (Cil.exp -> Cil.formatArg list option)> constant
-
-%type <((string * Cil.formatArg) list -> Cil.lval) * (Cil.lval -> Cil.formatArg list option)> lval
-
-%type <((string * Cil.formatArg) list -> Cil.typ) * (Cil.typ -> Cil.formatArg list option)> typename
-
-%type <(Cil.attributes -> (string * Cil.formatArg) list -> Cil.typ) * (Cil.typ -> Cil.formatArg list option)> type_spec
-
-%type <((string * Cil.formatArg) list -> (string * Cil.typ * Cil.attributes) list option * bool) * ((string * Cil.typ * Cil.attributes) list option * bool -> Cil.formatArg list option)> parameters
-
-
-%type <(Cil.location -> (string * Cil.formatArg) list -> Cil.instr) * (Cil.instr -> Cil.formatArg list option)> instr
-
-%type <(Cil.typ -> (string * Cil.formatArg) list -> Cil.offset) * (Cil.offset -> Cil.formatArg list option)> offset
-
-
-%%
-
-
-initialize:
- /* empty */ { }
-;
-
-/* (*** Expressions ***) */
-
-
-expression:
-| ARG_e { (* Count arguments eagerly *)
- let currentArg = $1 in
- ((fun args ->
- match getArg currentArg args with
- Fe e -> e
- | a -> wrongArgType currentArg
- "expression" a),
-
- (fun e -> Some [ Fe e ]))
- }
-
-| constant { $1 }
-
-| lval %prec IDENT
- { ((fun args -> Lval ((fst $1) args)),
-
- (fun e -> match e with
- Lval l -> (snd $1) l
- | _ -> None))
- }
-
-| SIZEOF expression
- { ((fun args -> SizeOfE ((fst $2) args)),
-
- fun e -> match e with
- SizeOfE e' -> (snd $2) e'
- | _ -> None)
- }
-
-| SIZEOF LPAREN typename RPAREN
- { ((fun args -> SizeOf ((fst $3) args)),
-
- (fun e -> match e with
- SizeOf t -> (snd $3) t
- | _ -> None))
- }
-
-| ALIGNOF expression
- { ((fun args -> AlignOfE ((fst $2) args)),
-
- (fun e -> match e with
- AlignOfE e' -> (snd $2) e' | _ -> None))
- }
-
-| ALIGNOF LPAREN typename RPAREN
- { ((fun args -> AlignOf ((fst $3) args)),
-
- (fun e -> match e with
- AlignOf t' -> (snd $3) t' | _ -> None))
- }
-
-| PLUS expression
- { $2 }
-| MINUS expression
- { doUnop Neg $2 }
-
-| EXCLAM expression
- { doUnop LNot $2 }
-
-| TILDE expression
- { doUnop BNot $2 }
-
-| argu expression %prec ARG_u
- { ((fun args ->
- let e = (fst $2) args in
- UnOp((fst $1) args, e, typeOf e)),
-
- (fun e -> match e with
- UnOp(uo, e', _) -> begin
- match (snd $1) uo, (snd $2) e' with
- Some m1, Some m2 -> Some (m1 @ m2)
- | _ -> None
- end
- | _ -> None))
- }
-
-
-| AND expression %prec ADDROF
- { ((fun args ->
- match (fst $2) args with
- Lval l -> mkAddrOf l
- | _ -> E.s (bug "AddrOf applied to a non lval")),
- (fun e -> match e with
- AddrOf l -> (snd $2) (Lval l)
- | e -> (snd $2) (Lval (mkMem e NoOffset))))
- }
-
-| LPAREN expression RPAREN
- { $2 }
-
-| expression PLUS expression
- { ((fun args -> buildPlus ((fst $1) args)
- ((fst $3) args)),
- (fun e -> match e with
- BinOp((PlusPI|PlusA), e1, e2, _) -> begin
- match (snd $1) e1, (snd $3) e2 with
- Some m1, Some m2 -> Some (m1 @ m2)
- | _, _ -> None
- end
- | _ -> None))
- }
-
-| expression MINUS expression
- { ((fun args -> buildMinus ((fst $1) args)
- ((fst $3) args)),
-
- (fun e -> match e with
- BinOp((MinusPP|MinusPI|MinusA), e1, e2, _) ->
- begin
- match (snd $1) e1, (snd $3) e2 with
- Some m1, Some m2 -> Some (m1 @ m2)
- | _, _ -> None
- end
- | _ -> None))
- }
-| expression argb expression %prec ARG_b
- { ((fun args ->
- let e1 = (fst $1) args in
- let bop = (fst $2) args in
- let e2 = (fst $3) args in
- let t1 = typeOf e1 in
- BinOp(bop, e1, e2, t1)),
-
- (fun e -> match e with
- BinOp(bop, e1, e2, _) -> begin
- match (snd $1) e1,(snd $2) bop,(snd $3) e2 with
- Some m1, Some m2, Some m3 ->
- Some (m1 @ m2 @ m3)
- | _, _, _ -> None
- end
- | _ -> None))
- }
-
-| expression STAR expression
- { doBinop Mult $1 $3 }
-| expression SLASH expression
- { doBinop Div $1 $3 }
-| expression PERCENT expression
- { doBinop Mod $1 $3 }
-| expression INF_INF expression
- { doBinop Shiftlt $1 $3 }
-| expression SUP_SUP expression
- { doBinop Shiftrt $1 $3 }
-| expression AND expression
- { doBinop BAnd $1 $3 }
-| expression PIPE expression
- { doBinop BOr $1 $3 }
-| expression CIRC expression
- { doBinop BXor $1 $3 }
-| expression EQ_EQ expression
- { doBinop Eq $1 $3 }
-| expression EXCLAM_EQ expression
- { doBinop Ne $1 $3 }
-| expression INF expression
- { doBinop Lt $1 $3 }
-| expression SUP expression
- { doBinop Gt $1 $3 }
-| expression INF_EQ expression
- { doBinop Le $1 $3 }
-| expression SUP_EQ expression
- { doBinop Ge $1 $3 }
-
-| LPAREN typename RPAREN expression
- { ((fun args ->
- let t = (fst $2) args in
- let e = (fst $4) args in
- mkCast e t),
-
- (fun e ->
- let t', e' =
- match e with
- CastE (t', e') -> t', e'
- | _ -> typeOf e, e
- in
- match (snd $2) t', (snd $4 e') with
- Some m1, Some m2 -> Some (m1 @ m2)
- | _, _ -> None))
- }
-;
-
-/*(* Separate the ARG_ to ensure that the counting of arguments is right *)*/
-argu :
-| ARG_u { let currentArg = $1 in
- ((fun args ->
- match getArg currentArg args with
- Fu uo -> uo
- | a -> wrongArgType currentArg "unnop" a),
-
- fun uo -> Some [ Fu uo ])
- }
-;
-
-argb :
-| ARG_b { let currentArg = $1 in
- ((fun args ->
- match getArg currentArg args with
- Fb bo -> bo
- | a -> wrongArgType currentArg "binop" a),
-
- fun bo -> Some [ Fb bo ])
- }
-;
-
-constant:
-| ARG_d { let currentArg = $1 in
- ((fun args ->
- match getArg currentArg args with
- Fd n -> integer n
- | a -> wrongArgType currentArg "integer" a),
-
- fun e -> match e with
- Const(CInt64(n, _, _)) ->
- Some [ Fd (Int64.to_int n) ]
- | _ -> None)
- }
-
-| ARG_g { let currentArg = $1 in
- ((fun args ->
- match getArg currentArg args with
- Fg s -> Const(CStr s)
- | a -> wrongArgType currentArg "string" a),
-
- fun e -> match e with
- Const(CStr s) ->
- Some [ Fg s ]
- | _ -> None)
- }
-| CST_INT { let n = parseInt $1 in
- ((fun args -> n),
-
- (fun e -> match e, n with
- Const(CInt64(e', _, _)),
- Const(CInt64(n', _, _)) when e' = n' -> Some []
- | _ -> None))
- }
-;
-
-
-/*(***************** LVALUES *******************)*/
-lval:
-| ARG_l { let currentArg = $1 in
- ((fun args ->
- match getArg currentArg args with
- Fl l -> l
- | Fv v -> Var v, NoOffset
- | a -> wrongArgType currentArg "lval" a),
-
- fun l -> Some [ Fl l ])
- }
-
-| argv offset %prec ARG_v
- { ((fun args ->
- let v = (fst $1) args in
- (Var v, (fst $2) v.vtype args)),
-
- (fun l -> match l with
- Var vi, off -> begin
- match (snd $1) vi, (snd $2) off with
- Some m1, Some m2 -> Some (m1 @ m2)
- | _ -> None
- end
- | _ -> None))
- }
-
-| STAR expression { ((fun args -> mkMem ((fst $2) args) NoOffset),
-
- (fun l -> match l with
- Mem e, NoOffset -> (snd $2) e
- | _, _ -> None))
- }
-
-| expression ARROW IDENT offset
- { ((fun args ->
- let e = (fst $1) args in
- let baset =
- match unrollTypeDeep (typeOf e) with
- TPtr (t, _) -> t
- | _ -> E.s (bug "Expecting a pointer for field %s\n" $3)
- in
- let fi = getField baset $3 in
- mkMem e (Field(fi, (fst $4) fi.ftype args))),
-
- (fun l -> match l with
- Mem e, Field(fi, off) when fi.fname = $3 -> begin
- match (snd $1) e, (snd $4) off with
- Some m1, Some m2 -> Some (m1 @ m2)
- | _, _ -> None
- end
- | _, _ -> None))
- }
-
-| LPAREN STAR expression RPAREN offset
- { ((fun args ->
- let e = (fst $3) args in
- let baset =
- match unrollTypeDeep (typeOf e) with
- TPtr (t, _) -> t
- | _ -> E.s (bug "Expecting a pointer\n")
- in
- mkMem e ((fst $5) baset args)),
-
- (fun l -> match l with
- Mem e, off -> begin
- match (snd $3) e, (snd $5 off) with
- Some m1, Some m2 -> Some (m1 @ m2)
- | _, _ -> None
- end
- | _, _ -> None))
- }
- ;
-
-argv :
-| ARG_v { let currentArg = $1 in
- ((fun args ->
- match getArg currentArg args with
- Fv v -> v
- | a -> wrongArgType currentArg "varinfo" a),
-
- fun v -> Some [ Fv v ])
- }
-| IDENT { let currentArg = $1 in
- ((fun args ->
- match getArg currentArg args with
- Fv v -> v
- | a -> wrongArgType currentArg "varinfo" a),
- (fun v ->
- E.s (bug "identifiers (%s) are not supported for deconstruction" currentArg)))
- }
-;
-
-
-/*(********** OFFSETS *************)*/
-offset:
-| ARG_o { let currentArg = $1 in
- ((fun t args ->
- match getArg currentArg args with
- Fo o -> o
- | a -> wrongArgType currentArg "offset" a),
-
- (fun off -> Some [ Fo off ]))
- }
-
-| /* empty */ { ((fun t args -> NoOffset),
-
- (fun off -> match off with
- NoOffset -> Some []
- | _ -> None))
- }
-
-| DOT IDENT offset { ((fun t args ->
- let fi = getField t $2 in
- Field (fi, (fst $3) fi.ftype args)),
-
- (fun off -> match off with
- Field (fi, off') when fi.fname = $2 ->
- (snd $3) off'
- | _ -> None))
- }
-
-| LBRACKET expression RBRACKET offset
- { ((fun t args ->
- let bt =
- match unrollType t with
- TArray(bt, _, _) -> bt
- | _ -> E.s (error "Formatcil: expecting an array for index")
- in
- let e = (fst $2) args in
- Index(e, (fst $4) bt args)),
-
- (fun off -> match off with
- Index (e, off') -> begin
- match (snd $2) e, (snd $4) off with
- Some m1, Some m2 -> Some (m1 @ m2)
- | _, _ -> None
- end
- | _ -> None))
- }
-;
-
-
-/*(************ TYPES **************)*/
-typename: one_formal { ((fun args ->
- let (_, ft, _) = (fst $1) args in
- ft),
-
- (fun t -> (snd $1) ("", t, [])))
- }
-;
-
-one_formal:
-/*(* Do not allow attributes for the name *)*/
-| type_spec attributes decl
- { ((fun args ->
- let tal = (fst $2) args in
- let ts = (fst $1) tal args in
- let (fn, ft, _) = (fst $3) ts args in
- (fn, ft, [])),
-
- (fun (fn, ft, fa) ->
- match (snd $3) (fn, ft) with
- Some (restt, m3) -> begin
- match (snd $1) restt,
- (snd $2) (typeAttrs restt)with
- Some m1, Some m2 ->
- Some (m1 @ m2 @ m3)
- | _, _ -> None
- end
- | _ -> None))
- }
-
-| ARG_f
- { let currentArg = $1 in
- ((fun args ->
- match getArg currentArg args with
- Ff (fn, ft, fa) -> (fn, ft, fa)
- | a -> wrongArgType currentArg "formal" a),
-
- (fun (fn, ft, fa) -> Some [ Ff (fn, ft, fa) ]))
- }
-;
-
-type_spec:
-| ARG_t { let currentArg = $1 in
- ((fun al args ->
- match getArg currentArg args with
- Ft t -> typeAddAttributes al t
- | a -> wrongArgType currentArg "type" a),
-
- (fun t -> Some [ Ft t ]))
- }
-
-| VOID { ((fun al args -> TVoid al),
-
- (fun t -> match unrollType t with
- TVoid _ -> Some []
- | _ -> None)) }
-
-| ARG_k { let currentArg = $1 in
- ((fun al args ->
- match getArg currentArg args with
- Fk ik -> TInt(ik, al)
- | a -> wrongArgType currentArg "ikind" a),
-
- (fun t -> match unrollType t with
- TInt(ik, _) -> Some [ Fk ik ]
- | _ -> None))
- }
-
-| CHAR { ((fun al args -> TInt(IChar, al)),
- (matchIntType IChar)) }
-| UNSIGNED CHAR { ((fun al args -> TInt(IUChar, al)),
- matchIntType IUChar) }
-
-| SHORT { ((fun al args -> TInt(IShort, al)),
- matchIntType IShort) }
-| UNSIGNED SHORT { ((fun al args -> TInt(IUShort, al)),
- matchIntType IUShort) }
-
-| INT { ((fun al args -> TInt(IInt, al)),
- matchIntType IInt) }
-| UNSIGNED INT { ((fun al args -> TInt(IUInt, al)), matchIntType IUInt) }
-
-| LONG { ((fun al args -> TInt(ILong, al)),
- matchIntType ILong) }
-| UNSIGNED LONG { ((fun al args -> TInt(IULong, al)),
- matchIntType IULong) }
-
-| LONG LONG { ((fun al args -> TInt(ILongLong, al)),
-
- matchIntType ILongLong)
- }
-| UNSIGNED LONG LONG { ((fun al args -> TInt(IULongLong, al)),
-
- matchIntType IULongLong)
- }
-
-| FLOAT { ((fun al args -> TFloat(FFloat, al)),
- matchFloatType FFloat)
- }
-| DOUBLE { ((fun al args -> TFloat(FDouble, al)),
- matchFloatType FDouble) }
-
-| STRUCT ARG_c { let currentArg = $2 in
- ((fun al args ->
- match getArg currentArg args with
- Fc ci -> TComp(ci, al)
- | a -> wrongArgType currentArg "compinfo" a),
-
- (fun t -> match unrollType t with
- TComp(ci, _) -> Some [ Fc ci ]
- | _ -> None))
- }
-| UNION ARG_c { let currentArg = $2 in
- ((fun al args ->
- match getArg currentArg args with
- Fc ci -> TComp(ci, al)
- | a -> wrongArgType currentArg "compinfo" a),
-
- (fun t -> match unrollType t with
- TComp(ci, _) -> Some [ Fc ci ]
- | _ -> None))
-
- }
-
-| TYPEOF LPAREN expression RPAREN
- { ((fun al args -> typeAddAttributes al
- (typeOf ((fst $3) args))),
-
- (fun t -> E.s (bug "Cannot match typeof(e)\n")))
- }
-;
-
-decl:
-| STAR attributes decl
- { ((fun ts args ->
- let al = (fst $2) args in
- (fst $3) (TPtr(ts, al)) args),
-
- (fun (fn, ft) ->
- match (snd $3) (fn, ft) with
- Some (TPtr(bt, al), m2) -> begin
- match (snd $2) al with
- Some m1 -> Some (bt, m1 @ m2)
- | _ -> None
- end
- | _ -> None))
- }
-
-| direct_decl { $1 }
-;
-
-direct_decl:
-| /* empty */ { ((fun ts args -> ("", ts, [])),
-
- (* Match any name in this case *)
- (fun (fn, ft) ->
- Some (unrollType ft, [])))
- }
-
-| IDENT { ((fun ts args -> ($1, ts, [])),
-
- (fun (fn, ft) ->
- if fn = "" || fn = $1 then
- Some (unrollType ft, [])
- else
- None))
- }
-
-| LPAREN attributes decl RPAREN
- { ((fun ts args ->
- let al = (fst $2) args in
- (fst $3) (typeAddAttributes al ts) args),
-
- (fun (fn, ft) -> begin
- match (snd $3) (fn, ft) with
- Some (restt, m2) -> begin
- match (snd $2) (typeAttrs restt) with
- Some m1 -> Some (restt, m1 @ m2)
- | _ -> None
- end
- | _ -> None
- end))
- }
-
-| direct_decl LBRACKET exp_opt RBRACKET
- { ((fun ts args ->
- (fst $1) (TArray(ts, (fst $3) args, [])) args),
-
- (fun (fn, ft) ->
- match (snd $1) (fn, ft) with
- Some (TArray(bt, lo, _), m1) -> begin
- match (snd $3) lo with
- Some m2 -> Some (unrollType bt, m1 @ m2)
- | _ -> None
- end
- | _ -> None))
- }
-
-
-/*(* We use parentheses around the function to avoid conflicts *)*/
-| LPAREN attributes decl RPAREN LPAREN parameters RPAREN
- { ((fun ts args ->
- let al = (fst $2) args in
- let pars, isva = (fst $6) args in
- (fst $3) (TFun(ts, pars, isva, al)) args),
-
- (fun (fn, ft) ->
- match (snd $3) (fn, ft) with
- Some (TFun(rt, args, isva, al), m1) -> begin
- match (snd $2) al, (snd $6) (args, isva) with
- Some m2, Some m6
- -> Some (unrollType rt, m1 @ m2 @ m6)
- | _ -> None
- end
- | _ -> None))
- }
-;
-
-parameters:
-| /* empty */ { ((fun args -> (None, false)),
-
- (* Match any formals *)
- (fun (pars, isva) ->
- match pars, isva with
- (_, false) -> Some []
- | _ -> None))
- }
-
-| parameters_ne { ((fun args ->
- let (pars : (string * typ * attributes) list),
- (isva : bool) = (fst $1) args in
- (Some pars), isva),
-
- (function
- ((Some pars), isva) -> (snd $1) (pars, isva)
- | _ -> None))
- }
-;
-parameters_ne:
-| ELLIPSIS
- { ((fun args -> ([], true)),
-
- (function
- ([], true) -> Some []
- | _ -> None))
- }
-
-| ARG_va { let currentArg = $1 in
- ((fun args ->
- match getArg currentArg args with
- Fva isva -> ([], isva)
- | a -> wrongArgType currentArg "vararg" a),
-
- (function
- ([], isva) -> Some [ Fva isva ]
- | _ -> None))
- }
-
-| ARG_F { let currentArg = $1 in
- ((fun args ->
- match getArg currentArg args with
- FF fl -> ( fl, false)
- | a -> wrongArgType currentArg "formals" a),
-
- (function
- (pars, false) -> Some [ FF pars ]
- | _ -> None))
- }
-
-| one_formal { ((fun args -> ([(fst $1) args], false)),
-
- (function
- ([ f ], false) -> (snd $1) f
- | _ -> None))
- }
-
-
-| one_formal COMMA parameters_ne
- { ((fun args ->
- let this = (fst $1) args in
- let (rest, isva) = (fst $3) args in
- (this :: rest, isva)),
-
- (function
- ((f::rest, isva)) -> begin
- match (snd $1) f, (snd $3) (rest, isva) with
- Some m1, Some m2 -> Some (m1 @ m2)
- | _, _ -> None
- end
- | _ -> None))
- }
-;
-
-
-
-
-
-exp_opt:
- /* empty */ { ((fun args -> None),
- (* Match anything if the pattern does not have a len *)
- (fun _ -> Some [])) }
-
-| expression { ((fun args -> Some ((fst $1) args)),
-
- (fun lo -> match lo with
- Some e -> (snd $1) e
- | _ -> None))
- }
-| ARG_eo { let currentArg = $1 in
- ((fun args ->
- match getArg currentArg args with
- Feo lo -> lo
- | a -> wrongArgType currentArg "exp_opt" a),
-
- fun lo -> Some [ Feo lo ])
- }
-;
-
-
-
-attributes:
- /*(* Ignore other attributes *)*/
- /* empty */ { ((fun args -> []),
- (fun attrs -> Some [])) }
-
-| ARG_A { let currentArg = $1 in
- ((fun args ->
- match getArg currentArg args with
- FA al -> al
- | a -> wrongArgType currentArg "attributes" a),
-
- (fun al -> Some [ FA al ]))
- }
-
-| attribute attributes
- { ((fun args ->
- addAttribute ((fst $1) args) ((fst $2) args)),
- (* Pass all the attributes down *)
- (fun attrs ->
- match (snd $1) attrs, (snd $2) attrs with
- Some m1, Some m2 -> Some (m1 @ m2)
- | _, _ -> None))
- }
-;
-
-attribute:
-| CONST { doAttr "const" None }
-| RESTRICT { doAttr "restrict" None }
-| VOLATILE { doAttr "volatile" None }
-| ATTRIBUTE LPAREN LPAREN attr RPAREN RPAREN
- { $4 }
-
-;
-
-
-attr:
-| IDENT
- { doAttr $1 None }
-
-| IDENT LPAREN attr_args_ne RPAREN
- { doAttr $1 (Some $3) }
-;
-
-attr_args_ne:
- attr_arg { ((fun args -> [ (fst $1) args ]),
-
- (fun aargs -> match aargs with
- [ arg ] -> (snd $1) arg
- | _ -> None))
- }
-| attr_arg COMMA attr_args_ne { ((fun args ->
- let this = (fst $1) args in
- this :: ((fst $3) args)),
-
- (fun aargs -> match aargs with
- h :: rest -> begin
- match (snd $1) h, (snd $3) rest with
- Some m1, Some m2 -> Some (m1 @ m2)
- | _, _ -> None
- end
- | _ -> None))
- }
-| ARG_P { let currentArg = $1 in
- ((fun args ->
- match getArg currentArg args with
- FP al -> al
- | a -> wrongArgType currentArg "attrparams" a),
-
- (fun al -> Some [ FP al ]))
- }
-;
-
-attr_arg:
-| IDENT { ((fun args -> ACons($1, [])),
-
- (fun aarg -> match aarg with
- ACons(id, []) when id = $1 -> Some []
- | _ -> None))
- }
-| IDENT LPAREN attr_args_ne RPAREN
- { ((fun args -> ACons($1, (fst $3) args)),
-
- (fun aarg -> match aarg with
- ACons(id, args) when id = $1 ->
- (snd $3) args
- | _ -> None))
- }
-| ARG_p { let currentArg = $1 in
- ((fun args ->
- match getArg currentArg args with
- Fp p -> p
- | a -> wrongArgType currentArg "attrparam" a),
-
- (fun ap -> Some [ Fp ap]))
- }
-
-;
-
-/* (********** INSTRUCTIONS ***********) */
-instr:
-| ARG_i SEMICOLON
- { let currentArg = $1 in
- ((fun loc args ->
- match getArg currentArg args with
- Fi i -> i
- | a -> wrongArgType currentArg "instr" a),
-
- (fun i -> Some [ Fi i]))
- }
-
-| lval EQ expression SEMICOLON
- { ((fun loc args ->
- Set((fst $1) args, (fst $3) args, loc)),
-
- (fun i -> match i with
- Set (lv, e, l) -> begin
- match (snd $1) lv, (snd $3) e with
- Some m1, Some m2 -> Some (m1 @ m2)
- | _, _ -> None
- end
- | _ -> None))
- }
-
-| lval PLUS_EQ expression SEMICOLON
- { ((fun loc args ->
- let l = (fst $1) args in
- Set(l, buildPlus (Lval l) ((fst $3) args), loc)),
-
- matchBinopEq
- (fun bop -> bop = PlusPI || bop = PlusA)
- (snd $1) (snd $3))
- }
-
-| lval MINUS_EQ expression SEMICOLON
- { ((fun loc args ->
- let l = (fst $1) args in
- Set(l,
- buildMinus (Lval l) ((fst $3) args), loc)),
-
- matchBinopEq (fun bop -> bop = MinusA
- || bop = MinusPP
- || bop = MinusPI)
- (snd $1) (snd $3))
- }
-| lval STAR_EQ expression SEMICOLON
- { doBinopEq Mult $1 $3 }
-
-| lval SLASH_EQ expression SEMICOLON
- { doBinopEq Div $1 $3 }
-
-| lval PERCENT_EQ expression SEMICOLON
- { doBinopEq Mod $1 $3 }
-
-| lval AND_EQ expression SEMICOLON
- { doBinopEq BAnd $1 $3 }
-
-| lval PIPE_EQ expression SEMICOLON
- { doBinopEq BOr $1 $3 }
-
-| lval CIRC_EQ expression SEMICOLON
- { doBinopEq BXor $1 $3 }
-
-| lval INF_INF_EQ expression SEMICOLON
- { doBinopEq Shiftlt $1 $3 }
-
-| lval SUP_SUP_EQ expression SEMICOLON
- { doBinopEq Shiftrt $1 $3 }
-
-/* (* Would be nice to be able to condense the next three rules but we get
- * into conflicts *)*/
-| lval EQ lval LPAREN arguments RPAREN SEMICOLON
- { ((fun loc args ->
- Call(Some ((fst $1) args), Lval ((fst $3) args),
- (fst $5) args, loc)),
-
- (fun i -> match i with
- Call(Some l, Lval f, args, loc) -> begin
- match (snd $1) l, (snd $3) f, (snd $5) args with
- Some m1, Some m2, Some m3 ->
- Some (m1 @ m2 @ m3)
- | _, _, _ -> None
- end
- | _ -> None))
- }
-
-| lval LPAREN arguments RPAREN SEMICOLON
- { ((fun loc args ->
- Call(None, Lval ((fst $1) args),
- (fst $3) args, loc)),
-
- (fun i -> match i with
- Call(None, Lval f, args, loc) -> begin
- match (snd $1) f, (snd $3) args with
- Some m1, Some m2 -> Some (m1 @ m2)
- | _, _ -> None
- end
- | _ -> None))
- }
-
-| arglo lval LPAREN arguments RPAREN SEMICOLON
- { ((fun loc args ->
- Call((fst $1) args, Lval ((fst $2) args),
- (fst $4) args, loc)),
-
- (fun i -> match i with
- Call(lo, Lval f, args, loc) -> begin
- match (snd $1) lo, (snd $2) f, (snd $4) args with
- Some m1, Some m2, Some m3 ->
- Some (m1 @ m2 @ m3)
- | _, _, _ -> None
- end
- | _ -> None))
- }
-;
-
-/* (* Separate this out to ensure that the counting or arguments is right *)*/
-arglo:
- ARG_lo { let currentArg = $1 in
- ((fun args ->
- let res =
- match getArg currentArg args with
- Flo x -> x
- | a -> wrongArgType currentArg "lval option" a
- in
- res),
-
- (fun lo -> Some [ Flo lo ]))
- }
-;
-arguments:
- /* empty */ { ((fun args -> []),
-
- (fun actuals -> match actuals with
- [] -> Some []
- | _ -> None))
- }
-
-| arguments_ne { $1 }
-;
-
-arguments_ne:
- expression { ((fun args -> [ (fst $1) args ]),
-
- (fun actuals -> match actuals with
- [ h ] -> (snd $1) h
- | _ -> None))
- }
-
-| ARG_E { let currentArg = $1 in
- ((fun args ->
- match getArg currentArg args with
- FE el -> el
- | a -> wrongArgType currentArg "arguments" a),
-
- (fun actuals -> Some [ FE actuals ]))
- }
-
-| expression COMMA arguments_ne
- { ((fun args -> ((fst $1) args) :: ((fst $3) args)),
-
- (fun actuals -> match actuals with
- h :: rest -> begin
- match (snd $1) h, (snd $3) rest with
- Some m1, Some m2 -> Some (m1 @ m2)
- | _, _ -> None
- end
- | _ -> None))
- }
-;
-
-
-/*(******** STATEMENTS *********)*/
-stmt:
- IF LPAREN expression RPAREN stmt %prec IF
- { (fun mkTemp loc args ->
- mkStmt (If((fst $3) args,
- mkBlock [ $5 mkTemp loc args ],
- mkBlock [], loc)))
- }
-| IF LPAREN expression RPAREN stmt ELSE stmt
- { (fun mkTemp loc args ->
- mkStmt (If((fst $3) args,
- mkBlock [ $5 mkTemp loc args ],
- mkBlock [ $7 mkTemp loc args], loc)))
- }
-| RETURN exp_opt SEMICOLON
- { (fun mkTemp loc args ->
- mkStmt (Return((fst $2) args, loc)))
- }
-| BREAK SEMICOLON
- { (fun mkTemp loc args ->
- mkStmt (Break loc))
- }
-| CONTINUE SEMICOLON
- { (fun mkTemp loc args ->
- mkStmt (Continue loc))
- }
-| LBRACE stmt_list RBRACE
- { (fun mkTemp loc args ->
- let stmts = $2 mkTemp loc args in
- mkStmt (Block (mkBlock (stmts))))
- }
-| WHILE LPAREN expression RPAREN stmt
- { (fun mkTemp loc args ->
- let e = (fst $3) args in
- let e =
- if isPointerType(typeOf e) then
- mkCast e !upointType
- else e
- in
-(*
- mkStmt
- (Loop (mkBlock [ mkStmt
- (If(e,
- mkBlock [],
- mkBlock [ mkStmt
- (Break loc) ],
- loc));
- $5 mkTemp loc args ],
- loc, None, None))
-*)
- mkStmt
- (While (e, mkBlock [ $5 mkTemp loc args ], loc)))
- }
-| instr_list { (fun mkTemp loc args ->
- mkStmt (Instr ($1 loc args)))
- }
-| ARG_s { let currentArg = $1 in
- (fun mkTemp loc args ->
- match getArg currentArg args with
- Fs s -> s
- | a -> wrongArgType currentArg "stmt" a) }
-;
-
-stmt_list:
- /* empty */ { (fun mkTemp loc args -> []) }
-
-| ARG_S { let currentArg = $1 in
- (fun mkTemp loc args ->
- match getArg currentArg args with
- | FS sl -> sl
- | a -> wrongArgType currentArg "stmts" a)
- }
-| stmt stmt_list
- { (fun mkTemp loc args ->
- let this = $1 mkTemp loc args in
- this :: ($2 mkTemp loc args))
- }
-/* (* We can also have a declaration *) */
-| type_spec attributes decl maybe_init SEMICOLON stmt_list
- { (fun mkTemp loc args ->
- let tal = (fst $2) args in
- let ts = (fst $1) tal args in
- let (n, t, _) = (fst $3) ts args in
- let init = $4 args in
- (* Before we proceed we must create the variable *)
- let v = mkTemp n t in
- (* Now we parse the rest *)
- let rest = $6 mkTemp loc ((n, Fv v) :: args) in
- (* Now we add the initialization instruction to the
- * front *)
- match init with
- NoInit -> rest
- | InitExp e ->
- mkStmtOneInstr (Set((Var v, NoOffset), e, loc))
- :: rest
- | InitCall (f, args) ->
- mkStmtOneInstr (Call(Some (Var v, NoOffset),
- Lval f, args, loc))
- :: rest
-
- )
- }
-;
-
-instr_list:
- /*(* Set this rule to very low precedence to ensure that we shift as
- many instructions as possible *)*/
- instr %prec COMMA
- { (fun loc args -> [ ((fst $1) loc args) ]) }
-| ARG_I { let currentArg = $1 in
- (fun loc args ->
- match getArg currentArg args with
- | FI il -> il
- | a -> wrongArgType currentArg "instrs" a)
- }
-| instr instr_list
- { (fun loc args ->
- let this = (fst $1) loc args in
- this :: ($2 loc args))
- }
-;
-
-
-maybe_init:
-| { (fun args -> NoInit) }
-| EQ expression { (fun args -> InitExp ((fst $2) args)) }
-| EQ lval LPAREN arguments RPAREN
- { (fun args ->
- InitCall((fst $2) args, (fst $4) args)) }
-;
-%%
-
-
-
-
-
-
-
diff --git a/cil/src/frontc/cabs.ml b/cil/src/frontc/cabs.ml
deleted file mode 100644
index 78ac02f44fbd3300789247103f5409585dd7ce70..0000000000000000000000000000000000000000
--- a/cil/src/frontc/cabs.ml
+++ /dev/null
@@ -1,396 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(** This file was originally part of Hugues Casee's frontc 2.0, and has been
- * extensively changed since.
-**
-** 1.0 3.22.99 Hugues Cassé First version.
-** 2.0 George Necula 12/12/00: Many extensions
- **)
-
-(*
-** Types
-*)
-
-type cabsloc = {
- lineno : int;
- filename: string;
- byteno: int;
-}
-
-let cabslu = {lineno = -10;
- filename = "cabs loc unknown";
- byteno = -10;}
-
-(* clexer puts comments here *)
-let commentsGA = GrowArray.make 100 (GrowArray.Elem(cabslu,"",false))
-
-type typeSpecifier = (* Merge all specifiers into one type *)
- Tvoid (* Type specifier ISO 6.7.2 *)
- | Tchar
- | Tshort
- | Tint
- | Tlong
- | Tint64
- | Tfloat
- | Tdouble
- | Tsigned
- | Tunsigned
- | Tnamed of string
- (* each of the following three kinds of specifiers contains a field
- * or item list iff it corresponds to a definition (as opposed to
- * a forward declaration or simple reference to the type); they
- * also have a list of __attribute__s that appeared between the
- * keyword and the type name (definitions only) *)
- | Tstruct of string * field_group list option * attribute list
- | Tunion of string * field_group list option * attribute list
- | Tenum of string * enum_item list option * attribute list
- | TtypeofE of expression (* GCC __typeof__ *)
- | TtypeofT of specifier * decl_type (* GCC __typeof__ *)
-
-and storage =
- NO_STORAGE | AUTO | STATIC | EXTERN | REGISTER
-
-and funspec =
- INLINE | VIRTUAL | EXPLICIT
-
-and cvspec =
- CV_CONST | CV_VOLATILE | CV_RESTRICT
-
-(* Type specifier elements. These appear at the start of a declaration *)
-(* Everywhere they appear in this file, they appear as a 'spec_elem list', *)
-(* which is not interpreted by cabs -- rather, this "word soup" is passed *)
-(* on to the compiler. Thus, we can represent e.g. 'int long float x' even *)
-(* though the compiler will of course choke. *)
-and spec_elem =
- SpecTypedef
- | SpecCV of cvspec (* const/volatile *)
- | SpecAttr of attribute (* __attribute__ *)
- | SpecStorage of storage
- | SpecInline
- | SpecType of typeSpecifier
- | SpecPattern of string (* specifier pattern variable *)
-
-(* decided to go ahead and replace 'spec_elem list' with specifier *)
-and specifier = spec_elem list
-
-
-(* Declarator type. They modify the base type given in the specifier. Keep
- * them in the order as they are printed (this means that the top level
- * constructor for ARRAY and PTR is the inner-level in the meaning of the
- * declared type) *)
-and decl_type =
- | JUSTBASE (* Prints the declared name *)
- | PARENTYPE of attribute list * decl_type * attribute list
- (* Prints "(attrs1 decl attrs2)".
- * attrs2 are attributes of the
- * declared identifier and it is as
- * if they appeared at the very end
- * of the declarator. attrs1 can
- * contain attributes for the
- * identifier or attributes for the
- * enclosing type. *)
- | ARRAY of decl_type * attribute list * expression
- (* Prints "decl [ attrs exp ]".
- * decl is never a PTR. *)
- | PTR of attribute list * decl_type (* Prints "* attrs decl" *)
- | PROTO of decl_type * single_name list * bool
- (* Prints "decl (args[, ...])".
- * decl is never a PTR.*)
-
-(* The base type and the storage are common to all names. Each name might
- * contain type or storage modifiers *)
-(* e.g.: int x, y; *)
-and name_group = specifier * name list
-
-(* The optional expression is the bitfield *)
-and field_group = specifier * (name * expression option) list
-
-(* like name_group, except the declared variables are allowed to have initializers *)
-(* e.g.: int x=1, y=2; *)
-and init_name_group = specifier * init_name list
-
-(* The decl_type is in the order in which they are printed. Only the name of
- * the declared identifier is pulled out. The attributes are those that are
- * printed after the declarator *)
-(* e.g: in "int *x", "*x" is the declarator; "x" will be pulled out as *)
-(* the string, and decl_type will be PTR([], JUSTBASE) *)
-and name = string * decl_type * attribute list * cabsloc
-
-(* A variable declarator ("name") with an initializer *)
-and init_name = name * init_expression
-
-(* Single names are for declarations that cannot come in groups, like
- * function parameters and functions *)
-and single_name = specifier * name
-
-
-and enum_item = string * expression * cabsloc
-
-(*
-** Declaration definition (at toplevel)
-*)
-and definition =
- FUNDEF of single_name * block * cabsloc * cabsloc
- | DECDEF of init_name_group * cabsloc (* global variable(s), or function prototype *)
- | TYPEDEF of name_group * cabsloc
- | ONLYTYPEDEF of specifier * cabsloc
- | GLOBASM of string * cabsloc
- | PRAGMA of expression * cabsloc
- | LINKAGE of string * cabsloc * definition list (* extern "C" { ... } *)
- (* toplevel form transformer, from the first definition to the *)
- (* second group of definitions *)
- | TRANSFORMER of definition * definition list * cabsloc
- (* expression transformer: source and destination *)
- | EXPRTRANSFORMER of expression * expression * cabsloc
-
-
-(* the string is a file name, and then the list of toplevel forms *)
-and file = string * definition list
-
-
-(*
-** statements
-*)
-
-(* A block contains a list of local label declarations ( GCC's ({ __label__
- * l1, l2; ... }) ) , a list of definitions and a list of statements *)
-and block =
- { blabels: string list;
- battrs: attribute list;
- bstmts: statement list
- }
-
-(* GCC asm directives have lots of extra information to guide the optimizer *)
-and asm_details =
- { aoutputs: (string * expression) list; (* constraints and expressions for outputs *)
- ainputs: (string * expression) list; (* constraints and expressions for inputs *)
- aclobbers: string list (* clobbered registers *)
- }
-
-and statement =
- NOP of cabsloc
- | COMPUTATION of expression * cabsloc
- | BLOCK of block * cabsloc
- | SEQUENCE of statement * statement * cabsloc
- | IF of expression * statement * statement * cabsloc
- | WHILE of expression * statement * cabsloc
- | DOWHILE of expression * statement * cabsloc
- | FOR of for_clause * expression * expression * statement * cabsloc
- | BREAK of cabsloc
- | CONTINUE of cabsloc
- | RETURN of expression * cabsloc
- | SWITCH of expression * statement * cabsloc
- | CASE of expression * statement * cabsloc
- | CASERANGE of expression * expression * statement * cabsloc
- | DEFAULT of statement * cabsloc
- | LABEL of string * statement * cabsloc
- | GOTO of string * cabsloc
- | COMPGOTO of expression * cabsloc (* GCC's "goto *exp" *)
- | DEFINITION of definition (*definition or declaration of a variable or type*)
-
- | ASM of attribute list * (* typically only volatile and const *)
- string list * (* template *)
- asm_details option * (* extra details to guide GCC's optimizer *)
- cabsloc
-
- (** MS SEH *)
- | TRY_EXCEPT of block * expression * block * cabsloc
- | TRY_FINALLY of block * block * cabsloc
-
-and for_clause =
- FC_EXP of expression
- | FC_DECL of definition
-
-(*
-** Expressions
-*)
-and binary_operator =
- ADD | SUB | MUL | DIV | MOD
- | AND | OR
- | BAND | BOR | XOR | SHL | SHR
- | EQ | NE | LT | GT | LE | GE
- | ASSIGN
- | ADD_ASSIGN | SUB_ASSIGN | MUL_ASSIGN | DIV_ASSIGN | MOD_ASSIGN
- | BAND_ASSIGN | BOR_ASSIGN | XOR_ASSIGN | SHL_ASSIGN | SHR_ASSIGN
-
-and unary_operator =
- MINUS | PLUS | NOT | BNOT | MEMOF | ADDROF
- | PREINCR | PREDECR | POSINCR | POSDECR
-
-and expression =
- NOTHING
- | UNARY of unary_operator * expression
- | LABELADDR of string (* GCC's && Label *)
- | BINARY of binary_operator * expression * expression
- | QUESTION of expression * expression * expression
-
- (* A CAST can actually be a constructor expression *)
- | CAST of (specifier * decl_type) * init_expression
-
- (* There is a special form of CALL in which the function called is
- __builtin_va_arg and the second argument is sizeof(T). This
- should be printed as just T *)
- | CALL of expression * expression list
- | COMMA of expression list
- | CONSTANT of constant
- | VARIABLE of string
- | EXPR_SIZEOF of expression
- | TYPE_SIZEOF of specifier * decl_type
- | EXPR_ALIGNOF of expression
- | TYPE_ALIGNOF of specifier * decl_type
- | INDEX of expression * expression
- | MEMBEROF of expression * string
- | MEMBEROFPTR of expression * string
- | GNU_BODY of block
- | EXPR_PATTERN of string (* pattern variable, and name *)
-
-and constant =
- | CONST_INT of string (* the textual representation *)
- | CONST_FLOAT of string (* the textual representaton *)
- | CONST_CHAR of int64 list
- | CONST_WCHAR of int64 list
- | CONST_STRING of string
- | CONST_WSTRING of int64 list
- (* ww: wstrings are stored as an int64 list at this point because
- * we might need to feed the wide characters piece-wise into an
- * array initializer (e.g., wchar_t foo[] = L"E\xabcd";). If that
- * doesn't happen we will convert it to an (escaped) string before
- * passing it to Cil. *)
-
-and init_expression =
- | NO_INIT
- | SINGLE_INIT of expression
- | COMPOUND_INIT of (initwhat * init_expression) list
-
-and initwhat =
- NEXT_INIT
- | INFIELD_INIT of string * initwhat
- | ATINDEX_INIT of expression * initwhat
- | ATINDEXRANGE_INIT of expression * expression
-
-
- (* Each attribute has a name and some
- * optional arguments *)
-and attribute = string * expression list
-
-
-(*********** HELPER FUNCTIONS **********)
-
-let missingFieldDecl = ("___missing_field_name", JUSTBASE, [], cabslu)
-
-let rec isStatic = function
- [] -> false
- | (SpecStorage STATIC) :: _ -> true
- | _ :: rest -> isStatic rest
-
-let rec isExtern = function
- [] -> false
- | (SpecStorage EXTERN) :: _ -> true
- | _ :: rest -> isExtern rest
-
-let rec isInline = function
- [] -> false
- | SpecInline :: _ -> true
- | _ :: rest -> isInline rest
-
-let rec isTypedef = function
- [] -> false
- | SpecTypedef :: _ -> true
- | _ :: rest -> isTypedef rest
-
-
-let get_definitionloc (d : definition) : cabsloc =
- match d with
- | FUNDEF(_, _, l, _) -> l
- | DECDEF(_, l) -> l
- | TYPEDEF(_, l) -> l
- | ONLYTYPEDEF(_, l) -> l
- | GLOBASM(_, l) -> l
- | PRAGMA(_, l) -> l
- | TRANSFORMER(_, _, l) -> l
- | EXPRTRANSFORMER(_, _, l) -> l
- | LINKAGE (_, l, _) -> l
-
-let get_statementloc (s : statement) : cabsloc =
-begin
- match s with
- | NOP(loc) -> loc
- | COMPUTATION(_,loc) -> loc
- | BLOCK(_,loc) -> loc
- | SEQUENCE(_,_,loc) -> loc
- | IF(_,_,_,loc) -> loc
- | WHILE(_,_,loc) -> loc
- | DOWHILE(_,_,loc) -> loc
- | FOR(_,_,_,_,loc) -> loc
- | BREAK(loc) -> loc
- | CONTINUE(loc) -> loc
- | RETURN(_,loc) -> loc
- | SWITCH(_,_,loc) -> loc
- | CASE(_,_,loc) -> loc
- | CASERANGE(_,_,_,loc) -> loc
- | DEFAULT(_,loc) -> loc
- | LABEL(_,_,loc) -> loc
- | GOTO(_,loc) -> loc
- | COMPGOTO (_, loc) -> loc
- | DEFINITION d -> get_definitionloc d
- | ASM(_,_,_,loc) -> loc
- | TRY_EXCEPT(_, _, _, loc) -> loc
- | TRY_FINALLY(_, _, loc) -> loc
-end
-
-
-let explodeStringToInts (s: string) : int64 list =
- let rec allChars i acc =
- if i < 0 then acc
- else allChars (i - 1) (Int64.of_int (Char.code (String.get s i)) :: acc)
- in
- allChars (-1 + String.length s) []
-
-let valueOfDigit chr =
- let int_value =
- match chr with
- '0'..'9' -> (Char.code chr) - (Char.code '0')
- | 'a'..'z' -> (Char.code chr) - (Char.code 'a') + 10
- | 'A'..'Z' -> (Char.code chr) - (Char.code 'A') + 10
- | _ -> Errormsg.s (Errormsg.bug "not a digit") in
- Int64.of_int int_value
-
-
-open Pretty
-let d_cabsloc () cl =
- text cl.filename ++ text ":" ++ num cl.lineno
diff --git a/cil/src/frontc/cabs2cil.ml b/cil/src/frontc/cabs2cil.ml
deleted file mode 100644
index 31b65b5b47aa9ddcf7313dab4127cf0dc4bf1930..0000000000000000000000000000000000000000
--- a/cil/src/frontc/cabs2cil.ml
+++ /dev/null
@@ -1,6238 +0,0 @@
-(* MODIF: allow E.Error to propagate *)
-
-(* MODIF: for pointer comparison, avoid systematic cast to unsigned int *)
-
-(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-(* MODIF: Return statement no longer added when the body of the function
- falls-through. *)
-
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* Type check and elaborate ABS to CIL *)
-
-(* The references to ISO means ANSI/ISO 9899-1999 *)
-module A = Cabs
-module E = Errormsg
-module H = Hashtbl
-module IH = Inthash
-module AL = Alpha
-
-open Cabs
-open Pretty
-open Cil
-open Trace
-
-
-let mydebugfunction () =
- E.s (error "mydebugfunction")
-
-let debugGlobal = false
-
-(** NDC added command line parameter **)
-(* Turn on tranformation that forces correct parameter evaluation order *)
-let forceRLArgEval = ref false
-
-(* Leave a certain global alone. Use a negative number to disable. *)
-let nocil: int ref = ref (-1)
-
-(* Indicates whether we're allowed to duplicate small chunks. *)
-let allowDuplication: bool ref = ref true
-
-(* ---------- source error message handling ------------- *)
-let lu = locUnknown
-let cabslu = {lineno = -10;
- filename = "cabs lu";
- byteno = -10;}
-
-
-(** Interface to the Cprint printer *)
-let withCprint (f: 'a -> unit) (x: 'a) : unit =
- Cprint.commit (); Cprint.flush ();
- let old = !Cprint.out in
- Cprint.out := !E.logChannel;
- f x;
- Cprint.commit (); Cprint.flush ();
- flush !Cprint.out;
- Cprint.out := old
-
-
-(** Keep a list of the variable ID for the variables that were created to
- * hold the result of function calls *)
-let callTempVars: unit IH.t = IH.create 13
-
-(* Keep a list of functions that were called without a prototype. *)
-let noProtoFunctions : bool IH.t = IH.create 13
-
-(* Check that s starts with the prefix p *)
-let prefix p s =
- let lp = String.length p in
- let ls = String.length s in
- lp <= ls && String.sub s 0 lp = p
-
-(***** COMPUTED GOTO ************)
-
-(* The address of labels are small integers (starting from 0). A computed
- * goto is replaced with a switch on the address of the label. We generate
- * only one such switch and we'll jump to it from all computed gotos. To
- * accomplish this we'll add a local variable to store the target of the
- * goto. *)
-
-(* The local variable in which to put the detination of the goto and the
- * statement where to jump *)
-let gotoTargetData: (varinfo * stmt) option ref = ref None
-
-(* The "addresses" of labels *)
-let gotoTargetHash: (string, int) H.t = H.create 13
-let gotoTargetNextAddr: int ref = ref 0
-
-
-(********** TRANSPARENT UNION ******)
-(* Check if a type is a transparent union, and return the first field if it
- * is *)
-let isTransparentUnion (t: typ) : fieldinfo option =
- match unrollType t with
- TComp (comp, _) when not comp.cstruct ->
- (* Turn transparent unions into the type of their first field *)
- if hasAttribute "transparent_union" (typeAttrs t) then begin
- match comp.cfields with
- f :: _ -> Some f
- | _ -> E.s (unimp "Empty transparent union: %s" (compFullName comp))
- end else
- None
- | _ -> None
-
-(* When we process an argument list, remember the argument index which has a
- * transparent union type, along with the original type. We need this to
- * process function definitions *)
-let transparentUnionArgs : (int * typ) list ref = ref []
-
-let debugLoc = false
-let convLoc (l : cabsloc) =
- if debugLoc then
- ignore (E.log "convLoc at %s: line %d, btye %d\n" l.filename l.lineno l.byteno);
- {line = l.lineno; file = l.filename; byte = l.byteno;}
-
-
-let isOldStyleVarArgName n =
- if !msvcMode then n = "va_alist"
- else n = "__builtin_va_alist"
-
-let isOldStyleVarArgTypeName n =
- if !msvcMode then n = "va_list" || n = "__ccured_va_list"
- else n = "__builtin_va_alist_t"
-
-(* Weimer
- * multi-character character constants
- * In MSCV, this code works:
- *
- * long l1 = 'abcd'; // note single quotes
- * char * s = "dcba";
- * long * lptr = ( long * )s;
- * long l2 = *lptr;
- * assert(l1 == l2);
- *
- * We need to change a multi-character character literal into the
- * appropriate integer constant. However, the plot sickens: we
- * must also be able to handle things like 'ab\nd' (value = * "d\nba")
- * and 'abc' (vale = *"cba").
- *
- * First we convert 'AB\nD' into the list [ 65 ; 66 ; 10 ; 68 ], then we
- * multiply and add to get the desired value.
- *)
-
-(* Given a character constant (like 'a' or 'abc') as a list of 64-bit
- * values, turn it into a CIL constant. Multi-character constants are
- * treated as multi-digit numbers with radix given by the bit width of
- * the specified type (either char or wchar_t). *)
-let reduce_multichar typ : int64 list -> int64 =
- let radix = bitsSizeOf typ in
- List.fold_left
- (fun acc -> Int64.add (Int64.shift_left acc radix))
- Int64.zero
-
-let interpret_character_constant char_list =
- let value = reduce_multichar charType char_list in
- if value < (Int64.of_int 256) then
- (* ISO C 6.4.4.4.10: single-character constants have type int *)
- (CChr(Char.chr (Int64.to_int value))), intType
- else begin
- let orig_rep = None (* Some("'" ^ (String.escaped str) ^ "'") *) in
- if value <= (Int64.of_int32 Int32.max_int) then
- (CInt64(value,IULong,orig_rep)),(TInt(IULong,[]))
- else
- (CInt64(value,IULongLong,orig_rep)),(TInt(IULongLong,[]))
- end
-
-(*** EXPRESSIONS *************)
-
- (* We collect here the program *)
-let theFile : global list ref = ref []
-let theFileTypes : global list ref = ref []
-
-let initGlobals () = theFile := []; theFileTypes := []
-
-
-let cabsPushGlobal (g: global) =
- pushGlobal g ~types:theFileTypes ~variables:theFile
-
-(* Keep track of some variable ids that must be turned into definitions. We
- * do this when we encounter what appears a definition of a global but
- * without initializer. We leave it a declaration because maybe down the road
- * we see another definition with an initializer. But if we don't see any
- * then we turn the last such declaration into a definition without
- * initializer *)
-let mustTurnIntoDef: bool IH.t = IH.create 117
-
-(* Globals that have already been defined. Indexed by the variable name. *)
-let alreadyDefined: (string, location) H.t = H.create 117
-
-(* Globals that were created due to static local variables. We chose their
- * names to be distinct from any global encountered at the time. But we might
- * see a global with conflicting name later in the file. *)
-let staticLocals: (string, varinfo) H.t = H.create 13
-
-
-(* Typedefs. We chose their names to be distinct from any global encounterd
- * at the time. But we might see a global with conflicting name later in the
- * file *)
-let typedefs: (string, typeinfo) H.t = H.create 13
-
-let popGlobals () =
- let rec revonto (tail: global list) = function
- [] -> tail
-
- | GVarDecl (vi, l) :: rest
- when vi.vstorage != Extern && IH.mem mustTurnIntoDef vi.vid ->
- IH.remove mustTurnIntoDef vi.vid;
- revonto (GVar (vi, {init = None}, l) :: tail) rest
-
- | x :: rest -> revonto (x :: tail) rest
- in
- revonto (revonto [] !theFile) !theFileTypes
-
-
-(********* ENVIRONMENTS ***************)
-
-(* The environment is kept in two distinct data structures. A hash table maps
- * each original variable name into a varinfo (for variables, or an
- * enumeration tag, or a type). (Note that the varinfo might contain an
- * alpha-converted name different from that of the lookup name.) The Ocaml
- * hash tables can keep multiple mappings for a single key. Each time the
- * last mapping is returned and upon deletion the old mapping is restored. To
- * keep track of local scopes we also maintain a list of scopes (represented
- * as lists). *)
-type envdata =
- EnvVar of varinfo (* The name refers to a variable
- * (which could also be a function) *)
- | EnvEnum of exp * typ (* The name refers to an enumeration
- * tag for which we know the value
- * and the host type *)
- | EnvTyp of typ (* The name is of the form "struct
- * foo", or "union foo" or "enum foo"
- * and refers to a type. Note that
- * the name of the actual type might
- * be different from foo due to alpha
- * conversion *)
- | EnvLabel of string (* The name refers to a label. This
- * is useful for GCC's locally
- * declared labels. The lookup name
- * for this category is "label foo" *)
-
-let env : (string, envdata * location) H.t = H.create 307
-(* We also keep a global environment. This is always a subset of the env *)
-let genv : (string, envdata * location) H.t = H.create 307
-
- (* In the scope we keep the original name, so we can remove them from the
- * hash table easily *)
-type undoScope =
- UndoRemoveFromEnv of string
- | UndoResetAlphaCounter of location AL.alphaTableData ref *
- location AL.alphaTableData
- | UndoRemoveFromAlphaTable of string
-
-let scopes : undoScope list ref list ref = ref []
-
-let isAtTopLevel () =
- !scopes = []
-
-
-(* When you add to env, you also add it to the current scope *)
-let addLocalToEnv (n: string) (d: envdata) =
-(* ignore (E.log "%a: adding local %s to env\n" d_loc !currentLoc n); *)
- H.add env n (d, !currentLoc);
- (* If we are in a scope, then it means we are not at top level. Add the
- * name to the scope *)
- (match !scopes with
- [] -> begin
- match d with
- EnvVar _ ->
- E.s (E.bug "addLocalToEnv: not in a scope when adding %s!" n)
- | _ -> () (* We might add types *)
- end
- | s :: _ ->
- s := (UndoRemoveFromEnv n) :: !s)
-
-
-let addGlobalToEnv (k: string) (d: envdata) : unit =
-(* ignore (E.log "%a: adding global %s to env\n" d_loc !currentLoc k); *)
- H.add env k (d, !currentLoc);
- (* Also add it to the global environment *)
- H.add genv k (d, !currentLoc)
-
-
-
-(* Create a new name based on a given name. The new name is formed from a
- * prefix (obtained from the given name as the longest prefix that ends with
- * a non-digit), followed by a '_' and then by a positive integer suffix. The
- * first argument is a table mapping name prefixes with the largest suffix
- * used so far for that prefix. The largest suffix is one when only the
- * version without suffix has been used. *)
-let alphaTable : (string, location AL.alphaTableData ref) H.t = H.create 307
- (* vars and enum tags. For composite types we have names like "struct
- * foo" or "union bar" *)
-
-(* To keep different name scopes different, we add prefixes to names
- * specifying the kind of name: the kind can be one of "" for variables or
- * enum tags, "struct" for structures and unions (they share the name space),
- * "enum" for enumerations, or "type" for types *)
-let kindPlusName (kind: string)
- (origname: string) : string =
- if kind = "" then origname else
- kind ^ " " ^ origname
-
-
-let stripKind (kind: string) (kindplusname: string) : string =
- let l = 1 + String.length kind in
- if l > 1 then
- String.sub kindplusname l (String.length kindplusname - l)
- else
- kindplusname
-
-let newAlphaName (globalscope: bool) (* The name should have global scope *)
- (kind: string)
- (origname: string) : string * location =
- let lookupname = kindPlusName kind origname in
- (* If we are in a scope then it means that we are alpha-converting a local
- * name. Go and add stuff to reset the state of the alpha table but only to
- * the top-most scope (that of the enclosing function) *)
- let rec findEnclosingFun = function
- [] -> (* At global scope *)()
- | [s] -> begin
- let prefix = AL.getAlphaPrefix lookupname in
- try
- let countref = H.find alphaTable prefix in
- s := (UndoResetAlphaCounter (countref, !countref)) :: !s
- with Not_found ->
- s := (UndoRemoveFromAlphaTable prefix) :: !s
- end
- | _ :: rest -> findEnclosingFun rest
- in
- if not globalscope then
- findEnclosingFun !scopes;
- let newname, oldloc =
- AL.newAlphaName alphaTable None lookupname !currentLoc in
- stripKind kind newname, oldloc
-
-
-
-
-let explodeString (nullterm: bool) (s: string) : char list =
- let rec allChars i acc =
- if i < 0 then acc
- else allChars (i - 1) ((String.get s i) :: acc)
- in
- allChars (-1 + String.length s)
- (if nullterm then [Char.chr 0] else [])
-
-(*** In order to process GNU_BODY expressions we must record that a given
- *** COMPUTATION is interesting *)
-let gnu_body_result : (A.statement * ((exp * typ) option ref)) ref
- = ref (A.NOP cabslu, ref None)
-
-(*** When we do statements we need to know the current return type *)
-let currentReturnType : typ ref = ref (TVoid([]))
-let currentFunctionFDEC: fundec ref = ref dummyFunDec
-
-
-let lastStructId = ref 0
-let anonStructName (k: string) (suggested: string) =
- incr lastStructId;
- "__anon" ^ k ^ (if suggested <> "" then "_" ^ suggested else "")
- ^ "_" ^ (string_of_int (!lastStructId))
-
-
-let constrExprId = ref 0
-
-
-let startFile () =
- H.clear env;
- H.clear genv;
- H.clear alphaTable;
- lastStructId := 0
-
-
-
-let enterScope () =
- scopes := (ref []) :: !scopes
-
- (* Exit a scope and clean the environment. We do not yet delete from
- * the name table *)
-let exitScope () =
- let this, rest =
- match !scopes with
- car :: cdr -> car, cdr
- | [] -> E.s (error "Not in a scope")
- in
- scopes := rest;
- let rec loop = function
- [] -> ()
- | UndoRemoveFromEnv n :: t ->
- H.remove env n; loop t
- | UndoRemoveFromAlphaTable n :: t -> H.remove alphaTable n; loop t
- | UndoResetAlphaCounter (vref, oldv) :: t ->
- vref := oldv;
- loop t
- in
- loop !this
-
-(* Lookup a variable name. Return also the location of the definition. Might
- * raise Not_found *)
-let lookupVar (n: string) : varinfo * location =
- match H.find env n with
- (EnvVar vi), loc -> vi, loc
- | _ -> raise Not_found
-
-let lookupGlobalVar (n: string) : varinfo * location =
- match H.find genv n with
- (EnvVar vi), loc -> vi, loc
- | _ -> raise Not_found
-
-let docEnv () =
- let acc : (string * (envdata * location)) list ref = ref [] in
- let doone () = function
- EnvVar vi, l ->
- dprintf "Var(%s,global=%b) (at %a)" vi.vname vi.vglob d_loc l
- | EnvEnum (tag, typ), l -> dprintf "Enum (at %a)" d_loc l
- | EnvTyp t, l -> text "typ"
- | EnvLabel l, _ -> text ("label " ^ l)
- in
- H.iter (fun k d -> acc := (k, d) :: !acc) env;
- docList ~sep:line (fun (k, d) -> dprintf " %s -> %a" k doone d) () !acc
-
-
-
-(* Add a new variable. Do alpha-conversion if necessary *)
-let alphaConvertVarAndAddToEnv (addtoenv: bool) (vi: varinfo) : varinfo =
-(*
- ignore (E.log "%t: alphaConvert(addtoenv=%b) %s" d_thisloc addtoenv vi.vname);
-*)
- (* Announce the name to the alpha conversion table *)
- let newname, oldloc = newAlphaName (addtoenv && vi.vglob) "" vi.vname in
- (* Make a copy of the vi if the name has changed. Never change the name for
- * global variables *)
- let newvi =
- if vi.vname = newname then
- vi
- else begin
- if vi.vglob then begin
- (* Perhaps this is because we have seen a static local which happened
- * to get the name that we later want to use for a global. *)
- try
- let static_local_vi = H.find staticLocals vi.vname in
- H.remove staticLocals vi.vname;
- (* Use the new name for the static local *)
- static_local_vi.vname <- newname;
- (* And continue using the last one *)
- vi
- with Not_found -> begin
- (* Or perhaps we have seen a typedef which stole our name. This is
- possible because typedefs use the same name space *)
- try
- let typedef_ti = H.find typedefs vi.vname in
- H.remove typedefs vi.vname;
- (* Use the new name for the typedef instead *)
- typedef_ti.tname <- newname;
- (* And continue using the last name *)
- vi
- with Not_found ->
- E.s (E.error "It seems that we would need to rename global %s (to %s) because of previous occurrence at %a"
- vi.vname newname d_loc oldloc);
- end
- end else begin
- (* We have changed the name of a local variable. Can we try to detect
- * if the other variable was also local in the same scope? Not for
- * now. *)
- copyVarinfo vi newname
- end
- end
- in
- (* Store all locals in the slocals (in reversed order). We'll reverse them
- * and take out the formals at the end of the function *)
- if not vi.vglob then
- !currentFunctionFDEC.slocals <- newvi :: !currentFunctionFDEC.slocals;
-
- (if addtoenv then
- if vi.vglob then
- addGlobalToEnv vi.vname (EnvVar newvi)
- else
- addLocalToEnv vi.vname (EnvVar newvi));
-(*
- ignore (E.log " new=%s\n" newvi.vname);
-*)
-(* ignore (E.log "After adding %s alpha table is: %a\n"
- newvi.vname docAlphaTable alphaTable); *)
- newvi
-
-
-(* Strip the "const" from the type. It is unfortunate that const variables
- * can only be set in initialization. Once we decided to move all
- * declarations to the top of the functions, we have no way of setting a
- * "const" variable. Furthermore, if the type of the variable is an array or
- * a struct we must recursively strip the "const" from fields and array
- * elements. *)
-let rec stripConstLocalType (t: typ) : typ =
- let dc a =
- if hasAttribute "const" a then
- dropAttribute "const" a
- else a
- in
- match t with
- | TPtr (bt, a) ->
- (* We want to be able to detect by pointer equality if the type has
- * changed. So, don't realloc the type unless necessary. *)
- let a' = dc a in if a != a' then TPtr(bt, a') else t
- | TInt (ik, a) ->
- let a' = dc a in if a != a' then TInt(ik, a') else t
- | TFloat(fk, a) ->
- let a' = dc a in if a != a' then TFloat(fk, a') else t
- | TNamed (ti, a) ->
- (* We must go and drop the consts from the typeinfo as well ! *)
- let t' = stripConstLocalType ti.ttype in
- if t != t' then begin
- (* ignore (warn "Stripping \"const\" from typedef %s\n" ti.tname); *)
- ti.ttype <- t'
- end;
- let a' = dc a in if a != a' then TNamed(ti, a') else t
-
- | TEnum (ei, a) ->
- let a' = dc a in if a != a' then TEnum(ei, a') else t
-
- | TArray(bt, leno, a) ->
- (* We never assign to the array. So, no need to change the const. But
- * we must change it on the base type *)
- let bt' = stripConstLocalType bt in
- if bt' != bt then TArray(bt', leno, a) else t
-
- | TComp(ci, a) ->
- (* Must change both this structure as well as its fields *)
- List.iter
- (fun f ->
- let t' = stripConstLocalType f.ftype in
- if t' != f.ftype then begin
- ignore (warnOpt "Stripping \"const\" from field %s of %s\n"
- f.fname (compFullName ci));
- f.ftype <- t'
- end)
- ci.cfields;
- let a' = dc a in if a != a' then TComp(ci, a') else t
-
- (* We never assign functions either *)
- | TFun(rt, args, va, a) -> t
- | TVoid _ -> E.s (bug "cabs2cil: stripConstLocalType: void")
- | TBuiltin_va_list a ->
- let a' = dc a in if a != a' then TBuiltin_va_list a' else t
-
-
-let constFoldTypeVisitor = object (self)
- inherit nopCilVisitor
- method vtype t: typ visitAction =
- match t with
- TArray(bt, Some len, a) ->
- let len' = constFold true len in
- ChangeDoChildrenPost (
- TArray(bt, Some len', a),
- (fun x -> x)
- )
- | _ -> DoChildren
-end
-
-(* Const-fold any expressions that appear as array lengths in this type *)
-let constFoldType (t:typ) : typ =
- visitCilType constFoldTypeVisitor t
-
-
-
-(* Create a new temporary variable *)
-let newTempVar typ =
- if !currentFunctionFDEC == dummyFunDec then
- E.s (bug "newTempVar called outside a function");
-(* ignore (E.log "stripConstLocalType(%a) for temporary\n" d_type typ); *)
- let t' = stripConstLocalType typ in
- (* Start with the name "tmp". The alpha converter will fix it *)
- let vi = makeVarinfo false "tmp" t' in
- alphaConvertVarAndAddToEnv false vi (* Do not add to the environment *)
-(*
- { vname = "tmp"; (* addNewVar will make the name fresh *)
- vid = newVarId "tmp" false;
- vglob = false;
- vtype = t';
- vdecl = locUnknown;
- vinline = false;
- vattr = [];
- vaddrof = false;
- vreferenced = false; (* sm *)
- vstorage = NoStorage;
- }
-*)
-
-let mkAddrOfAndMark ((b, off) as lval) : exp =
- (* Mark the vaddrof flag if b is a variable *)
- (match b with
- Var vi -> vi.vaddrof <- true
- | _ -> ());
- mkAddrOf lval
-
-(* Call only on arrays *)
-let mkStartOfAndMark ((b, off) as lval) : exp =
- (* Mark the vaddrof flag if b is a variable *)
- (match b with
- Var vi -> vi.vaddrof <- true
- | _ -> ());
- let res = StartOf lval in
- res
-
-
-
- (* Keep a set of self compinfo for composite types *)
-let compInfoNameEnv : (string, compinfo) H.t = H.create 113
-let enumInfoNameEnv : (string, enuminfo) H.t = H.create 113
-
-
-let lookupTypeNoError (kind: string)
- (n: string) : typ * location =
- let kn = kindPlusName kind n in
- match H.find env kn with
- EnvTyp t, l -> t, l
- | _ -> raise Not_found
-
-let lookupType (kind: string)
- (n: string) : typ * location =
- try
- lookupTypeNoError kind n
- with Not_found ->
- E.s (error "Cannot find type %s (kind:%s)\n" n kind)
-
-(* Create the self ref cell and add it to the map. Return also an indication
- * if this is a new one. *)
-let createCompInfo (iss: bool) (n: string) : compinfo * bool =
- (* Add to the self cell set *)
- let key = (if iss then "struct " else "union ") ^ n in
- try
- H.find compInfoNameEnv key, false (* Only if not already in *)
- with Not_found -> begin
- (* Create a compinfo. This will have "cdefined" false. *)
- let res = mkCompInfo iss n (fun _ -> []) [] in
- H.add compInfoNameEnv key res;
- res, true
- end
-
-(* Create the self ref cell and add it to the map. Return an indication
- * whether this is a new one. *)
-let createEnumInfo (n: string) : enuminfo * bool =
- (* Add to the self cell set *)
- try
- H.find enumInfoNameEnv n, false (* Only if not already in *)
- with Not_found -> begin
- (* Create a enuminfo *)
- let enum = { ename = n; eitems = [];
- eattr = []; ereferenced = false; } in
- H.add enumInfoNameEnv n enum;
- enum, true
- end
-
-
- (* kind is either "struct" or "union" or "enum" and n is a name *)
-let findCompType (kind: string) (n: string) (a: attributes) =
- let makeForward () =
- (* This is a forward reference, either because we have not seen this
- * struct already or because we want to create a version with different
- * attributes *)
- if kind = "enum" then
- let enum, isnew = createEnumInfo n in
- if isnew then
- cabsPushGlobal (GEnumTagDecl (enum, !currentLoc));
- TEnum (enum, a)
- else
- let iss = if kind = "struct" then true else false in
- let self, isnew = createCompInfo iss n in
- if isnew then
- cabsPushGlobal (GCompTagDecl (self, !currentLoc));
- TComp (self, a)
- in
- try
- let old, _ = lookupTypeNoError kind n in (* already defined *)
- let olda = typeAttrs old in
- if Util.equals olda a then old else makeForward ()
- with Not_found -> makeForward ()
-
-
-(* A simple visitor that searchs a statement for labels *)
-class canDropStmtClass pRes = object
- inherit nopCilVisitor
-
- method vstmt s =
- if s.labels != [] then
- (pRes := false; SkipChildren)
- else
- if !pRes then DoChildren else SkipChildren
-
- method vinst _ = SkipChildren
- method vexpr _ = SkipChildren
-
-end
-let canDropStatement (s: stmt) : bool =
- let pRes = ref true in
- let vis = new canDropStmtClass pRes in
- ignore (visitCilStmt vis s);
- !pRes
-
-(**** Occasionally we see structs with no name and no fields *)
-
-
-module BlockChunk =
- struct
- type chunk = {
- stmts: stmt list;
- postins: instr list; (* Some instructions to append at
- * the ends of statements (in
- * reverse order) *)
- (* A list of case statements visible at the
- * outer level *)
- cases: (label * stmt) list
- }
-
- let d_chunk () (c: chunk) =
- dprintf "@[{ @[%a@] };@?%a@]"
- (docList ~sep:(chr ';') (d_stmt ())) c.stmts
- (docList ~sep:(chr ';') (d_instr ())) (List.rev c.postins)
-
- let empty =
- { stmts = []; postins = []; cases = []; }
-
- let isEmpty (c: chunk) =
- c.postins == [] && c.stmts == []
-
- let isNotEmpty (c: chunk) = not (isEmpty c)
-
- let i2c (i: instr) =
- { empty with postins = [i] }
-
- (* Occasionally, we'll have to push postins into the statements *)
- let pushPostIns (c: chunk) : stmt list =
- if c.postins = [] then c.stmts
- else
- let rec toLast = function
- [{skind=Instr il} as s] as stmts ->
- s.skind <- Instr (il @ (List.rev c.postins));
- stmts
-
- | [] -> [mkStmt (Instr (List.rev c.postins))]
-
- | a :: rest -> a :: toLast rest
- in
- compactStmts (toLast c.stmts)
-
-
- let c2block (c: chunk) : block =
- { battrs = [];
- bstmts = pushPostIns c;
- }
-
- (* Add an instruction at the end. Never refer to this instruction again
- * after you call this *)
- let (+++) (c: chunk) (i : instr) =
- {c with postins = i :: c.postins}
-
- (* Append two chunks. Never refer to the original chunks after you call
- * this. And especially never share c2 with somebody else *)
- let (@@) (c1: chunk) (c2: chunk) =
- { stmts = compactStmts (pushPostIns c1 @ c2.stmts);
- postins = c2.postins;
- cases = c1.cases @ c2.cases;
- }
-
- let skipChunk = empty
-
- let returnChunk (e: exp option) (l: location) : chunk =
- { stmts = [ mkStmt (Return(e, l)) ];
- postins = [];
- cases = []
- }
-
- let ifChunk (be: exp) (l: location) (t: chunk) (e: chunk) : chunk =
-
- { stmts = [ mkStmt(If(be, c2block t, c2block e, l))];
- postins = [];
- cases = t.cases @ e.cases;
- }
-
- (* We can duplicate a chunk if it has a few simple statements, and if
- * it does not have cases *)
- let duplicateChunk (c: chunk) = (* raises Failure if you should not
- * duplicate this chunk *)
- if not !allowDuplication then
- raise (Failure "cannot duplicate: disallowed by user");
- if c.cases != [] then raise (Failure "cannot duplicate: has cases") else
- let pCount = ref (List.length c.postins) in
- { stmts =
- List.map
- (fun s ->
- if s.labels != [] then
- raise (Failure "cannot duplicate: has labels");
-(*
- (match s.skind with
- If _ | Switch _ | (*Loop _*)
- While _ | DoWhile _ | For _ | Block _ ->
- raise (Failure "cannot duplicate: complex stmt")
- | Instr il ->
- pCount := !pCount + List.length il
- | _ -> incr pCount);
- if !pCount > 5 then raise (Failure ("cannot duplicate: too many instr"));
-*)
- (* We can just copy it because there is nothing to share here.
- * Except maybe for the ref cell in Goto but it is Ok to share
- * that, I think *)
- { s with sid = s.sid}) c.stmts;
- postins = c.postins; (* There is no shared stuff in instructions *)
- cases = []
- }
-(*
- let duplicateChunk (c: chunk) =
- if isEmpty c then c else raise (Failure ("cannot duplicate: isNotEmpty"))
-*)
- (* We can drop a chunk if it does not have labels inside *)
- let canDrop (c: chunk) =
- List.for_all canDropStatement c.stmts
-
-(*
- let loopChunk (body: chunk) : chunk =
- (* Make the statement *)
- let loop = mkStmt (Loop (c2block body, !currentLoc, None, None)) in
- { stmts = [ loop (* ; n *) ];
- postins = [];
- cases = body.cases;
- }
-*)
-
- let whileChunk (e: exp) (body: chunk) : chunk =
- let loop = mkStmt (While (e, c2block body, !currentLoc)) in
-
- { stmts = [ loop ];
- postins = [];
- cases = body.cases;
- }
-
- let doWhileChunk (e: exp) (body: chunk) : chunk =
- let loop = mkStmt (DoWhile (e, c2block body, !currentLoc)) in
-
- { stmts = [ loop ];
- postins = [];
- cases = body.cases;
- }
-
- let forChunk (bInit: chunk) (e: exp) (bIter: chunk)
- (body: chunk) : chunk =
- let loop = mkStmt (For (c2block bInit, e, c2block bIter,
- c2block body, !currentLoc)) in
-
- { stmts = [ loop ];
- postins = [];
- cases = body.cases;
- }
-
- let breakChunk (l: location) : chunk =
- { stmts = [ mkStmt (Break l) ];
- postins = [];
- cases = [];
- }
-
- let continueChunk (l: location) : chunk =
- { stmts = [ mkStmt (Continue l) ];
- postins = [];
- cases = []
- }
-
- (* Keep track of the gotos *)
- let backPatchGotos : (string, stmt ref list ref) H.t = H.create 17
- let addGoto (lname: string) (bref: stmt ref) : unit =
- let gotos =
- try
- H.find backPatchGotos lname
- with Not_found -> begin
- let gotos = ref [] in
- H.add backPatchGotos lname gotos;
- gotos
- end
- in
- gotos := bref :: !gotos
-
- (* Keep track of the labels *)
- let labelStmt : (string, stmt) H.t = H.create 17
- let initLabels () =
- H.clear backPatchGotos;
- H.clear labelStmt
-
- let resolveGotos () =
- H.iter
- (fun lname gotos ->
- try
- let dest = H.find labelStmt lname in
- List.iter (fun gref -> gref := dest) !gotos
- with Not_found -> begin
- E.s (error "Label %s not found\n" lname)
- end)
- backPatchGotos
-
- (* Get the first statement in a chunk. Might need to change the
- * statements in the chunk *)
- let getFirstInChunk (c: chunk) : stmt * stmt list =
- (* Get the first statement and add the label to it *)
- match c.stmts with
- s :: _ -> s, c.stmts
- | [] -> (* Add a statement *)
- let n = mkEmptyStmt () in
- n, n :: c.stmts
-
- let consLabel (l: string) (c: chunk) (loc: location)
- (in_original_program_text : bool) : chunk =
- (* Get the first statement and add the label to it *)
- let labstmt, stmts' = getFirstInChunk c in
- (* Add the label *)
- labstmt.labels <- Label (l, loc, in_original_program_text) ::
- labstmt.labels;
- H.add labelStmt l labstmt;
- if c.stmts == stmts' then c else {c with stmts = stmts'}
-
- let s2c (s:stmt) : chunk =
- { stmts = [ s ];
- postins = [];
- cases = [];
- }
-
- let gotoChunk (ln: string) (l: location) : chunk =
- let gref = ref dummyStmt in
- addGoto ln gref;
- { stmts = [ mkStmt (Goto (gref, l)) ];
- postins = [];
- cases = [];
- }
-
- let caseRangeChunk (el: exp list) (l: location) (next: chunk) =
- let fst, stmts' = getFirstInChunk next in
- let labels = List.map (fun e -> Case (e, l)) el in
- let cases = List.map (fun l -> (l, fst)) labels in
- fst.labels <- labels @ fst.labels;
- { next with stmts = stmts'; cases = cases @ next.cases}
-
- let defaultChunk (l: location) (next: chunk) =
- let fst, stmts' = getFirstInChunk next in
- let lb = Default l in
- fst.labels <- lb :: fst.labels;
- { next with stmts = stmts'; cases = (lb, fst) :: next.cases}
-
-
- let switchChunk (e: exp) (body: chunk) (l: location) =
- (* Make the statement *)
- let switch = mkStmt (Switch (e, c2block body,
- List.map (fun (_, s) -> s) body.cases,
- l)) in
- { stmts = [ switch (* ; n *) ];
- postins = [];
- cases = [];
- }
-
- let mkFunctionBody (c: chunk) : block =
- resolveGotos (); initLabels ();
- if c.cases <> [] then
- E.s (error "Switch cases not inside a switch statement\n");
- c2block c
-
- end
-
-open BlockChunk
-
-
-(************ Labels ***********)
-(*
-(* Since we turn dowhile and for loops into while we need to take care in
- * processing the continue statement. For each loop that we enter we place a
- * marker in a list saying what kinds of loop it is. When we see a continue
- * for a Non-while loop we must generate a label for the continue *)
-type loopstate =
- While
- | NotWhile of string ref
-
-let continues : loopstate list ref = ref []
-
-let startLoop iswhile =
- continues := (if iswhile then While else NotWhile (ref "")) :: !continues
-*)
-
-(* We need to take care while processing the continue statement...
- * For each loop that we enter we place a marker in a list saying what
- * chunk of code we must duplicate before each continue statement
- * in order to preserve the semantics. *)
-type loopMarker =
- | DuplicateBeforeContinue of chunk
- | ContinueUnchanged
-
-let continues : loopMarker list ref = ref []
-
-let startLoop lstate =
- continues := lstate :: !continues
-
-let continueDuplicateChunk (l: location) : chunk =
- match !continues with
- | [] -> E.s (error "continue not in a loop")
- | DuplicateBeforeContinue c :: _ -> c @@ continueChunk l
- | ContinueUnchanged :: _ -> continueChunk l
-
-(* Sometimes we need to create new label names *)
-let newLabelName (base: string) = fst (newAlphaName false "label" base)
-
-(*
-let continueOrLabelChunk (l: location) : chunk =
- match !continues with
- [] -> E.s (error "continue not in a loop")
- | While :: _ -> continueChunk l
- | NotWhile lr :: _ ->
- if !lr = "" then begin
- lr := newLabelName "__Cont"
- end;
- gotoChunk !lr l
-
-let consLabContinue (c: chunk) =
- match !continues with
- [] -> E.s (error "labContinue not in a loop")
- | While :: rest -> c
- | NotWhile lr :: rest -> if !lr = "" then c else consLabel !lr c !currentLoc false
-*)
-
-let exitLoop () =
- match !continues with
- [] -> E.s (error "exit Loop not in a loop")
- | _ :: rest -> continues := rest
-
-
-(* In GCC we can have locally declared labels. *)
-let genNewLocalLabel (l: string) =
- (* Call the newLabelName to register the label name in the alpha conversion
- * table. *)
- let l' = newLabelName l in
- (* Add it to the environment *)
- addLocalToEnv (kindPlusName "label" l) (EnvLabel l');
- l'
-
-let lookupLabel (l: string) =
- try
- match H.find env (kindPlusName "label" l) with
- EnvLabel l', _ -> l'
- | _ -> raise Not_found
- with Not_found ->
- l
-
-
-(** ALLOCA ***)
-let allocaFun () =
- let name =
- if !msvcMode then "alloca"
- (* Use __builtin_alloca where possible, because this can be used
- even when gcc is invoked with -fno-builtin *)
- else "__builtin_alloca"
- in
- let fdec = emptyFunction name in
- fdec.svar.vtype <-
- TFun(voidPtrType, Some [ ("len", !typeOfSizeOf, []) ], false, []);
- fdec.svar
-
-(* Maps local variables that are variable sized arrays to the expression that
- * denotes their length *)
-let varSizeArrays : exp IH.t = IH.create 17
-
-(**** EXP actions ***)
-type expAction =
- ADrop (* Drop the result. Only the
- * side-effect is interesting *)
- | ASet of lval * typ (* Put the result in a given lval,
- * provided it matches the type. The
- * type is the type of the lval. *)
- | AExp of typ option (* Return the exp as usual.
- * Optionally we can specify an
- * expected type. This is useful for
- * constants. The expected type is
- * informational only, we do not
- * guarantee that the converted
- * expression has that type.You must
- * use a doCast afterwards to make
- * sure. *)
- | AExpLeaveArrayFun (* Do it like an expression, but do
- * not convert arrays of functions
- * into pointers *)
-
-
-(*** Result of compiling conditional expressions *)
-type condExpRes =
- CEExp of chunk * exp (* Do a chunk and then an expression *)
- | CEAnd of condExpRes * condExpRes
- | CEOr of condExpRes * condExpRes
- | CENot of condExpRes
-
-(******** CASTS *********)
-let integralPromotion (t : typ) : typ = (* c.f. ISO 6.3.1.1 *)
- match unrollType t with
- (* We assume that an IInt can hold even an IUShort *)
- TInt ((IShort|IUShort|IChar|ISChar|IUChar), a) -> TInt(IInt, a)
- | TInt _ -> t
- | TEnum (_, a) -> TInt(IInt, a)
- | t -> E.s (error "integralPromotion: not expecting %a" d_type t)
-
-
-let arithmeticConversion (* c.f. ISO 6.3.1.8 *)
- (t1: typ)
- (t2: typ) : typ =
- let checkToInt _ = () in (* dummies for now *)
- let checkToFloat _ = () in
- match unrollType t1, unrollType t2 with
- TFloat(FLongDouble, _), _ -> checkToFloat t2; t1
- | _, TFloat(FLongDouble, _) -> checkToFloat t1; t2
- | TFloat(FDouble, _), _ -> checkToFloat t2; t1
- | _, TFloat (FDouble, _) -> checkToFloat t1; t2
- | TFloat(FFloat, _), _ -> checkToFloat t2; t1
- | _, TFloat (FFloat, _) -> checkToFloat t1; t2
- | _, _ -> begin
- let t1' = integralPromotion t1 in
- let t2' = integralPromotion t2 in
- match unrollType t1', unrollType t2' with
- TInt(IULongLong, _), _ -> checkToInt t2'; t1'
- | _, TInt(IULongLong, _) -> checkToInt t1'; t2'
-
- (* We assume a long long is always larger than a long *)
- | TInt(ILongLong, _), _ -> checkToInt t2'; t1'
- | _, TInt(ILongLong, _) -> checkToInt t1'; t2'
-
- | TInt(IULong, _), _ -> checkToInt t2'; t1'
- | _, TInt(IULong, _) -> checkToInt t1'; t2'
-
-
- | TInt(ILong,_), TInt(IUInt,_)
- when bitsSizeOf t1' <= bitsSizeOf t2' -> TInt(IULong,[])
- | TInt(IUInt,_), TInt(ILong,_)
- when bitsSizeOf t2' <= bitsSizeOf t1' -> TInt(IULong,[])
-
- | TInt(ILong, _), _ -> checkToInt t2'; t1'
- | _, TInt(ILong, _) -> checkToInt t1'; t2'
-
- | TInt(IUInt, _), _ -> checkToInt t2'; t1'
- | _, TInt(IUInt, _) -> checkToInt t1'; t2'
-
- | TInt(IInt, _), TInt (IInt, _) -> t1'
-
- | _, _ -> E.s (error "arithmeticConversion")
- end
-
-
-(* Specify whether the cast is from the source code *)
-let rec castTo ?(fromsource=false)
- (ot : typ) (nt : typ) (e : exp) : (typ * exp ) =
-(*
- ignore (E.log "%t: castTo:%s %a->%a\n"
- d_thisloc
- (if fromsource then "(source)" else "")
- d_type ot d_type nt);
-*)
- if not fromsource && Util.equals (typeSig ot) (typeSig nt) then
- (* Do not put the cast if it is not necessary, unless it is from the
- * source. *)
- (ot, e)
- else begin
- let result = (nt,
- if !insertImplicitCasts || fromsource then mkCastT e ot nt else e) in
-(*
- ignore (E.log "castTo: ot=%a nt=%a\n result is %a\n"
- d_type ot d_type nt
- d_plainexp (snd result));
-*)
- (* Now see if we can have a cast here *)
- match ot, nt with
- TNamed(r, _), _ -> castTo ~fromsource:fromsource r.ttype nt e
- | _, TNamed(r, _) -> castTo ~fromsource:fromsource ot r.ttype e
- | TInt(ikindo,_), TInt(ikindn,_) ->
- (* We used to ignore attributes on integer-integer casts. Not anymore *)
- (* if ikindo = ikindn then (nt, e) else *)
- result
-
- | TPtr (told, _), TPtr(tnew, _) -> result
-
- | TInt _, TPtr _ -> result
-
- | TPtr _, TInt _ -> result
-
- | TArray _, TPtr _ -> result
-
- | TArray(t1,_,_), TArray(t2,None,_) when Util.equals (typeSig t1) (typeSig t2) -> (nt, e)
-
- | TPtr _, TArray(_,_,_) -> (nt, e)
-
- | TEnum _, TInt _ -> result
- | TFloat _, (TInt _|TEnum _) -> result
- | (TInt _|TEnum _), TFloat _ -> result
- | TFloat _, TFloat _ -> result
- | TInt _, TEnum _ -> result
- | TEnum _, TEnum _ -> result
-
- | TEnum _, TPtr _ -> result
- | TBuiltin_va_list _, (TInt _ | TPtr _) ->
- result
-
- | (TInt _ | TPtr _), TBuiltin_va_list _ ->
- ignore (warnOpt "Casting %a to __builtin_va_list" d_type ot);
- result
-
- | TPtr _, TEnum _ ->
- ignore (warnOpt "Casting a pointer into an enumeration type");
- result
-
- (* The expression is evaluated for its side-effects *)
- | (TInt _ | TEnum _ | TPtr _ ), TVoid _ ->
- (ot, e)
-
- (* Even casts between structs are allowed when we are only
- * modifying some attributes *)
- | TComp (comp1, a1), TComp (comp2, a2) when comp1.ckey = comp2.ckey ->
- (nt, e)
-
- (** If we try to pass a transparent union value to a function
- * expecting a transparent union argument, the argument type would
- * have been changed to the type of the first argument, and we'll
- * see a cast from a union to the type of the first argument. Turn
- * that into a field access *)
- | TComp(tunion, a1), nt -> begin
- match isTransparentUnion ot with
- None -> E.s (error "castTo %a -> %a@!" d_type ot d_type nt)
- | Some fstfield -> begin
- (* We do it now only if the expression is an lval *)
- let e' =
- match e with
- Lval lv ->
- Lval (addOffsetLval (Field(fstfield, NoOffset)) lv)
- | _ -> E.s (unimp "castTo: transparent union expression is not an lval: %a\n" d_exp e)
- in
- (* Continue casting *)
- castTo ~fromsource:fromsource fstfield.ftype nt e'
- end
- end
- | _ -> E.s (error "cabs2cil: castTo %a -> %a@!" d_type ot d_type nt)
- end
-
-
-(* A cast that is used for conditional expressions. Pointers are Ok *)
-let checkBool (ot : typ) (e : exp) : bool =
- match unrollType ot with
- TInt _ -> true
- | TPtr _ -> true
- | TEnum _ -> true
- | TFloat _ -> true
- | _ -> E.s (error "castToBool %a" d_type ot)
-
-(* Given an expression that is being coerced to bool,
- is it a nonzero constant? *)
-let rec isConstTrue (e:exp): bool =
- match e with
- | Const(CInt64 (n,_,_)) -> n <> Int64.zero
- | Const(CChr c) -> 0 <> Char.code c
- | Const(CStr _ | CWStr _) -> true
- | Const(CReal(f, _, _)) -> f <> 0.0;
- | CastE(_, e) -> isConstTrue e
- | _ -> false
-
-(* Given an expression that is being coerced to bool, is it zero?
- This is a more general version of Cil.isZero, which only handles integers.
- On constant expressions, either isConstTrue or isConstFalse will hold. *)
-let rec isConstFalse (e:exp): bool =
- match e with
- | Const(CInt64 (n,_,_)) -> n = Int64.zero
- | Const(CChr c) -> 0 = Char.code c
- | Const(CReal(f, _, _)) -> f = 0.0;
- | CastE(_, e) -> isConstFalse e
- | _ -> false
-
-
-
-(* We have our own version of addAttributes that does not allow duplicates *)
-let cabsAddAttributes al0 (al: attributes) : attributes =
- if al0 == [] then al else
- List.fold_left
- (fun acc (Attr(an, _) as a) ->
- (* See if the attribute is already in there *)
- match filterAttributes an acc with
- [] -> addAttribute a acc (* Nothing with that name *)
- | a' :: _ ->
- if Util.equals a a' then
- acc (* Already in *)
- else begin
- ignore (warnOpt
- "Duplicate attribute %a along with %a"
- d_attr a d_attr a');
- (* let acc' = dropAttribute an acc in *)
- (** Keep both attributes *)
- addAttribute a acc
- end)
- al
- al0
-
-let cabsTypeAddAttributes a0 t =
- begin
- match a0 with
- | [] ->
- (* no attributes, keep same type *)
- t
- | _ ->
- (* anything else: add a0 to existing attributes *)
- let add (a: attributes) = cabsAddAttributes a0 a in
- match t with
- TVoid a -> TVoid (add a)
- | TInt (ik, a) ->
- (* Here we have to watch for the mode attribute *)
-(* sm: This stuff is to handle a GCC extension where you can request integers*)
-(* of specific widths using the "mode" attribute syntax; for example: *)
-(* typedef int int8_t __attribute__ ((__mode__ ( __QI__ ))) ; *)
-(* The cryptic "__QI__" defines int8_t to be 8 bits wide, instead of the *)
-(* 32 bits you'd guess if you didn't know about "mode". The relevant *)
-(* testcase is test/small2/mode_sizes.c, and it was inspired by my *)
-(* /usr/include/sys/types.h. *)
-(* *)
-(* A consequence of this handling is that we throw away the mode *)
-(* attribute, which we used to go out of our way to avoid printing anyway.*)
- let ik', a0' =
- (* Go over the list of new attributes and come back with a
- * filtered list and a new integer kind *)
- List.fold_left
- (fun (ik', a0') a0one ->
- match a0one with
- Attr("mode", [ACons(mode,[])]) -> begin
- (trace "gccwidth" (dprintf "I see mode %s applied to an int type\n"
- mode (* #$@!#@ ML! d_type t *) ));
- (* the cases below encode the 32-bit assumption.. *)
- match (ik', mode) with
- | (IInt, "__QI__") -> (IChar, a0')
- | (IInt, "__byte__") -> (IChar, a0')
- | (IInt, "__HI__") -> (IShort, a0')
- | (IInt, "__SI__") -> (IInt, a0') (* same as t *)
- | (IInt, "__word__") -> (IInt, a0')
- | (IInt, "__pointer__") -> (IInt, a0')
- | (IInt, "__DI__") -> (ILongLong, a0')
-
- | (IUInt, "__QI__") -> (IUChar, a0')
- | (IUInt, "__byte__") -> (IUChar, a0')
- | (IUInt, "__HI__") -> (IUShort, a0')
- | (IUInt, "__SI__") -> (IUInt, a0')
- | (IUInt, "__word__") -> (IUInt, a0')
- | (IUInt, "__pointer__")-> (IUInt, a0')
- | (IUInt, "__DI__") -> (IULongLong, a0')
-
- | _ ->
- (ignore (error "GCC width mode %s applied to unexpected type, or unexpected mode"
- mode));
- (ik', a0one :: a0')
-
- end
- | _ -> (ik', a0one :: a0'))
- (ik, [])
- a0
- in
- TInt (ik', cabsAddAttributes a0' a)
-
- | TFloat (fk, a) -> TFloat (fk, add a)
- | TEnum (enum, a) -> TEnum (enum, add a)
- | TPtr (t, a) -> TPtr (t, add a)
- | TArray (t, l, a) -> TArray (t, l, add a)
- | TFun (t, args, isva, a) -> TFun(t, args, isva, add a)
- | TComp (comp, a) -> TComp (comp, add a)
- | TNamed (t, a) -> TNamed (t, add a)
- | TBuiltin_va_list a -> TBuiltin_va_list (add a)
- end
-
-
-(* Do types *)
- (* Combine the types. Raises the Failure exception with an error message.
- * isdef says whether the new type is for a definition *)
-type combineWhat =
- CombineFundef (* The new definition is for a function definition. The old
- * is for a prototype *)
- | CombineFunarg (* Comparing a function argument type with an old prototype
- * arg *)
- | CombineFunret (* Comparing the return of a function with that from an old
- * prototype *)
- | CombineOther
-
-(* We sometimes want to succeed in combining two structure types that are
- * identical except for the names of the structs. We keep a list of types
- * that are known to be equal *)
-let isomorphicStructs : (string * string, bool) H.t = H.create 15
-
-let rec combineTypes (what: combineWhat) (oldt: typ) (t: typ) : typ =
- match oldt, t with
- | TVoid olda, TVoid a -> TVoid (cabsAddAttributes olda a)
- | TInt (oldik, olda), TInt (ik, a) ->
- let combineIK oldk k =
- if oldk = k then oldk else
- (* GCC allows a function definition to have a more precise integer
- * type than a prototype that says "int" *)
- if not !msvcMode && oldk = IInt && bitsSizeOf t <= 32
- && (what = CombineFunarg || what = CombineFunret) then
- k
- else
- raise (Failure "different integer types")
- in
- TInt (combineIK oldik ik, cabsAddAttributes olda a)
- | TFloat (oldfk, olda), TFloat (fk, a) ->
- let combineFK oldk k =
- if oldk = k then oldk else
- (* GCC allows a function definition to have a more precise integer
- * type than a prototype that says "double" *)
- if not !msvcMode && oldk = FDouble && k = FFloat
- && (what = CombineFunarg || what = CombineFunret) then
- k
- else
- raise (Failure "different floating point types")
- in
- TFloat (combineFK oldfk fk, cabsAddAttributes olda a)
- | TEnum (_, olda), TEnum (ei, a) ->
- TEnum (ei, cabsAddAttributes olda a)
-
- (* Strange one. But seems to be handled by GCC *)
- | TEnum (oldei, olda) , TInt(IInt, a) -> TEnum(oldei,
- cabsAddAttributes olda a)
- (* Strange one. But seems to be handled by GCC *)
- | TInt(IInt, olda), TEnum (ei, a) -> TEnum(ei, cabsAddAttributes olda a)
-
-
- | TComp (oldci, olda) , TComp (ci, a) ->
- if oldci.cstruct <> ci.cstruct then
- raise (Failure "different struct/union types");
- let comb_a = cabsAddAttributes olda a in
- if oldci.cname = ci.cname then
- TComp (oldci, comb_a)
- else
- (* Now maybe they are actually the same *)
- if H.mem isomorphicStructs (oldci.cname, ci.cname) then
- (* We know they are the same *)
- TComp (oldci, comb_a)
- else begin
- (* If one has 0 fields (undefined) while the other has some fields
- * we accept it *)
- let oldci_nrfields = List.length oldci.cfields in
- let ci_nrfields = List.length ci.cfields in
- if oldci_nrfields = 0 then
- TComp (ci, comb_a)
- else if ci_nrfields = 0 then
- TComp (oldci, comb_a)
- else begin
- (* Make sure that at least they have the same number of fields *)
- if oldci_nrfields <> ci_nrfields then begin
-(*
- ignore (E.log "different number of fields: %s had %d and %s had %d\n"
- oldci.cname oldci_nrfields
- ci.cname ci_nrfields);
-*)
- raise (Failure "different structs(number of fields)");
- end;
- (* Assume they are the same *)
- H.add isomorphicStructs (oldci.cname, ci.cname) true;
- H.add isomorphicStructs (ci.cname, oldci.cname) true;
- (* Check that the fields are isomorphic and watch for Failure *)
- (try
- List.iter2 (fun oldf f ->
- if oldf.fbitfield <> f.fbitfield then
- raise (Failure "different structs(bitfield info)");
- if oldf.fattr <> f.fattr then
- raise (Failure "different structs(field attributes)");
- (* Make sure the types are compatible *)
- ignore (combineTypes CombineOther oldf.ftype f.ftype);
- ) oldci.cfields ci.cfields
- with Failure _ as e -> begin
- (* Our assumption was wrong. Forget the isomorphism *)
- ignore (E.log "\tFailed in our assumption that %s and %s are isomorphic\n"
- oldci.cname ci.cname);
- H.remove isomorphicStructs (oldci.cname, ci.cname);
- H.remove isomorphicStructs (ci.cname, oldci.cname);
- raise e
- end);
- (* We get here if we succeeded *)
- TComp (oldci, comb_a)
- end
- end
-
- | TArray (oldbt, oldsz, olda), TArray (bt, sz, a) ->
- let newbt = combineTypes CombineOther oldbt bt in
- let newsz =
- match oldsz, sz with
- None, Some _ -> sz
- | Some _, None -> oldsz
- | None, None -> sz
- | Some oldsz', Some sz' ->
- (* They are not structurally equal. But perhaps they are equal if
- * we evaluate them. Check first machine independent comparison *)
- let checkEqualSize (machdep: bool) =
- Util.equals (constFold machdep oldsz')
- (constFold machdep sz')
- in
- if checkEqualSize false then
- oldsz
- else if checkEqualSize true then begin
- ignore (warn "Array type comparison succeeds only based on machine-dependent constant evaluation: %a and %a\n"
- d_exp oldsz' d_exp sz');
- oldsz
- end else
- raise (Failure "different array lengths")
-
- in
- TArray (newbt, newsz, cabsAddAttributes olda a)
-
- | TPtr (oldbt, olda), TPtr (bt, a) ->
- TPtr (combineTypes CombineOther oldbt bt, cabsAddAttributes olda a)
-
- | TFun (_, _, _, [Attr("missingproto",_)]), TFun _ -> t
-
- | TFun (oldrt, oldargs, oldva, olda), TFun (rt, args, va, a) ->
- let newrt = combineTypes
- (if what = CombineFundef then CombineFunret else CombineOther)
- oldrt rt
- in
- if oldva != va then
- raise (Failure "diferent vararg specifiers");
- (* If one does not have arguments, believe the one with the
- * arguments *)
- let newargs =
- if oldargs = None then args else
- if args = None then oldargs else
- let oldargslist = argsToList oldargs in
- let argslist = argsToList args in
- if List.length oldargslist <> List.length argslist then
- raise (Failure "different number of arguments")
- else begin
- (* Go over the arguments and update the old ones with the
- * adjusted types *)
- Some
- (List.map2
- (fun (on, ot, oa) (an, at, aa) ->
- (* Update the names. Always prefer the new name. This is
- * very important if the prototype uses different names than
- * the function definition. *)
- let n = if an <> "" then an else on in
- let t =
- combineTypes
- (if what = CombineFundef then
- CombineFunarg else CombineOther)
- ot at
- in
- let a = addAttributes oa aa in
- (n, t, a))
- oldargslist argslist)
- end
- in
- TFun (newrt, newargs, oldva, cabsAddAttributes olda a)
-
- | TNamed (oldt, olda), TNamed (t, a) when oldt.tname = t.tname ->
- TNamed (oldt, cabsAddAttributes olda a)
-
- | TBuiltin_va_list olda, TBuiltin_va_list a ->
- TBuiltin_va_list (cabsAddAttributes olda a)
-
- (* Unroll first the new type *)
- | _, TNamed (t, a) ->
- let res = combineTypes what oldt t.ttype in
- cabsTypeAddAttributes a res
-
- (* And unroll the old type as well if necessary *)
- | TNamed (oldt, a), _ ->
- let res = combineTypes what oldt.ttype t in
- cabsTypeAddAttributes a res
-
- | _ -> raise (Failure "different type constructors")
-
-
-(* Create and cache varinfo's for globals. Starts with a varinfo but if the
- * global has been declared already it might come back with another varinfo.
- * Returns the varinfo to use (might be the old one), and an indication
- * whether the variable exists already in the environment *)
-let makeGlobalVarinfo (isadef: bool) (vi: varinfo) : varinfo * bool =
- try (* See if already defined, in the global environment. We could also
- * look it up in the whole environment but in that case we might see a
- * local. This can happen when we declare an extern variable with
- * global scope but we are in a local scope. *)
- let oldvi, oldloc = lookupGlobalVar vi.vname in
- (* It was already defined. We must reuse the varinfo. But clean up the
- * storage. *)
- let newstorage = (** See 6.2.2 *)
- match oldvi.vstorage, vi.vstorage with
- (* Extern and something else is that thing *)
- | Extern, other
- | other, Extern -> other
-
- | NoStorage, other
- | other, NoStorage -> other
-
-
- | _ ->
- if vi.vstorage != oldvi.vstorage then
- ignore (warn
- "Inconsistent storage specification for %s. Previous declaration: %a"
- vi.vname d_loc oldloc);
- vi.vstorage
- in
- oldvi.vinline <- oldvi.vinline || vi.vinline;
- oldvi.vstorage <- newstorage;
- (* Union the attributes *)
- oldvi.vattr <- cabsAddAttributes oldvi.vattr vi.vattr;
- begin
- try
- oldvi.vtype <-
- combineTypes
- (if isadef then CombineFundef else CombineOther)
- oldvi.vtype vi.vtype;
- with Failure reason ->
- ignore (E.log "old type = %a\n" d_plaintype oldvi.vtype);
- ignore (E.log "new type = %a\n" d_plaintype vi.vtype);
- E.s (error "Declaration of %s does not match previous declaration from %a (%s)."
- vi.vname d_loc oldloc reason)
- end;
-
- (* Found an old one. Keep the location always from the definition *)
- if isadef then begin
- oldvi.vdecl <- vi.vdecl;
- end;
- oldvi, true
-
- with Not_found -> begin (* A new one. *)
- (* Announce the name to the alpha conversion table. This will not
- * actually change the name of the vi. See the definition of
- * alphaConvertVarAndAddToEnv *)
- alphaConvertVarAndAddToEnv true vi, false
- end
-
-let conditionalConversion (t2: typ) (t3: typ) : typ =
- let tresult = (* ISO 6.5.15 *)
- match unrollType t2, unrollType t3 with
- (TInt _ | TEnum _ | TFloat _),
- (TInt _ | TEnum _ | TFloat _) ->
- arithmeticConversion t2 t3
- | TComp (comp2,_), TComp (comp3,_)
- when comp2.ckey = comp3.ckey -> t2
- | TPtr(_, _), TPtr(TVoid _, _) -> t2
- | TPtr(TVoid _, _), TPtr(_, _) -> t3
- | TPtr _, TPtr _ when Util.equals (typeSig t2) (typeSig t3) -> t2
- | TPtr _, TInt _ -> t2 (* most likely comparison with 0 *)
- | TInt _, TPtr _ -> t3 (* most likely comparison with 0 *)
-
- (* When we compare two pointers of diffent type, we combine them
- * using the same algorithm when combining multiple declarations of
- * a global *)
- | (TPtr _) as t2', (TPtr _ as t3') -> begin
- try combineTypes CombineOther t2' t3'
- with Failure msg -> begin
- ignore (warn "A.QUESTION: %a does not match %a (%s)"
- d_type (unrollType t2) d_type (unrollType t3) msg);
- t2 (* Just pick one *)
- end
- end
- | _, _ -> E.s (error "A.QUESTION for invalid combination of types")
- in
- tresult
-
-(* Some utilitites for doing initializers *)
-
-let debugInit = false
-
-type preInit =
- | NoInitPre
- | SinglePre of exp
- | CompoundPre of int ref (* the maximum used index *)
- * preInit array ref (* an array with initializers *)
-
-(* Instructions on how to handle designators *)
-type handleDesignators =
- | Handle (* Handle them yourself *)
- | DoNotHandle (* Do not handle them your self *)
- | HandleAsNext (* First behave as if you have a NEXT_INIT. Useful for going
- * into nested designators *)
- | HandleFirst (* Handle only the first designator *)
-
-(* Set an initializer *)
-let rec setOneInit (this: preInit)
- (o: offset) (e: exp) : preInit =
- match o with
- NoOffset -> SinglePre e
- | _ ->
- let idx, (* Index in the current comp *)
- restoff (* Rest offset *) =
- match o with
- | Index(Const(CInt64(i,_,_)), off) -> Int64.to_int i, off
- | Field (f, off) ->
- (* Find the index of the field *)
- let rec loop (idx: int) = function
- [] -> E.s (bug "Cannot find field %s" f.fname)
- | f' :: _ when f'.fname = f.fname -> idx
- | _ :: restf -> loop (idx + 1) restf
- in
- loop 0 f.fcomp.cfields, off
- | _ -> E.s (bug "setOneInit: non-constant index")
- in
- let pMaxIdx, pArray =
- match this with
- NoInitPre -> (* No initializer so far here *)
- ref idx, ref (Array.create (max 32 (idx + 1)) NoInitPre)
-
- | CompoundPre (pMaxIdx, pArray) ->
- if !pMaxIdx < idx then begin
- pMaxIdx := idx;
- (* Maybe we also need to grow the array *)
- let l = Array.length !pArray in
- if l <= idx then begin
- let growBy = max (max 32 (idx + 1 - l)) (l / 2) in
- let newarray = Array.make (growBy + idx) NoInitPre in
- Array.blit !pArray 0 newarray 0 l;
- pArray := newarray
- end
- end;
- pMaxIdx, pArray
- | SinglePre e ->
- E.s (unimp "Index %d is already initialized" idx)
- in
- assert (idx >= 0 && idx < Array.length !pArray);
- let this' = setOneInit !pArray.(idx) restoff e in
- !pArray.(idx) <- this';
- CompoundPre (pMaxIdx, pArray)
-
-
-(* collect a CIL initializer, given the original syntactic initializer
- * 'preInit'; this returns a type too, since initialization of an array
- * with unspecified size actually changes the array's type
- * (ANSI C, 6.7.8, para 22) *)
-let rec collectInitializer
- (this: preInit)
- (thistype: typ) : (init * typ) =
- if this = NoInitPre then (makeZeroInit thistype), thistype
- else
- match unrollType thistype, this with
- | _ , SinglePre e -> SingleInit e, thistype
- | TArray (bt, leno, at), CompoundPre (pMaxIdx, pArray) ->
- let (len: int), newtype =
- (* normal case: use array's declared length, newtype=thistype *)
- match leno with
- Some len -> begin
- match constFold true len with
- Const(CInt64(ni, _, _)) when ni >= 0L ->
- (Int64.to_int ni), TArray(bt,leno,at)
-
- | _ -> E.s (error "Array length is not a constant expression %a"
- d_exp len)
- end
- | _ ->
- (* unsized array case, length comes from initializers *)
- (!pMaxIdx + 1,
- TArray (bt, Some (integer (!pMaxIdx + 1)), at))
- in
- if !pMaxIdx >= len then
- E.s (E.bug "collectInitializer: too many initializers(%d >= %d)\n"
- !pMaxIdx len);
- (* len could be extremely big. So omit the last initializers, if they
- * are many (more than 16) *)
-(*
- ignore (E.log "collectInitializer: len = %d, pMaxIdx= %d\n"
- len !pMaxIdx); *)
- let endAt =
- if len - 1 > !pMaxIdx + 16 then
- !pMaxIdx
- else
- len - 1
- in
- (* Make one zero initializer to be used next *)
- let oneZeroInit = makeZeroInit bt in
- let rec collect (acc: (offset * init) list) (idx: int) =
- if idx = -1 then acc
- else
- let thisi =
- if idx > !pMaxIdx then oneZeroInit
- else (fst (collectInitializer !pArray.(idx) bt))
- in
- collect ((Index(integer idx, NoOffset), thisi) :: acc) (idx - 1)
- in
-
- CompoundInit (newtype, collect [] endAt), newtype
-
- | TComp (comp, _), CompoundPre (pMaxIdx, pArray) when comp.cstruct ->
- let rec collect (idx: int) = function
- [] -> []
- | f :: restf ->
- if f.fname = missingFieldName then
- collect (idx + 1) restf
- else
- let thisi =
- if idx > !pMaxIdx then
- makeZeroInit f.ftype
- else
- collectFieldInitializer !pArray.(idx) f
- in
- (Field(f, NoOffset), thisi) :: collect (idx + 1) restf
- in
- CompoundInit (thistype, collect 0 comp.cfields), thistype
-
- | TComp (comp, _), CompoundPre (pMaxIdx, pArray) when not comp.cstruct ->
- (* Find the field to initialize *)
- let rec findField (idx: int) = function
- [] -> E.s (bug "collectInitializer: union")
- | _ :: rest when idx < !pMaxIdx && !pArray.(idx) = NoInitPre ->
- findField (idx + 1) rest
- | f :: _ when idx = !pMaxIdx ->
- Field(f, NoOffset),
- collectFieldInitializer !pArray.(idx) f
- | _ -> E.s (error "Can initialize only one field for union")
- in
- if !msvcMode && !pMaxIdx != 0 then
- ignore (warn "On MSVC we can initialize only the first field of a union");
- CompoundInit (thistype, [ findField 0 comp.cfields ]), thistype
-
- | _ -> E.s (unimp "collectInitializer")
-
-and collectFieldInitializer
- (this: preInit)
- (f: fieldinfo) : init =
- (* collect, and rewrite type *)
- let init,newtype = (collectInitializer this f.ftype) in
- f.ftype <- newtype;
- init
-
-
-type stackElem =
- InArray of offset * typ * int * int ref (* offset of parent, base type,
- * length, current index. If the
- * array length is unspecified we
- * use Int.max_int *)
- | InComp of offset * compinfo * fieldinfo list (* offset of parent,
- base comp, current fields *)
-
-
-(* A subobject is given by its address. The address is read from the end of
- * the list (the bottom of the stack), starting with the current object *)
-type subobj = { mutable stack: stackElem list; (* With each stack element we
- * store the offset of its
- * PARENT *)
- mutable eof: bool; (* The stack is empty and we reached the
- * end *)
- mutable soTyp: typ; (* The type of the subobject. Set using
- * normalSubobj after setting stack. *)
- mutable soOff: offset; (* The offset of the subobject. Set
- * using normalSubobj after setting
- * stack. *)
- curTyp: typ; (* Type of current object. See ISO for
- * the definition of the current object *)
- curOff: offset; (* The offset of the current obj *)
- host: varinfo; (* The host that we are initializing.
- * For error messages *)
- }
-
-
-(* Make a subobject iterator *)
-let rec makeSubobj
- (host: varinfo)
- (curTyp: typ)
- (curOff: offset) =
- let so =
- { host = host; curTyp = curTyp; curOff = curOff;
- stack = []; eof = false;
- (* The next are fixed by normalSubobj *)
- soTyp = voidType; soOff = NoOffset } in
- normalSubobj so;
- so
-
- (* Normalize a stack so the we always point to a valid subobject. Do not
- * descend into type *)
-and normalSubobj (so: subobj) : unit =
- match so.stack with
- [] -> so.soOff <- so.curOff; so.soTyp <- so.curTyp
- (* The array is over *)
- | InArray (parOff, bt, leno, current) :: rest ->
- if leno = !current then begin (* The array is over *)
- if debugInit then ignore (E.log "Past the end of array\n");
- so.stack <- rest;
- advanceSubobj so
- end else begin
- so.soTyp <- bt;
- so.soOff <- addOffset (Index(integer !current, NoOffset)) parOff
- end
-
- (* The fields are over *)
- | InComp (parOff, comp, nextflds) :: rest ->
- if nextflds == [] then begin (* No more fields here *)
- if debugInit then ignore (E.log "Past the end of structure\n");
- so.stack <- rest;
- advanceSubobj so
- end else begin
- let fst = List.hd nextflds in
- so.soTyp <- fst.ftype;
- so.soOff <- addOffset (Field(fst, NoOffset)) parOff
- end
-
- (* Advance to the next subobject. Always apply to a normalized object *)
-and advanceSubobj (so: subobj) : unit =
- if so.eof then E.s (bug "advanceSubobj past end");
- match so.stack with
- | [] -> if debugInit then ignore (E.log "Setting eof to true\n");
- so.eof <- true
- | InArray (parOff, bt, leno, current) :: rest ->
- if debugInit then ignore (E.log " Advancing to [%d]\n" (!current + 1));
- (* so.stack <- InArray (parOff, bt, leno, current + 1) :: rest; *)
- incr current;
- normalSubobj so
-
- (* The fields are over *)
- | InComp (parOff, comp, nextflds) :: rest ->
- if debugInit then
- ignore (E.log "Advancing past .%s\n" (List.hd nextflds).fname);
- let flds' = try List.tl nextflds with _ -> E.s (bug "advanceSubobj") in
- so.stack <- InComp(parOff, comp, flds') :: rest;
- normalSubobj so
-
-
-
-(* Find the fields to initialize in a composite. *)
-let fieldsToInit
- (comp: compinfo)
- (designator: string option)
- : fieldinfo list =
- (* Never look at anonymous fields *)
- let flds1 =
- List.filter (fun f -> f.fname <> missingFieldName) comp.cfields in
- let flds2 =
- match designator with
- None -> flds1
- | Some fn ->
- let rec loop = function
- [] -> E.s (error "Cannot find designated field %s" fn)
- | (f :: _) as nextflds when f.fname = fn -> nextflds
- | _ :: rest -> loop rest
- in
- loop flds1
- in
- (* If it is a union we only initialize one field *)
- match flds2 with
- [] -> []
- | (f :: rest) as toinit ->
- if comp.cstruct then toinit else [f]
-
-
-let integerArrayLength (leno: exp option) : int =
- match leno with
- None -> max_int
- | Some len -> begin
- try lenOfArray leno
- with LenOfArray ->
- E.s (error "Initializing non-constant-length array\n length=%a\n"
- d_exp len)
- end
-
-(* sm: I'm sure something like this already exists, but ... *)
-let isNone (o : 'a option) : bool =
- match o with
- | None -> true
- | Some _ -> false
-
-
-let annonCompFieldNameId = ref 0
-let annonCompFieldName = "__annonCompField"
-
-
-
-(* Utility ***)
-let rec replaceLastInList
- (lst: A.expression list)
- (how: A.expression -> A.expression) : A.expression list=
- match lst with
- [] -> []
- | [e] -> [how e]
- | h :: t -> h :: replaceLastInList t how
-
-
-
-
-
-let convBinOp (bop: A.binary_operator) : binop =
- match bop with
- A.ADD -> PlusA
- | A.SUB -> MinusA
- | A.MUL -> Mult
- | A.DIV -> Div
- | A.MOD -> Mod
- | A.BAND -> BAnd
- | A.BOR -> BOr
- | A.XOR -> BXor
- | A.SHL -> Shiftlt
- | A.SHR -> Shiftrt
- | A.EQ -> Eq
- | A.NE -> Ne
- | A.LT -> Lt
- | A.LE -> Le
- | A.GT -> Gt
- | A.GE -> Ge
- | _ -> E.s (error "convBinOp")
-
-(**** PEEP-HOLE optimizations ***)
-let afterConversion (c: chunk) : chunk =
- (* Now scan the statements and find Instr blocks *)
-
- (** We want to collapse sequences of the form "tmp = f(); v = tmp". This
- * will help significantly with the handling of calls to malloc, where it
- * is important to have the cast at the same place as the call *)
- let collapseCallCast = function
- Call(Some(Var vi, NoOffset), f, args, l),
- Set(destlv, CastE (newt, Lval(Var vi', NoOffset)), _)
- when (not vi.vglob &&
- String.length vi.vname >= 3 &&
- (* Watch out for the possibility that we have an implied cast in
- * the call *)
- (let tcallres =
- match unrollType (typeOf f) with
- TFun (rt, _, _, _) -> rt
- | _ -> E.s (E.bug "Function call to a non-function")
- in
- Util.equals (typeSig tcallres) (typeSig vi.vtype) &&
- Util.equals (typeSig newt) (typeSig (typeOfLval destlv))) &&
- IH.mem callTempVars vi.vid &&
- vi' == vi)
- -> Some [Call(Some destlv, f, args, l)]
- | i1,i2 -> None
- in
- (* First add in the postins *)
- let sl = pushPostIns c in
- peepHole2 collapseCallCast sl;
- { c with stmts = sl; postins = [] }
-
-(***** Try to suggest a name for the anonymous structures *)
-let suggestAnonName (nl: A.name list) =
- match nl with
- [] -> ""
- | (n, _, _, _) :: _ -> n
-
-
-(** Optional constant folding of binary operations *)
-let optConstFoldBinOp (machdep: bool) (bop: binop)
- (e1: exp) (e2:exp) (t: typ) =
- if !lowerConstants then
- constFoldBinOp machdep bop e1 e2 t
- else
- BinOp(bop, e1, e2, t)
-
-(****** TYPE SPECIFIERS *******)
-let rec doSpecList (suggestedAnonName: string) (* This string will be part of
- * the names for anonymous
- * structures and enums *)
- (specs: A.spec_elem list)
- (* Returns the base type, the storage, whether it is inline and the
- * (unprocessed) attributes *)
- : typ * storage * bool * A.attribute list =
- (* Do one element and collect the type specifiers *)
- let isinline = ref false in (* If inline appears *)
- (* The storage is placed here *)
- let storage : storage ref = ref NoStorage in
-
- (* Collect the attributes. Unfortunately, we cannot treat GCC
- * __attributes__ and ANSI C const/volatile the same way, since they
- * associate with structures differently. Specifically, ANSI
- * qualifiers never apply to structures (ISO 6.7.3), whereas GCC
- * attributes always do (GCC manual 4.30). Therefore, they are
- * collected and processed separately. *)
- let attrs : A.attribute list ref = ref [] in (* __attribute__, etc. *)
- let cvattrs : A.cvspec list ref = ref [] in (* const/volatile *)
-
- let doSpecElem (se: A.spec_elem)
- (acc: A.typeSpecifier list)
- : A.typeSpecifier list =
- match se with
- A.SpecTypedef -> acc
- | A.SpecInline -> isinline := true; acc
- | A.SpecStorage st ->
- if !storage <> NoStorage then
- E.s (error "Multiple storage specifiers");
- let sto' =
- match st with
- A.NO_STORAGE -> NoStorage
- | A.AUTO -> NoStorage
- | A.REGISTER -> Register
- | A.STATIC -> Static
- | A.EXTERN -> Extern
- in
- storage := sto';
- acc
-
- | A.SpecCV cv -> cvattrs := cv :: !cvattrs; acc
- | A.SpecAttr a -> attrs := a :: !attrs; acc
- | A.SpecType ts -> ts :: acc
- | A.SpecPattern _ -> E.s (E.bug "SpecPattern in cabs2cil input")
- in
- (* Now scan the list and collect the type specifiers. Preserve the order *)
- let tspecs = List.fold_right doSpecElem specs [] in
-
- let tspecs' =
- (* GCC allows a named type that appears first to be followed by things
- * like "short", "signed", "unsigned" or "long". *)
- match tspecs with
- A.Tnamed n :: (_ :: _ as rest) when not !msvcMode ->
- (* If rest contains "short" or "long" then drop the Tnamed *)
- if List.exists (function A.Tshort -> true
- | A.Tlong -> true | _ -> false) rest then
- rest
- else
- tspecs
-
- | _ -> tspecs
- in
- (* Sort the type specifiers *)
- let sortedspecs =
- let order = function (* Don't change this *)
- | A.Tvoid -> 0
- | A.Tsigned -> 1
- | A.Tunsigned -> 2
- | A.Tchar -> 3
- | A.Tshort -> 4
- | A.Tlong -> 5
- | A.Tint -> 6
- | A.Tint64 -> 7
- | A.Tfloat -> 8
- | A.Tdouble -> 9
- | _ -> 10 (* There should be at most one of the others *)
- in
- List.stable_sort (fun ts1 ts2 -> compare (order ts1) (order ts2)) tspecs'
- in
- let getTypeAttrs () : A.attribute list =
- (* Partitions the attributes in !attrs.
- Type attributes are removed from attrs and returned, so that they
- can go into the type definition. Name attributes are left in attrs,
- so they will be returned by doSpecAttr and used in the variable
- declaration.
- Testcase: small1/attr9.c *)
- let an, af, at = cabsPartitionAttributes ~default:AttrType !attrs in
- attrs := an; (* Save the name attributes for later *)
- if af <> [] then
- E.s (error "Invalid position for function type attributes.");
- at
- in
-
- (* And now try to make sense of it. See ISO 6.7.2 *)
- let bt =
- match sortedspecs with
- [A.Tvoid] -> TVoid []
- | [A.Tchar] -> TInt(IChar, [])
- | [A.Tsigned; A.Tchar] -> TInt(ISChar, [])
- | [A.Tunsigned; A.Tchar] -> TInt(IUChar, [])
-
- | [A.Tshort] -> TInt(IShort, [])
- | [A.Tsigned; A.Tshort] -> TInt(IShort, [])
- | [A.Tshort; A.Tint] -> TInt(IShort, [])
- | [A.Tsigned; A.Tshort; A.Tint] -> TInt(IShort, [])
-
- | [A.Tunsigned; A.Tshort] -> TInt(IUShort, [])
- | [A.Tunsigned; A.Tshort; A.Tint] -> TInt(IUShort, [])
-
- | [] -> TInt(IInt, [])
- | [A.Tint] -> TInt(IInt, [])
- | [A.Tsigned] -> TInt(IInt, [])
- | [A.Tsigned; A.Tint] -> TInt(IInt, [])
-
- | [A.Tunsigned] -> TInt(IUInt, [])
- | [A.Tunsigned; A.Tint] -> TInt(IUInt, [])
-
- | [A.Tlong] -> TInt(ILong, [])
- | [A.Tsigned; A.Tlong] -> TInt(ILong, [])
- | [A.Tlong; A.Tint] -> TInt(ILong, [])
- | [A.Tsigned; A.Tlong; A.Tint] -> TInt(ILong, [])
-
- | [A.Tunsigned; A.Tlong] -> TInt(IULong, [])
- | [A.Tunsigned; A.Tlong; A.Tint] -> TInt(IULong, [])
-
- | [A.Tlong; A.Tlong] -> TInt(ILongLong, [])
- | [A.Tsigned; A.Tlong; A.Tlong] -> TInt(ILongLong, [])
- | [A.Tlong; A.Tlong; A.Tint] -> TInt(ILongLong, [])
- | [A.Tsigned; A.Tlong; A.Tlong; A.Tint] -> TInt(ILongLong, [])
-
- | [A.Tunsigned; A.Tlong; A.Tlong] -> TInt(IULongLong, [])
- | [A.Tunsigned; A.Tlong; A.Tlong; A.Tint] -> TInt(IULongLong, [])
-
- (* int64 is to support MSVC *)
- | [A.Tint64] -> TInt(ILongLong, [])
- | [A.Tsigned; A.Tint64] -> TInt(ILongLong, [])
-
- | [A.Tunsigned; A.Tint64] -> TInt(IULongLong, [])
-
- | [A.Tfloat] -> TFloat(FFloat, [])
- | [A.Tdouble] -> TFloat(FDouble, [])
-
- | [A.Tlong; A.Tdouble] -> TFloat(FLongDouble, [])
-
- (* Now the other type specifiers *)
- | [A.Tnamed n] -> begin
- if n = "__builtin_va_list" &&
- Machdep.gccHas__builtin_va_list then begin
- TBuiltin_va_list []
- end else
- let t =
- match lookupType "type" n with
- (TNamed _) as x, _ -> x
- | typ -> E.s (error "Named type %s is not mapped correctly\n" n)
- in
- t
- end
-
- | [A.Tstruct (n, None, _)] -> (* A reference to a struct *)
- if n = "" then E.s (error "Missing struct tag on incomplete struct");
- findCompType "struct" n []
- | [A.Tstruct (n, Some nglist, extraAttrs)] -> (* A definition of a struct *)
- let n' =
- if n <> "" then n else anonStructName "struct" suggestedAnonName in
- (* Use the (non-cv, non-name) attributes in !attrs now *)
- let a = extraAttrs @ (getTypeAttrs ()) in
- makeCompType true n' nglist (doAttributes a)
-
- | [A.Tunion (n, None, _)] -> (* A reference to a union *)
- if n = "" then E.s (error "Missing union tag on incomplete union");
- findCompType "union" n []
- | [A.Tunion (n, Some nglist, extraAttrs)] -> (* A definition of a union *)
- let n' =
- if n <> "" then n else anonStructName "union" suggestedAnonName in
- (* Use the attributes now *)
- let a = extraAttrs @ (getTypeAttrs ()) in
- makeCompType false n' nglist (doAttributes a)
-
- | [A.Tenum (n, None, _)] -> (* Just a reference to an enum *)
- if n = "" then E.s (error "Missing enum tag on incomplete enum");
- findCompType "enum" n []
-
- | [A.Tenum (n, Some eil, extraAttrs)] -> (* A definition of an enum *)
- let n' =
- if n <> "" then n else anonStructName "enum" suggestedAnonName in
- (* make a new name for this enumeration *)
- let n'', _ = newAlphaName true "enum" n' in
-
- (* Create the enuminfo, or use one that was created already for a
- * forward reference *)
- let enum, _ = createEnumInfo n'' in
- let a = extraAttrs @ (getTypeAttrs ()) in
- enum.eattr <- doAttributes a;
- let res = TEnum (enum, []) in
-
- (* sm: start a scope for the enum tag values, since they *
- * can refer to earlier tags *)
- enterScope ();
-
- (* as each name,value pair is determined, this is called *)
- let rec processName kname (i: exp) loc rest = begin
- (* add the name to the environment, but with a faked 'typ' field;
- * we don't know the full type yet (since that includes all of the
- * tag values), but we won't need them in here *)
- addLocalToEnv kname (EnvEnum (i, res));
-
- (* add this tag to the list so that it ends up in the real
- * environment when we're finished *)
- let newname, _ = newAlphaName true "" kname in
-
- (kname, (newname, i, loc)) :: loop (increm i 1) rest
- end
-
- and loop i = function
- [] -> []
- | (kname, A.NOTHING, cloc) :: rest ->
- (* use the passed-in 'i' as the value, since none specified *)
- processName kname i (convLoc cloc) rest
-
- | (kname, e, cloc) :: rest ->
- (* constant-eval 'e' to determine tag value *)
- let e' = getIntConstExp e in
- let e' =
- match isInteger (constFold true e') with
- Some i -> if !lowerConstants then kinteger64 IInt i else e'
- | _ -> E.s (error "Constant initializer %a not an integer" d_exp e')
- in
- processName kname e' (convLoc cloc) rest
- in
-
- (* sm: now throw away the environment we built for eval'ing the enum
- * tags, so we can add to the new one properly *)
- exitScope ();
-
- let fields = loop zero eil in
- (* Now set the right set of items *)
- enum.eitems <- List.map (fun (_, x) -> x) fields;
- (* Record the enum name in the environment *)
- addLocalToEnv (kindPlusName "enum" n'') (EnvTyp res);
- (* And define the tag *)
- cabsPushGlobal (GEnumTag (enum, !currentLoc));
- res
-
-
- | [A.TtypeofE e] ->
- let (c, e', t) = doExp false e AExpLeaveArrayFun in
- let t' =
- match e' with
- StartOf(lv) -> typeOfLval lv
- (* If this is a string literal, then we treat it as in sizeof*)
- | Const (CStr s) -> begin
- match typeOf e' with
- TPtr(bt, _) -> (* This is the type of array elements *)
- TArray(bt, Some (SizeOfStr s), [])
- | _ -> E.s (bug "The typeOf a string is not a pointer type")
- end
- | _ -> t
- in
-(*
- ignore (E.log "typeof(%a) = %a\n" d_exp e' d_plaintype t');
-*)
- t'
-
- | [A.TtypeofT (specs, dt)] ->
- let typ = doOnlyType specs dt in
- typ
-
- | _ ->
- E.s (error "Invalid combination of type specifiers")
- in
- bt,!storage,!isinline,List.rev (!attrs @ (convertCVtoAttr !cvattrs))
-
-(* given some cv attributes, convert them into named attributes for
- * uniform processing *)
-and convertCVtoAttr (src: A.cvspec list) : A.attribute list =
- match src with
- | [] -> []
- | CV_CONST :: tl -> ("const",[]) :: (convertCVtoAttr tl)
- | CV_VOLATILE :: tl -> ("volatile",[]) :: (convertCVtoAttr tl)
- | CV_RESTRICT :: tl -> ("restrict",[]) :: (convertCVtoAttr tl)
-
-
-and makeVarInfoCabs
- ~(isformal: bool)
- ~(isglobal: bool)
- (ldecl : location)
- (bt, sto, inline, attrs)
- (n,ndt,a)
- : varinfo =
- let vtype, nattr =
- doType (AttrName false) bt (A.PARENTYPE(attrs, ndt, a)) in
- if inline && not (isFunctionType vtype) then
- ignore (error "inline for a non-function: %s" n);
- let t =
- if not isglobal && not isformal then begin
- (* Sometimes we call this on the formal argument of a function with no
- * arguments. Don't call stripConstLocalType in that case *)
-(* ignore (E.log "stripConstLocalType(%a) for %s\n" d_type vtype n); *)
- stripConstLocalType vtype
- end else
- vtype
- in
- let vi = makeVarinfo isglobal n t in
- vi.vstorage <- sto;
- vi.vattr <- nattr;
- vi.vdecl <- ldecl;
-
- if false then
- ignore (E.log "Created varinfo %s : %a\n" vi.vname d_type vi.vtype);
-
- vi
-
-(* Process a local variable declaration and allow variable-sized arrays *)
-and makeVarSizeVarInfo (ldecl : location)
- spec_res
- (n,ndt,a)
- : varinfo * chunk * exp * bool =
- if not !msvcMode then
- match isVariableSizedArray ndt with
- None ->
- makeVarInfoCabs ~isformal:false
- ~isglobal:false
- ldecl spec_res (n,ndt,a), empty, zero, false
- | Some (ndt', se, len) ->
- makeVarInfoCabs ~isformal:false
- ~isglobal:false
- ldecl spec_res (n,ndt',a), se, len, true
- else
- makeVarInfoCabs ~isformal:false
- ~isglobal:false
- ldecl spec_res (n,ndt,a), empty, zero, false
-
-and doAttr (a: A.attribute) : attribute list =
- (* Strip the leading and trailing underscore *)
- let stripUnderscore (n: string) : string =
- let l = String.length n in
- let rec start i =
- if i >= l then
- E.s (error "Invalid attribute name %s" n);
- if String.get n i = '_' then start (i + 1) else i
- in
- let st = start 0 in
- let rec finish i =
- (* We know that we will stop at >= st >= 0 *)
- if String.get n i = '_' then finish (i - 1) else i
- in
- let fin = finish (l - 1) in
- String.sub n st (fin - st + 1)
- in
- match a with
- | (s, []) -> [Attr (stripUnderscore s, [])]
- | (s, el) ->
-
- let rec attrOfExp (strip: bool)
- ?(foldenum=true)
- (a: A.expression) : attrparam =
- match a with
- A.VARIABLE n -> begin
- let n' = if strip then stripUnderscore n else n in
- (** See if this is an enumeration *)
- try
- if not foldenum then raise Not_found;
-
- match H.find env n' with
- EnvEnum (tag, _), _ -> begin
- match isInteger (constFold true tag) with
- Some i64 when !lowerConstants -> AInt (Int64.to_int i64)
- | _ -> ACons(n', [])
- end
- | _ -> ACons (n', [])
- with Not_found -> ACons(n', [])
- end
- | A.CONSTANT (A.CONST_STRING s) -> AStr s
- | A.CONSTANT (A.CONST_INT str) -> AInt (int_of_string str)
- | A.CALL(A.VARIABLE n, args) -> begin
- let n' = if strip then stripUnderscore n else n in
- let ae' = List.map ae args in
- ACons(n', ae')
- end
- | A.EXPR_SIZEOF e -> ASizeOfE (ae e)
- | A.TYPE_SIZEOF (bt, dt) -> ASizeOf (doOnlyType bt dt)
- | A.EXPR_ALIGNOF e -> AAlignOfE (ae e)
- | A.TYPE_ALIGNOF (bt, dt) -> AAlignOf (doOnlyType bt dt)
- | A.BINARY(A.AND, aa1, aa2) ->
- ABinOp(LAnd, ae aa1, ae aa2)
- | A.BINARY(A.OR, aa1, aa2) ->
- ABinOp(LOr, ae aa1, ae aa2)
- | A.BINARY(abop, aa1, aa2) ->
- ABinOp (convBinOp abop, ae aa1, ae aa2)
- | A.UNARY(A.PLUS, aa) -> ae aa
- | A.UNARY(A.MINUS, aa) -> AUnOp (Neg, ae aa)
- | A.UNARY(A.BNOT, aa) -> AUnOp(BNot, ae aa)
- | A.UNARY(A.NOT, aa) -> AUnOp(LNot, ae aa)
- | A.MEMBEROF (e, s) -> ADot (ae e, s)
- | _ ->
- ignore (E.log "Invalid expression in attribute: ");
- withCprint Cprint.print_expression a;
- E.s (error "cabs2cil: invalid expression")
-
- and ae (e: A.expression) = attrOfExp false e in
-
- (* Sometimes we need to convert attrarg into attr *)
- let arg2attr = function
- | ACons (s, args) -> Attr (s, args)
- | a ->
- E.s (error "Invalid form of attribute: %a"
- d_attrparam a);
- in
- if s = "__attribute__" then (* Just a wrapper for many attributes*)
- List.map (fun e -> arg2attr (attrOfExp true ~foldenum:false e)) el
- else if s = "__blockattribute__" then (* Another wrapper *)
- List.map (fun e -> arg2attr (attrOfExp true ~foldenum:false e)) el
- else if s = "__declspec" then
- List.map (fun e -> arg2attr (attrOfExp false ~foldenum:false e)) el
- else
- [Attr(stripUnderscore s, List.map (attrOfExp ~foldenum:false false) el)]
-
-and doAttributes (al: A.attribute list) : attribute list =
- List.fold_left (fun acc a -> cabsAddAttributes (doAttr a) acc) [] al
-
-(* A version of Cil.partitionAttributes that works on CABS attributes.
- It would be better to use Cil.partitionAttributes instead to avoid
- the extra doAttr conversions here, but that's hard to do in doSpecList.*)
-and cabsPartitionAttributes
- ~(default:attributeClass)
- (attrs: A.attribute list) :
- A.attribute list * A.attribute list * A.attribute list =
- let rec loop (n,f,t) = function
- [] -> n, f, t
- | a :: rest ->
- let kind = match doAttr a with
- [] -> default
- | Attr(an, _)::_ ->
- (try H.find attributeHash an with Not_found -> default)
- in
- match kind with
- AttrName _ -> loop (a::n, f, t) rest
- | AttrFunType _ ->
- loop (n, a::f, t) rest
- | AttrType -> loop (n, f, a::t) rest
- in
- loop ([], [], []) attrs
-
-
-
-and doType (nameortype: attributeClass) (* This is AttrName if we are doing
- * the type for a name, or AttrType
- * if we are doing this type in a
- * typedef *)
- (bt: typ) (* The base type *)
- (dt: A.decl_type)
- (* Returns the new type and the accumulated name (or type attribute
- if nameoftype = AttrType) attributes *)
- : typ * attribute list =
-
- (* Now do the declarator type. But remember that the structure of the
- * declarator type is as printed, meaning that it is the reverse of the
- * right one *)
- let rec doDeclType (bt: typ) (acc: attribute list) = function
- A.JUSTBASE -> bt, acc
- | A.PARENTYPE (a1, d, a2) ->
- let a1' = doAttributes a1 in
- let a1n, a1f, a1t = partitionAttributes AttrType a1' in
- let a2' = doAttributes a2 in
- let a2n, a2f, a2t = partitionAttributes nameortype a2' in
-(*
- ignore (E.log "doType: %a @[a1n=%a@!a1f=%a@!a1t=%a@!a2n=%a@!a2f=%a@!a2t=%a@]@!" d_loc !currentLoc d_attrlist a1n d_attrlist a1f d_attrlist a1t d_attrlist a2n d_attrlist a2f d_attrlist a2t);
-*)
- let bt' = cabsTypeAddAttributes a1t bt in
-(*
- ignore (E.log "bt' = %a\n" d_type bt');
-*)
- let bt'', a1fadded =
- match unrollType bt with
- TFun _ -> cabsTypeAddAttributes a1f bt', true
- | _ -> bt', false
- in
- (* Now recurse *)
- let restyp, nattr = doDeclType bt'' acc d in
- (* Add some more type attributes *)
- let restyp = cabsTypeAddAttributes a2t restyp in
- (* See if we can add some more type attributes *)
- let restyp' =
- match unrollType restyp with
- TFun _ ->
- if a1fadded then
- cabsTypeAddAttributes a2f restyp
- else
- cabsTypeAddAttributes a2f
- (cabsTypeAddAttributes a1f restyp)
- | TPtr ((TFun _ as tf), ap) when not !msvcMode ->
- if a1fadded then
- TPtr(cabsTypeAddAttributes a2f tf, ap)
- else
- TPtr(cabsTypeAddAttributes a2f
- (cabsTypeAddAttributes a1f tf), ap)
- | _ ->
- if a1f <> [] && not a1fadded then
- E.s (error "Invalid position for (prefix) function type attributes:%a"
- d_attrlist a1f);
- if a2f <> [] then
- E.s (error "Invalid position for (post) function type attributes:%a"
- d_attrlist a2f);
- restyp
- in
-(*
- ignore (E.log "restyp' = %a\n" d_type restyp');
-*)
- (* Now add the name attributes and return *)
- restyp', cabsAddAttributes a1n (cabsAddAttributes a2n nattr)
-
- | A.PTR (al, d) ->
- let al' = doAttributes al in
- let an, af, at = partitionAttributes AttrType al' in
- (* Now recurse *)
- let restyp, nattr = doDeclType (TPtr(bt, at)) acc d in
- (* See if we can do anything with function type attributes *)
- let restyp' =
- match unrollType restyp with
- TFun _ -> cabsTypeAddAttributes af restyp
- | TPtr((TFun _ as tf), ap) ->
- TPtr(cabsTypeAddAttributes af tf, ap)
- | _ ->
- if af <> [] then
- E.s (error "Invalid position for function type attributes:%a"
- d_attrlist af);
- restyp
- in
- (* Now add the name attributes and return *)
- restyp', cabsAddAttributes an nattr
-
-
- | A.ARRAY (d, al, len) ->
- let lo =
- match len with
- A.NOTHING -> None
- | _ ->
- let len' = doPureExp len in
- let _, len'' = castTo (typeOf len') intType len' in
- let elsz =
- try (bitsSizeOf bt + 7) / 8
- with _ -> 1 (** We get this if we cannot compute the size of
- * one element. This can happen, when we define
- * an extern, for example. We use 1 for now *)
- in
- (match constFold true len' with
- Const(CInt64(i, _, _)) ->
- if i < 0L then
- E.s (error "Length of array is negative\n");
- if Int64.mul i (Int64.of_int elsz) >= 0x80000000L then
- E.s (error "Length of array is too large\n")
-
-
- | l ->
- if isConstant l then
- (* e.g., there may be a float constant involved.
- * We'll leave it to the user to ensure the length is
- * non-negative, etc.*)
- ignore(warn "Unable to do constant-folding on array length %a. Some CIL operations on this array may fail."
- d_exp l)
- else
- E.s (error "Length of array is not a constant: %a\n"
- d_exp l));
- Some len''
- in
- let al' = doAttributes al in
- doDeclType (TArray(bt, lo, al')) acc d
-
- | A.PROTO (d, args, isva) ->
- (* Start a scope for the parameter names *)
- enterScope ();
- (* Intercept the old-style use of varargs.h. On GCC this means that
- * we have ellipsis and a last argument "builtin_va_alist:
- * builtin_va_alist_t". On MSVC we do not have the ellipsis and we
- * have a last argument "va_alist: va_list" *)
- let args', isva' =
- if args != [] && !msvcMode = not isva then begin
- let newisva = ref isva in
- let rec doLast = function
- [([A.SpecType (A.Tnamed atn)], (an, A.JUSTBASE, [], _))]
- when isOldStyleVarArgTypeName atn &&
- isOldStyleVarArgName an -> begin
- (* Turn it into a vararg *)
- newisva := true;
- (* And forget about this argument *)
- []
- end
-
- | a :: rest -> a :: doLast rest
- | [] -> []
- in
- let args' = doLast args in
- (args', !newisva)
- end else (args, isva)
- in
- (* Make the argument as for a formal *)
- let doOneArg (s, (n, ndt, a, cloc)) : varinfo =
- let s' = doSpecList n s in
- let ndt' = match isVariableSizedArray ndt with
- None -> ndt
- | Some (ndt', se, len) ->
- (* If this is a variable-sized array, we replace the array
- type with a pointer type. This is the defined behavior
- for array parameters, so we do not need to add this to
- varSizeArrays, fix sizeofs, etc. *)
- if isNotEmpty se then
- E.s (error "array parameter: length not pure");
- ndt'
- in
- let vi = makeVarInfoCabs ~isformal:true ~isglobal:false
- (convLoc cloc) s' (n,ndt',a) in
- (* Add the formal to the environment, so it can be referenced by
- other formals (e.g. in an array type, although that will be
- changed to a pointer later, or though typeof). *)
- addLocalToEnv vi.vname (EnvVar vi);
- vi
- in
- let targs : varinfo list option =
- match List.map doOneArg args' with
- | [] -> None (* No argument list *)
- | [t] when isVoidType t.vtype ->
- Some []
- | l -> Some l
- in
- exitScope ();
- (* Turn [] types into pointers in the arguments and the result type.
- * Turn function types into pointers to respective. This simplifies
- * our life a lot, and is what the standard requires. *)
- let rec fixupArgumentTypes (argidx: int) (args: varinfo list) : unit =
- match args with
- [] -> ()
- | a :: args' ->
- (match unrollType a.vtype with
- TArray(t,_,attr) -> a.vtype <- TPtr(t, attr)
- | TFun _ -> a.vtype <- TPtr(a.vtype, [])
- | TComp (comp, _) -> begin
- match isTransparentUnion a.vtype with
- None -> ()
- | Some fstfield ->
- transparentUnionArgs :=
- (argidx, a.vtype) :: !transparentUnionArgs;
- a.vtype <- fstfield.ftype;
- end
- | _ -> ());
- fixupArgumentTypes (argidx + 1) args'
- in
- let args =
- match targs with
- None -> None
- | Some argl ->
- fixupArgumentTypes 0 argl;
- Some (List.map (fun a -> (a.vname, a.vtype, a.vattr)) argl)
- in
- let tres =
- match unrollType bt with
- TArray(t,_,attr) -> TPtr(t, attr)
- | _ -> bt
- in
- doDeclType (TFun (tres, args, isva', [])) acc d
-
- in
- doDeclType bt [] dt
-
-(* If this is a declarator for a variable size array then turn it into a
- pointer type and a length *)
-and isVariableSizedArray (dt: A.decl_type)
- : (A.decl_type * chunk * exp) option =
- let res = ref None in
- let rec findArray = function
- ARRAY (JUSTBASE, al, lo) when lo != A.NOTHING ->
- (* Try to compile the expression to a constant *)
- let (se, e', _) = doExp true lo (AExp (Some intType)) in
- if isNotEmpty se || not (isConstant e') then begin
- res := Some (se, e');
- PTR (al, JUSTBASE)
- end else
- ARRAY (JUSTBASE, al, lo)
- | ARRAY (dt, al, lo) -> ARRAY (findArray dt, al, lo)
- | PTR (al, dt) -> PTR (al, findArray dt)
- | JUSTBASE -> JUSTBASE
- | PARENTYPE (prea, dt, posta) -> PARENTYPE (prea, findArray dt, posta)
- | PROTO (dt, f, a) -> PROTO (findArray dt, f, a)
- in
- let dt' = findArray dt in
- match !res with
- None -> None
- | Some (se, e) -> Some (dt', se, e)
-
-and doOnlyType (specs: A.spec_elem list) (dt: A.decl_type) : typ =
- let bt',sto,inl,attrs = doSpecList "" specs in
- if sto <> NoStorage || inl then
- E.s (error "Storage or inline specifier in type only");
- let tres, nattr = doType AttrType bt' (A.PARENTYPE(attrs, dt, [])) in
- if nattr <> [] then
- E.s (error "Name attributes in only_type: %a"
- d_attrlist nattr);
- tres
-
-
-and makeCompType (isstruct: bool)
- (n: string)
- (nglist: A.field_group list)
- (a: attribute list) =
- (* Make a new name for the structure *)
- let kind = if isstruct then "struct" else "union" in
- let n', _ = newAlphaName true kind n in
- (* Create the self cell for use in fields and forward references. Or maybe
- * one exists already from a forward reference *)
- let comp, _ = createCompInfo isstruct n' in
- let doFieldGroup ((s: A.spec_elem list),
- (nl: (A.name * A.expression option) list)) : 'a list =
- (* Do the specifiers exactly once *)
- let sugg = match nl with
- [] -> ""
- | ((n, _, _, _), _) :: _ -> n
- in
- let bt, sto, inl, attrs = doSpecList sugg s in
- (* Do the fields *)
- let makeFieldInfo
- (((n,ndt,a,cloc) : A.name), (widtho : A.expression option))
- : fieldinfo =
- if sto <> NoStorage || inl then
- E.s (error "Storage or inline not allowed for fields");
- let ftype, nattr =
- doType (AttrName false) bt (A.PARENTYPE(attrs, ndt, a)) in
- (* check for fields whose type is an undefined struct. This rules
- out circularity:
- struct C1 { struct C2 c2; }; //This line is now an error.
- struct C2 { struct C1 c1; int dummy; };
- *)
- (match unrollType ftype with
- TComp (ci',_) when not ci'.cdefined ->
- E.s (error "Type of field %s is an undefined struct.\n" n)
- | _ -> ());
- let width =
- match widtho with
- None -> None
- | Some w -> begin
- (match unrollType ftype with
- TInt (ikind, a) -> ()
- | TEnum _ -> ()
- | _ -> E.s (error "Base type for bitfield is not an integer type"));
- match isIntegerConstant w with
- Some n -> Some n
- | None -> E.s (error "bitfield width is not an integer constant")
- end
- in
- (* If the field is unnamed and its type is a structure of union type
- * then give it a distinguished name *)
- let n' =
- if n = missingFieldName then begin
- match unrollType ftype with
- TComp _ -> begin
- incr annonCompFieldNameId;
- annonCompFieldName ^ (string_of_int !annonCompFieldNameId)
- end
- | _ -> n
- end else
- n
- in
- { fcomp = comp;
- fname = n';
- ftype = ftype;
- fbitfield = width;
- fattr = nattr;
- floc = convLoc cloc
- }
- in
- List.map makeFieldInfo nl
- in
-
-
- let flds = List.concat (List.map doFieldGroup nglist) in
- if comp.cfields <> [] then begin
- (* This appears to be a multiply defined structure. This can happen from
- * a construct like "typedef struct foo { ... } A, B;". This is dangerous
- * because at the time B is processed some forward references in { ... }
- * appear as backward references, which coild lead to circularity in
- * the type structure. We do a thourough check and then we reuse the type
- * for A *)
- let fieldsSig fs = List.map (fun f -> typeSig f.ftype) fs in
- if not (Util.equals (fieldsSig comp.cfields) (fieldsSig flds)) then
- ignore (error "%s seems to be multiply defined" (compFullName comp))
- end else
- comp.cfields <- flds;
-
-(* ignore (E.log "makeComp: %s: %a\n" comp.cname d_attrlist a); *)
- comp.cattr <- a;
- let res = TComp (comp, []) in
- (* This compinfo is defined, even if there are no fields *)
- comp.cdefined <- true;
- (* Create a typedef for this one *)
- cabsPushGlobal (GCompTag (comp, !currentLoc));
-
- (* There must be a self cell created for this already *)
- addLocalToEnv (kindPlusName kind n) (EnvTyp res);
- (* Now create a typedef with just this type *)
- res
-
-and preprocessCast (specs: A.specifier)
- (dt: A.decl_type)
- (ie: A.init_expression)
- : A.specifier * A.decl_type * A.init_expression =
- let typ = doOnlyType specs dt in
- (* If we are casting to a union type then we have to treat this as a
- * constructor expression. This is to handle the gcc extension that allows
- * cast from a type of a field to the type of the union *)
- let ie' =
- match unrollType typ, ie with
- TComp (c, _), A.SINGLE_INIT _ when not c.cstruct ->
- A.COMPOUND_INIT [(A.INFIELD_INIT ("___matching_field",
- A.NEXT_INIT),
- ie)]
- | _, _ -> ie
- in
- (* Maybe specs contains an unnamed composite. Replace with the name so that
- * when we do again the specs we get the right name *)
- let specs1 =
- match typ with
- TComp (ci, _) ->
- List.map
- (function
- A.SpecType (A.Tstruct ("", flds, [])) ->
- A.SpecType (A.Tstruct (ci.cname, None, []))
- | A.SpecType (A.Tunion ("", flds, [])) ->
- A.SpecType (A.Tunion (ci.cname, None, []))
- | s -> s) specs
- | _ -> specs
- in
- specs1, dt, ie'
-
-and getIntConstExp (aexp) : exp =
- let c, e, _ = doExp true aexp (AExp None) in
- if not (isEmpty c) then
- E.s (error "Constant expression %a has effects" d_exp e);
- match e with
- (* first, filter for those Const exps that are integers *)
- | Const (CInt64 _ ) -> e
- | Const (CEnum _) -> e
- | Const (CChr i) -> Const(charConstToInt i)
-
- (* other Const expressions are not ok *)
- | Const _ -> E.s (error "Expected integer constant and got %a" d_exp e)
-
- (* now, anything else that 'doExp true' returned is ok (provided
- that it didn't yield side effects); this includes, in particular,
- the various sizeof and alignof expression kinds *)
- | _ -> e
-
-(* this is like 'isIntConstExp', but retrieves the actual integer
- * the expression denotes; I have not extended it to work with
- * sizeof/alignof since (for CCured) we can't const-eval those,
- * and it's not clear whether they can be bitfield width specifiers
- * anyway (since that's where this function is used) *)
-and isIntegerConstant (aexp) : int option =
- match doExp true aexp (AExp None) with
- (c, e, _) when isEmpty c -> begin
- match isInteger e with
- Some i64 -> Some (Int64.to_int i64)
- | _ -> None
- end
- | _ -> None
-
- (* Process an expression and in the process do some type checking,
- * extract the effects as separate statements *)
-and doExp (asconst: bool) (* This expression is used as a constant *)
- (e: A.expression)
- (what: expAction) : (chunk * exp * typ) =
- (* A subexpression of array type is automatically turned into StartOf(e).
- * Similarly an expression of function type is turned into AddrOf. So
- * essentially doExp should never return things of type TFun or TArray *)
- let processArrayFun e t =
- match e, unrollType t with
- (Lval(lv) | CastE(_, Lval lv)), TArray(tbase, _, a) ->
- mkStartOfAndMark lv, TPtr(tbase, a)
- | (Lval(lv) | CastE(_, Lval lv)), TFun _ ->
- mkAddrOfAndMark lv, TPtr(t, [])
- | _, (TArray _ | TFun _) ->
- E.s (error "Array or function expression is not lval: %a@!"
- d_plainexp e)
- | _ -> e, t
- in
- (* Before we return we call finishExp *)
- let finishExp ?(newWhat=what)
- (se: chunk) (e: exp) (t: typ) : chunk * exp * typ =
- match newWhat with
- ADrop -> (se, e, t)
- | AExpLeaveArrayFun ->
- (se, e, t) (* It is important that we do not do "processArrayFun" in
- * this case. We exploit this when we process the typeOf
- * construct *)
- | AExp _ ->
- let (e', t') = processArrayFun e t in
-(*
- ignore (E.log "finishExp: e'=%a, t'=%a\n"
- d_exp e' d_type t');
-*)
- (se, e', t')
-
- | ASet (lv, lvt) -> begin
- (* See if the set was done already *)
- match e with
- Lval(lv') when lv == lv' ->
- (se, e, t)
- | _ ->
- let (e', t') = processArrayFun e t in
- let (t'', e'') = castTo t' lvt e' in
-(*
- ignore (E.log "finishExp: e = %a\n e'' = %a\n" d_plainexp e d_plainexp e'');
-*)
- (se +++ (Set(lv, e'', !currentLoc)), e'', t'')
- end
- in
- let rec findField (n: string) (fidlist: fieldinfo list) : offset =
- (* Depth first search for the field. This appears to be what GCC does.
- * MSVC checks that there are no ambiguous field names, so it does not
- * matter how we search *)
- let rec search = function
- [] -> NoOffset (* Did not find *)
- | fid :: rest when fid.fname = n -> Field(fid, NoOffset)
- | fid :: rest when prefix annonCompFieldName fid.fname -> begin
- match unrollType fid.ftype with
- TComp (ci, _) ->
- let off = search ci.cfields in
- if off = NoOffset then
- search rest (* Continue searching *)
- else
- Field (fid, off)
- | _ -> E.s (bug "unnamed field type is not a struct/union")
- end
- | _ :: rest -> search rest
- in
- let off = search fidlist in
- if off = NoOffset then
- E.s (error "Cannot find field %s" n);
- off
- in
- try
- match e with
- | A.NOTHING when what = ADrop -> finishExp empty (integer 0) intType
- | A.NOTHING ->
- let res = Const(CStr "exp_nothing") in
- finishExp empty res (typeOf res)
-
- (* Do the potential lvalues first *)
- | A.VARIABLE n -> begin
- (* Look up in the environment *)
- try
- let envdata = H.find env n in
- match envdata with
- EnvVar vi, _ ->
- (* if isconst &&
- not (isFunctionType vi.vtype) &&
- not (isArrayType vi.vtype)then
- E.s (error "variable appears in constant"); *)
- finishExp empty (Lval(var vi)) vi.vtype
- | EnvEnum (tag, typ), _ ->
- if !Cil.lowerConstants then
- finishExp empty tag typ
- else begin
- let ei =
- match unrollType typ with
- TEnum(ei, _) -> ei
- | _ -> assert false
- in
- finishExp empty (Const (CEnum(tag, n, ei))) typ
- end
-
- | _ -> raise Not_found
- with Not_found -> begin
- if isOldStyleVarArgName n then
- E.s (error "Cannot resolve variable %s. This could be a CIL bug due to the handling of old-style variable argument functions.\n" n)
- else
- E.s (error "Cannot resolve variable %s.\n" n)
- end
- end
- | A.INDEX (e1, e2) -> begin
- (* Recall that doExp turns arrays into StartOf pointers *)
- let (se1, e1', t1) = doExp false e1 (AExp None) in
- let (se2, e2', t2) = doExp false e2 (AExp None) in
- let se = se1 @@ se2 in
- let (e1'', t1, e2'', tresult) =
- (* Either e1 or e2 can be the pointer *)
- match unrollType t1, unrollType t2 with
- TPtr(t1e,_), (TInt _|TEnum _) -> e1', t1, e2', t1e
- | (TInt _|TEnum _), TPtr(t2e,_) -> e2', t2, e1', t2e
- | _ ->
- E.s (error
- "Expecting a pointer type in index:@! t1=%a@!t2=%a@!"
- d_plaintype t1 d_plaintype t2)
- in
- (* We have to distinguish the construction based on the type of e1'' *)
- let res =
- match e1'' with
- StartOf array -> (* A real array indexing operation *)
- addOffsetLval (Index(e2'', NoOffset)) array
- | _ -> (* Turn into *(e1 + e2) *)
- mkMem (BinOp(IndexPI, e1'', e2'', t1)) NoOffset
- in
- (* Do some optimization of StartOf *)
- finishExp se (Lval res) tresult
-
- end
- | A.UNARY (A.MEMOF, e) ->
- if asconst then
- ignore (warn "MEMOF in constant");
- let (se, e', t) = doExp false e (AExp None) in
- let tresult =
- match unrollType t with
- | TPtr(te, _) -> te
- | _ -> E.s (error "Expecting a pointer type in *. Got %a@!"
- d_plaintype t)
- in
- finishExp se
- (Lval (mkMem e' NoOffset))
- tresult
-
- (* e.str = (& e + off(str)). If e = (be + beoff) then e.str = (be
- * + beoff + off(str)) *)
- | A.MEMBEROF (e, str) ->
- (* member of is actually allowed if we only take the address *)
- (* if isconst then
- E.s (error "MEMBEROF in constant"); *)
- let (se, e', t') = doExp false e (AExp None) in
- let lv =
- match e' with
- Lval x -> x
- | CastE(_, Lval x) -> x
- | _ -> E.s (error "Expected an lval in MEMBEROF (field %s)" str)
- in
- let field_offset =
- match unrollType t' with
- TComp (comp, _) -> findField str comp.cfields
- | _ -> E.s (error "expecting a struct with field %s" str)
- in
- let lv' = Lval(addOffsetLval field_offset lv) in
- let field_type = typeOf lv' in
- finishExp se lv' field_type
-
- (* e->str = * (e + off(str)) *)
- | A.MEMBEROFPTR (e, str) ->
- if asconst then
- ignore (warn "MEMBEROFPTR in constant");
- let (se, e', t') = doExp false e (AExp None) in
- let pointedt =
- match unrollType t' with
- TPtr(t1, _) -> t1
- | TArray(t1,_,_) -> t1
- | _ -> E.s (error "expecting a pointer to a struct")
- in
- let field_offset =
- match unrollType pointedt with
- TComp (comp, _) -> findField str comp.cfields
- | x ->
- E.s (error
- "expecting a struct with field %s. Found %a. t1 is %a"
- str d_type x d_type t')
- in
- let lv' = Lval (mkMem e' field_offset) in
- let field_type = typeOf lv' in
- finishExp se lv' field_type
-
- | A.CONSTANT ct -> begin
- let hasSuffix str =
- let l = String.length str in
- fun s ->
- let ls = String.length s in
- l >= ls && s = String.uppercase (String.sub str (l - ls) ls)
- in
- match ct with
- A.CONST_INT str -> begin
- let res = parseInt str in
- finishExp empty res (typeOf res)
- end
-
-(*
- | A.CONST_WSTRING wstr ->
- let len = List.length wstr in
- let wchar_t = !wcharType in
- (* We will make an array big enough to contain the wide
- * characters and the wide-null terminator *)
- let ws_t = TArray(wchar_t, Some (integer len), []) in
- let ws =
- makeGlobalVar ("wide_string" ^ string_of_int !lastStructId)
- ws_t
- in
- ws.vstorage <- Static;
- incr lastStructId;
- (* Make the initializer. Idx is a wide_char index. *)
- let rec loop (idx: int) (s: int64 list) =
- match s with
- [] -> []
- | wc::rest ->
- let wc_cilexp = Const (CInt64(wc, IInt, None)) in
- (Index(integer idx, NoOffset),
- SingleInit (mkCast wc_cilexp wchar_t))
- :: loop (idx + 1) rest
- in
- (* Add the definition for the array *)
- cabsPushGlobal (GVar(ws,
- {init = Some (CompoundInit(ws_t,
- loop 0 wstr))},
- !currentLoc));
- finishExp empty (StartOf(Var ws, NoOffset))
- (TPtr(wchar_t, []))
- *)
-
- | A.CONST_WSTRING (ws: int64 list) ->
- let res = Const(CWStr ((* intlist_to_wstring *) ws)) in
- finishExp empty res (typeOf res)
-
- | A.CONST_STRING s ->
- (* Maybe we burried __FUNCTION__ in there *)
- let s' =
- try
- let start = String.index s (Char.chr 0) in
- let l = String.length s in
- let tofind = (String.make 1 (Char.chr 0)) ^ "__FUNCTION__" in
- let past = start + String.length tofind in
- if past <= l &&
- String.sub s start (String.length tofind) = tofind then
- (if start > 0 then String.sub s 0 start else "") ^
- !currentFunctionFDEC.svar.vname ^
- (if past < l then String.sub s past (l - past) else "")
- else
- s
- with Not_found -> s
- in
- let res = Const(CStr s') in
- finishExp empty res (typeOf res)
-
- | A.CONST_CHAR char_list ->
- let a, b = (interpret_character_constant char_list) in
- finishExp empty (Const a) b
-
- | A.CONST_WCHAR char_list ->
- (* matth: I can't see a reason for a list of more than one char
- * here, since the kinteger64 below will take only the lower 16
- * bits of value. ('abc' makes sense, because CHAR constants have
- * type int, and so more than one char may be needed to represent
- * the value. But L'abc' has type wchar, and so is equivalent to
- * L'c'). But gcc allows L'abc', so I'll leave this here in case
- * I'm missing some architecture dependent behavior. *)
- let value = reduce_multichar !wcharType char_list in
- let result = kinteger64 !wcharKind value in
- finishExp empty result (typeOf result)
-
- | A.CONST_FLOAT str -> begin
- (* Maybe it ends in U or UL. Strip those *)
- let l = String.length str in
- let hasSuffix = hasSuffix str in
- let baseint, kind =
- if hasSuffix "L" then
- String.sub str 0 (l - 1), FLongDouble
- else if hasSuffix "F" then
- String.sub str 0 (l - 1), FFloat
- else if hasSuffix "D" then
- String.sub str 0 (l - 1), FDouble
- else
- str, FDouble
- in
- try
- finishExp empty
- (Const(CReal(float_of_string baseint, kind,
- Some str)))
- (TFloat(kind,[]))
- with e -> begin
- ignore (E.log "float_of_string %s (%s)\n" str
- (Printexc.to_string e));
- let res = Const(CStr "booo CONS_FLOAT") in
- finishExp empty res (typeOf res)
- end
- end
- end
-
- | A.TYPE_SIZEOF (bt, dt) ->
- let typ = doOnlyType bt dt in
- finishExp empty (SizeOf(typ)) !typeOfSizeOf
-
- (* Intercept the sizeof("string") *)
- | A.EXPR_SIZEOF (A.CONSTANT (A.CONST_STRING s)) -> begin
- (* Process the string first *)
- match doExp asconst (A.CONSTANT (A.CONST_STRING s)) (AExp None) with
- _, Const(CStr s), _ ->
- finishExp empty (SizeOfStr s) !typeOfSizeOf
- | _ -> E.s (bug "cabs2cil: sizeOfStr")
- end
-
- | A.EXPR_SIZEOF e ->
- (* Allow non-constants in sizeof *)
- (* Do not convert arrays and functions into pointers. *)
- let (se, e', t) = doExp false e AExpLeaveArrayFun in
-(*
- ignore (E.log "sizeof: %a e'=%a, t=%a\n"
- d_loc !currentLoc d_plainexp e' d_type t);
-*)
- (* !!!! The book says that the expression is not evaluated, so we
- * drop the potential side-effects
- if isNotEmpty se then
- ignore (warn "Warning: Dropping side-effect in EXPR_SIZEOF\n");
-*)
- let size =
- match e' with (* If we are taking the sizeof an
- * array we must drop the StartOf *)
- StartOf(lv) -> SizeOfE (Lval(lv))
-
- (* Maybe we are taking the sizeof for a CStr. In that case we
- * mean the pointer to the start of the string *)
- | Const(CStr _) -> SizeOf (charPtrType)
-
- (* Maybe we are taking the sizeof a variable-sized array *)
- | Lval (Var vi, NoOffset) -> begin
- try
- IH.find varSizeArrays vi.vid
- with Not_found -> SizeOfE e'
- end
- | _ -> SizeOfE e'
- in
- finishExp empty size !typeOfSizeOf
-
- | A.TYPE_ALIGNOF (bt, dt) ->
- let typ = doOnlyType bt dt in
- finishExp empty (AlignOf(typ)) !typeOfSizeOf
-
- | A.EXPR_ALIGNOF e ->
- let (se, e', t) = doExp false e AExpLeaveArrayFun in
- (* !!!! The book says that the expression is not evaluated, so we
- * drop the potential side-effects
- if isNotEmpty se then
- ignore (warn "Warning: Dropping side-effect in EXPR_ALIGNOF\n");
-*)
- let e'' =
- match e' with (* If we are taking the alignof an
- * array we must drop the StartOf *)
- StartOf(lv) -> Lval(lv)
-
- | _ -> e'
- in
- finishExp empty (AlignOfE(e'')) !typeOfSizeOf
-
- | A.CAST ((specs, dt), ie) ->
- let s', dt', ie' = preprocessCast specs dt ie in
- (* We know now that we can do s' and dt' many times *)
- let typ = doOnlyType s' dt' in
- let what' =
- match what with
- AExp (Some _) -> AExp (Some typ)
- | AExp None -> what
- | ADrop | AExpLeaveArrayFun -> what
- | ASet (lv, lvt) ->
- (* If the cast from typ to lvt would be dropped, then we
- * continue with a Set *)
- if false && Util.equals (typeSig typ) (typeSig lvt) then
- what
- else
- AExp None (* We'll create a temporary *)
- in
- (* Remember here if we have done the Set *)
- let (se, e', t'), (needcast: bool) =
- match ie' with
- A.SINGLE_INIT e -> doExp asconst e what', true
-
- | A.NO_INIT -> E.s (error "missing expression in cast")
-
- | A.COMPOUND_INIT _ -> begin
- (* Pretend that we are declaring and initializing a brand new
- * variable *)
- let newvar = "__constr_expr_" ^ string_of_int (!constrExprId) in
- incr constrExprId;
- let spec_res = doSpecList "" s' in
- let se1 =
- if !scopes == [] then begin
- ignore (createGlobal spec_res
- ((newvar, dt', [], cabslu), ie'));
- empty
- end else
- createLocal spec_res ((newvar, dt', [], cabslu), ie')
- in
- (* Now pretend that e is just a reference to the newly created
- * variable *)
- let se, e', t' = doExp asconst (A.VARIABLE newvar) what' in
- (* If typ is an array then the doExp above has already added a
- * StartOf. We must undo that now so that it is done once by
- * the finishExp at the end of this case *)
- let e2, t2 =
- match unrollType typ, e' with
- TArray _, StartOf lv -> Lval lv, typ
- | _, _ -> e', t'
- in
- (* If we are here, then the type t2 is guaranteed to match the
- * type of the expression e2, so we do not need a cast. We have
- * to worry about this because otherwise, we might need to cast
- * between arrays or structures. *)
- (se1 @@ se, e2, t2), false
- end
- in
- let (t'', e'') =
- match typ with
- TVoid _ when what' = ADrop -> (t', e') (* strange GNU thing *)
- | _ ->
- (* Do this to check the cast, unless we are sure that we do not
- * need the check. *)
- let newtyp, newexp =
- if needcast then
- castTo ~fromsource:true t' typ e'
- else
- t', e'
- in
- newtyp, newexp
- in
- finishExp se e'' t''
-
- | A.UNARY(A.MINUS, e) ->
- let (se, e', t) = doExp asconst e (AExp None) in
- if isIntegralType t then
- let tres = integralPromotion t in
- let e'' =
- match e' with
- | Const(CInt64(i, ik, _)) -> kinteger64 ik (Int64.neg i)
- | _ -> UnOp(Neg, mkCastT e' t tres, tres)
- in
- finishExp se e'' tres
- else
- if isArithmeticType t then
- finishExp se (UnOp(Neg,e',t)) t
- else
- E.s (error "Unary - on a non-arithmetic type")
-
- | A.UNARY(A.BNOT, e) ->
- let (se, e', t) = doExp asconst e (AExp None) in
- if isIntegralType t then
- let tres = integralPromotion t in
- let e'' = UnOp(BNot, mkCastT e' t tres, tres) in
- finishExp se e'' tres
- else
- E.s (error "Unary ~ on a non-integral type")
-
- | A.UNARY(A.PLUS, e) -> doExp asconst e what
-
-
- | A.UNARY(A.ADDROF, e) -> begin
- match e with
- A.COMMA el -> (* GCC extension *)
- doExp false
- (A.COMMA (replaceLastInList el (fun e -> A.UNARY(A.ADDROF, e))))
- what
- | A.QUESTION (e1, e2, e3) -> (* GCC extension *)
- doExp false
- (A.QUESTION (e1, A.UNARY(A.ADDROF, e2), A.UNARY(A.ADDROF, e3)))
- what
- | A.VARIABLE s when
- isOldStyleVarArgName s
- && (match !currentFunctionFDEC.svar.vtype with
- TFun(_, _, true, _) -> true | _ -> false) ->
- (* We are in an old-style variable argument function and we are
- * taking the address of the argument that was removed while
- * processing the function type. We compute the address based on
- * the address of the last real argument *)
- if !msvcMode then begin
- let rec getLast = function
- [] -> E.s (unimp "old-style variable argument function without real arguments")
- | [a] -> a
- | _ :: rest -> getLast rest
- in
- let last = getLast !currentFunctionFDEC.sformals in
- let res = mkAddrOfAndMark (var last) in
- let tres = typeOf res in
- let tres', res' = castTo tres (TInt(IULong, [])) res in
- (* Now we must add to this address to point to the next
- * argument. Round up to a multiple of 4 *)
- let sizeOfLast =
- (((bitsSizeOf last.vtype) + 31) / 32) * 4
- in
- let res'' =
- BinOp(PlusA, res', kinteger IULong sizeOfLast, tres')
- in
- finishExp empty res'' tres'
- end else begin (* On GCC the only reliable way to do this is to
- * call builtin_next_arg. If we take the address of
- * a local we are going to get the address of a copy
- * of the local ! *)
-
- doExp asconst
- (A.CALL (A.VARIABLE "__builtin_next_arg",
- [A.CONSTANT (A.CONST_INT "0")]))
- what
- end
-
- | (A.VARIABLE _ | A.UNARY (A.MEMOF, _) | (* Regular lvalues *)
- A.INDEX _ | A.MEMBEROF _ | A.MEMBEROFPTR _ |
- A.CAST (_, A.COMPOUND_INIT _)) -> begin
- let (se, e', t) = doExp false e (AExp None) in
- (* ignore (E.log "ADDROF on %a : %a\n" d_plainexp e'
- d_plaintype t); *)
- match e' with
- ( Lval x | CastE(_, Lval x)) ->
- finishExp se (mkAddrOfAndMark x) (TPtr(t, []))
-
- | StartOf (lv) ->
- let tres = TPtr(typeOfLval lv, []) in (* pointer to array *)
- finishExp se (mkAddrOfAndMark lv) tres
-
- (* Function names are converted into pointers to the function.
- * Taking the address-of again does not change things *)
- | AddrOf (Var v, NoOffset) when isFunctionType v.vtype ->
- finishExp se e' t
-
- | _ -> E.s (error "Expected lval for ADDROF. Got %a@!"
- d_plainexp e')
- end
- | _ -> E.s (error "Unexpected operand for addrof")
- end
- | A.UNARY((A.PREINCR|A.PREDECR) as uop, e) -> begin
- match e with
- A.COMMA el -> (* GCC extension *)
- doExp asconst
- (A.COMMA (replaceLastInList el
- (fun e -> A.UNARY(uop, e))))
- what
- | A.QUESTION (e1, e2q, e3q) -> (* GCC extension *)
- doExp asconst
- (A.QUESTION (e1, A.UNARY(uop, e2q),
- A.UNARY(uop, e3q)))
- what
-
- | (A.VARIABLE _ | A.UNARY (A.MEMOF, _) | (* Regular lvalues *)
- A.INDEX _ | A.MEMBEROF _ | A.MEMBEROFPTR _ |
- A.CAST _ (* A GCC extension *)) -> begin
- let uop' = if uop = A.PREINCR then PlusA else MinusA in
- if asconst then
- ignore (warn "PREINCR or PREDECR in constant");
- let (se, e', t) = doExp false e (AExp None) in
- let lv =
- match e' with
- Lval x -> x
- | CastE (_, Lval x) -> x (* A GCC extension. The operation is
- * done at the cast type. The result
- * is also of the cast type *)
- | _ -> E.s (error "Expected lval for ++ or --")
- in
- let tresult, result = doBinOp uop' e' t one intType in
- finishExp (se +++ (Set(lv, mkCastT result tresult t,
- !currentLoc)))
- e'
- tresult (* Should this be t instead ??? *)
- end
- | _ -> E.s (error "Unexpected operand for prefix -- or ++")
- end
-
- | A.UNARY((A.POSINCR|A.POSDECR) as uop, e) -> begin
- match e with
- A.COMMA el -> (* GCC extension *)
- doExp asconst
- (A.COMMA (replaceLastInList el
- (fun e -> A.UNARY(uop, e))))
- what
- | A.QUESTION (e1, e2q, e3q) -> (* GCC extension *)
- doExp asconst
- (A.QUESTION (e1, A.UNARY(uop, e2q), A.UNARY(uop, e3q)))
- what
-
- | (A.VARIABLE _ | A.UNARY (A.MEMOF, _) | (* Regular lvalues *)
- A.INDEX _ | A.MEMBEROF _ | A.MEMBEROFPTR _ |
- A.CAST _ (* A GCC extension *) ) -> begin
- if asconst then
- ignore (warn "POSTINCR or POSTDECR in constant");
- (* If we do not drop the result then we must save the value *)
- let uop' = if uop = A.POSINCR then PlusA else MinusA in
- let (se, e', t) = doExp false e (AExp None) in
- let lv =
- match e' with
- Lval x -> x
- | CastE (_, Lval x) -> x (* GCC extension. The addition must
- * be be done at the cast type. The
- * result of this is also of the cast
- * type *)
- | _ -> E.s (error "Expected lval for ++ or --")
- in
- let tresult, opresult = doBinOp uop' e' t one intType in
- let se', result =
- if what <> ADrop then
- let tmp = newTempVar t in
- se +++ (Set(var tmp, e', !currentLoc)), Lval(var tmp)
- else
- se, e'
- in
- finishExp
- (se' +++ (Set(lv, mkCastT opresult tresult t,
- !currentLoc)))
- result
- tresult (* Should this be t instead ??? *)
- end
- | _ -> E.s (error "Unexpected operand for suffix ++ or --")
- end
-
- | A.BINARY(A.ASSIGN, e1, e2) -> begin
- match e1 with
- A.COMMA el -> (* GCC extension *)
- doExp asconst
- (A.COMMA (replaceLastInList el
- (fun e -> A.BINARY(A.ASSIGN, e, e2))))
- what
- | A.QUESTION (e1, e2q, e3q) -> (* GCC extension *)
- doExp asconst
- (A.QUESTION (e1, A.BINARY(A.ASSIGN, e2q, e2),
- A.BINARY(A.ASSIGN, e3q, e2)))
- what
- | A.CAST (t, A.SINGLE_INIT e) -> (* GCC extension *)
- doExp asconst
- (A.CAST (t,
- A.SINGLE_INIT (A.BINARY(A.ASSIGN, e,
- A.CAST (t, A.SINGLE_INIT e2)))))
- what
-
- | (A.VARIABLE _ | A.UNARY (A.MEMOF, _) | (* Regular lvalues *)
- A.INDEX _ | A.MEMBEROF _ | A.MEMBEROFPTR _ ) -> begin
- if asconst then ignore (warn "ASSIGN in constant");
- let (se1, e1', lvt) = doExp false e1 (AExp None) in
- let lv =
- match e1' with
- Lval x -> x
- | _ -> E.s (error "Expected lval for assignment. Got %a\n"
- d_plainexp e1')
- in
- let (se2, e'', t'') = doExp false e2 (ASet(lv, lvt)) in
- finishExp (se1 @@ se2) e1' lvt
- end
- | _ -> E.s (error "Invalid left operand for ASSIGN")
- end
-
- | A.BINARY((A.ADD|A.SUB|A.MUL|A.DIV|A.MOD|A.BAND|A.BOR|A.XOR|
- A.SHL|A.SHR|A.EQ|A.NE|A.LT|A.GT|A.GE|A.LE) as bop, e1, e2) ->
- let bop' = convBinOp bop in
- let (se1, e1', t1) = doExp asconst e1 (AExp None) in
- let (se2, e2', t2) = doExp asconst e2 (AExp None) in
- let tresult, result = doBinOp bop' e1' t1 e2' t2 in
- finishExp (se1 @@ se2) result tresult
-
- (* assignment operators *)
- | A.BINARY((A.ADD_ASSIGN|A.SUB_ASSIGN|A.MUL_ASSIGN|A.DIV_ASSIGN|
- A.MOD_ASSIGN|A.BAND_ASSIGN|A.BOR_ASSIGN|A.SHL_ASSIGN|
- A.SHR_ASSIGN|A.XOR_ASSIGN) as bop, e1, e2) -> begin
- match e1 with
- A.COMMA el -> (* GCC extension *)
- doExp asconst
- (A.COMMA (replaceLastInList el
- (fun e -> A.BINARY(bop, e, e2))))
- what
- | A.QUESTION (e1, e2q, e3q) -> (* GCC extension *)
- doExp asconst
- (A.QUESTION (e1, A.BINARY(bop, e2q, e2),
- A.BINARY(bop, e3q, e2)))
- what
-
- | (A.VARIABLE _ | A.UNARY (A.MEMOF, _) | (* Regular lvalues *)
- A.INDEX _ | A.MEMBEROF _ | A.MEMBEROFPTR _ |
- A.CAST _ (* GCC extension *) ) -> begin
- if asconst then
- ignore (warn "op_ASSIGN in constant");
- let bop' = match bop with
- A.ADD_ASSIGN -> PlusA
- | A.SUB_ASSIGN -> MinusA
- | A.MUL_ASSIGN -> Mult
- | A.DIV_ASSIGN -> Div
- | A.MOD_ASSIGN -> Mod
- | A.BAND_ASSIGN -> BAnd
- | A.BOR_ASSIGN -> BOr
- | A.XOR_ASSIGN -> BXor
- | A.SHL_ASSIGN -> Shiftlt
- | A.SHR_ASSIGN -> Shiftrt
- | _ -> E.s (error "binary +=")
- in
- let (se1, e1', t1) = doExp false e1 (AExp None) in
- let lv1 =
- match e1' with
- Lval x -> x
- | CastE (_, Lval x) -> x (* GCC extension. The operation and
- * the result are at the cast type *)
- | _ -> E.s (error "Expected lval for assignment with arith")
- in
- let (se2, e2', t2) = doExp false e2 (AExp None) in
- let tresult, result = doBinOp bop' e1' t1 e2' t2 in
- (* We must cast the result to the type of the lv1, which may be
- * different than t1 if lv1 was a Cast *)
- let _, result' = castTo tresult (typeOfLval lv1) result in
- (* The type of the result is the type of the left-hand side *)
- finishExp (se1 @@ se2 +++
- (Set(lv1, result', !currentLoc)))
- e1'
- t1
- end
- | _ -> E.s (error "Unexpected left operand for assignment with arith")
- end
-
-
- | A.BINARY((A.AND|A.OR), _, _) | A.UNARY(A.NOT, _) -> begin
- let ce = doCondExp asconst e in
- (* We must normalize the result to 0 or 1 *)
- match ce with
- CEExp (se, ((Const _) as c)) ->
- finishExp se (if isConstTrue c then one else zero) intType
- | CEExp (se, (UnOp(LNot, _, _) as e)) ->
- (* already normalized to 0 or 1 *)
- finishExp se e intType
- | CEExp (se, e) ->
- let e' =
- let te = typeOf e in
- let _, zte = castTo intType te zero in
- BinOp(Ne, e, zte, te)
- in
- finishExp se e' intType
- | _ ->
- let tmp = var (newTempVar intType) in
- finishExp (compileCondExp ce
- (empty +++ (Set(tmp, integer 1,
- !currentLoc)))
- (empty +++ (Set(tmp, integer 0,
- !currentLoc))))
- (Lval tmp)
- intType
- end
-
- | A.CALL(f, args) ->
- if asconst then
- ignore (warn "CALL in constant");
- let (sf, f', ft') =
- match f with (* Treat the VARIABLE case separate
- * becase we might be calling a
- * function that does not have a
- * prototype. In that case assume it
- * takes INTs as arguments *)
- A.VARIABLE n -> begin
- try
- let vi, _ = lookupVar n in
- (empty, Lval(var vi), vi.vtype) (* Found. Do not use
- * finishExp. Simulate what =
- * AExp None *)
- with Not_found -> begin
- ignore (warnOpt "Calling function %s without prototype." n);
- let ftype = TFun(intType, None, false,
- [Attr("missingproto",[])]) in
- (* Add a prototype to the environment *)
- let proto, _ =
- makeGlobalVarinfo false (makeGlobalVar n ftype) in
- (* Make it EXTERN *)
- proto.vstorage <- Extern;
- IH.add noProtoFunctions proto.vid true;
- (* Add it to the file as well *)
- cabsPushGlobal (GVarDecl (proto, !currentLoc));
- (empty, Lval(var proto), ftype)
- end
- end
- | _ -> doExp false f (AExp None)
- in
- (* Get the result type and the argument types *)
- let (resType, argTypes, isvar, f'') =
- match unrollType ft' with
- TFun(rt,at,isvar,a) -> (rt,at,isvar,f')
- | TPtr (t, _) -> begin
- match unrollType t with
- TFun(rt,at,isvar,a) -> (* Make the function pointer
- * explicit *)
- let f'' =
- match f' with
- AddrOf lv -> Lval(lv)
- | _ -> Lval(mkMem f' NoOffset)
- in
- (rt,at,isvar, f'')
- | x ->
- E.s (error "Unexpected type of the called function %a: %a"
- d_exp f' d_type x)
- end
- | x -> E.s (error "Unexpected type of the called function %a: %a"
- d_exp f' d_type x)
- in
- let argTypesList = argsToList argTypes in
- (* Drop certain qualifiers from the result type *)
- let resType' = resType in
- (* Before we do the arguments we try to intercept a few builtins. For
- * these we have defined then with a different type, so we do not
- * want to give warnings. We'll just leave the arguments of these
- * functions alone*)
- let isSpecialBuiltin =
- match f'' with
- Lval (Var fv, NoOffset) ->
- fv.vname = "__builtin_stdarg_start" ||
- fv.vname = "__builtin_va_arg" ||
- fv.vname = "__builtin_va_start" ||
- fv.vname = "__builtin_expect" ||
- fv.vname = "__builtin_next_arg"
- | _ -> false
- in
-
- (** If the "--forceRLArgEval" flag was used, make sure
- we evaluate args right-to-left.
- Added by Nathan Cooprider. **)
- let force_right_to_left_evaluation (c, e, t) =
- (* If chunk is empty then it is not already evaluated *)
- (* constants don't need to be pulled out *)
- if (!forceRLArgEval && (not (isConstant e)) &&
- (not isSpecialBuiltin)) then
- (* create a temporary *)
- let tmp = newTempVar t in
- (* create an instruction to give the e to the temporary *)
- let i = Set(var tmp, e, !currentLoc) in
- (* add the instruction to the chunk *)
- (* change the expression to be the temporary *)
- (c +++ i, (Lval(var tmp)), t)
- else
- (c, e, t)
- in
- (* Do the arguments. In REVERSE order !!! Both GCC and MSVC do this *)
- let rec loopArgs
- : (string * typ * attributes) list * A.expression list
- -> (chunk * exp list) = function
- | ([], []) -> (empty, [])
-
- | args, [] ->
- if not isSpecialBuiltin then
- ignore (warnOpt
- "Too few arguments in call to %a."
- d_exp f');
- (empty, [])
-
- | ((_, at, _) :: atypes, a :: args) ->
- let (ss, args') = loopArgs (atypes, args) in
- (* Do not cast as part of translating the argument. We let
- * the castTo to do this work. This was necessary for
- * test/small1/union5, in which a transparent union is passed
- * as an argument *)
- let (sa, a', att) = force_right_to_left_evaluation
- (doExp false a (AExp None)) in
- let (_, a'') = castTo att at a' in
- (ss @@ sa, a'' :: args')
-
- | ([], args) -> (* No more types *)
- if not isvar && argTypes != None && not isSpecialBuiltin then
- (* Do not give a warning for functions without a prototype*)
- ignore (warnOpt "Too many arguments in call to %a" d_exp f');
- let rec loop = function
- [] -> (empty, [])
- | a :: args ->
- let (ss, args') = loop args in
- let (sa, a', at) = force_right_to_left_evaluation
- (doExp false a (AExp None)) in
- (ss @@ sa, a' :: args')
- in
- loop args
- in
- let (sargs, args') = loopArgs (argTypesList, args) in
- (* Setup some pointer to the elements of the call. We may change
- * these below *)
- let prechunk: chunk ref = ref (sf @@ sargs) in (* comes before *)
-
- (* Do we actually have a call, or an expression? *)
- let piscall: bool ref = ref true in
-
- let pf: exp ref = ref f'' in (* function to call *)
- let pargs: exp list ref = ref args' in (* arguments *)
- let pis__builtin_va_arg: bool ref = ref false in
- let pwhat: expAction ref = ref what in (* what to do with result *)
-
- let pres: exp ref = ref zero in (* If we do not have a call, this is
- * the result *)
- let prestype: typ ref = ref intType in
-
- let rec dropCasts = function CastE (_, e) -> dropCasts e | e -> e in
- (* Get the name of the last formal *)
- let getNameLastFormal () : string =
- match !currentFunctionFDEC.svar.vtype with
- TFun(_, Some args, true, _) -> begin
- match List.rev args with
- (last_par_name, _, _) :: _ -> last_par_name
- | _ -> ""
- end
- | _ -> ""
- in
-
- (* Try to intercept some builtins *)
- (match !pf with
- Lval(Var fv, NoOffset) -> begin
- if fv.vname = "__builtin_va_arg" then begin
- match !pargs with
- marker :: SizeOf resTyp :: _ -> begin
- (* Make a variable of the desired type *)
- let destlv, destlvtyp =
- match !pwhat with
- ASet (lv, lvt) -> lv, lvt
- | _ -> var (newTempVar resTyp), resTyp
- in
- pwhat := (ASet (destlv, destlvtyp));
- pargs := [marker; SizeOf resTyp; AddrOf destlv];
- pis__builtin_va_arg := true;
- end
- | _ ->
- ignore (warn "Invalid call to %s\n" fv.vname);
- end else if fv.vname = "__builtin_stdarg_start" then begin
- match !pargs with
- marker :: last :: [] -> begin
- let isOk =
- match dropCasts last with
- Lval (Var lastv, NoOffset) ->
- lastv.vname = getNameLastFormal ()
- | _ -> false
- in
- if not isOk then
- ignore (warn "The second argument in call to %s should be the last formal argument\n" fv.vname);
-
- (* Check that "lastv" is indeed the last variable in the
- * prototype and then drop it *)
- pargs := [ marker ]
- end
- | _ ->
- ignore (warn "Invalid call to %s\n" fv.vname);
-
- (* We have to turn uses of __builtin_varargs_start into uses
- * of __builtin_stdarg_start (because we have dropped the
- * __builtin_va_alist argument from this function) *)
-
- end else if fv.vname = "__builtin_varargs_start" then begin
- (* Lookup the prototype for the replacement *)
- let v, _ =
- try lookupGlobalVar "__builtin_stdarg_start"
- with Not_found -> E.s (bug "Cannot find __builtin_stdarg_start to replace %s\n" fv.vname)
- in
- pf := Lval (var v)
- end else if fv.vname = "__builtin_next_arg" then begin
- match !pargs with
- last :: [] -> begin
- let isOk =
- match dropCasts last with
- Lval (Var lastv, NoOffset) ->
- lastv.vname = getNameLastFormal ()
- | _ -> false
- in
- if not isOk then
- ignore (warn "The argument in call to %s should be the last formal argument\n" fv.vname);
-
- pargs := [ ]
- end
- | _ ->
- ignore (warn "Invalid call to %s\n" fv.vname);
- end else if fv.vname = "__builtin_constant_p" then begin
- (* Drop the side-effects *)
- prechunk := empty;
-
- (* Constant-fold the argument and see if it is a constant *)
- (match !pargs with
- [ arg ] -> begin
- match constFold true arg with
- Const _ -> piscall := false;
- pres := integer 1;
- prestype := intType
-
- | _ -> piscall := false;
- pres := integer 0;
- prestype := intType
- end
- | _ ->
- ignore (warn "Invalid call to builtin_constant_p"));
- end
- end
- | _ -> ());
-
-
- (* Now we must finish the call *)
- if !piscall then begin
- let addCall (calldest: lval option) (res: exp) (t: typ) =
- prechunk := !prechunk +++
- (Call(calldest, !pf, !pargs, !currentLoc));
- pres := res;
- prestype := t
- in
- match !pwhat with
- ADrop -> addCall None zero intType
-
- (* Set to a variable of corresponding type *)
- | ASet(lv, vtype) ->
- (* Make an exception here for __builtin_va_arg *)
- if !pis__builtin_va_arg then
- addCall None (Lval(lv)) vtype
- else
- addCall (Some lv) (Lval(lv)) vtype
-
- | _ -> begin
- let tmp, restyp' =
- match !pwhat with
- AExp (Some t) -> newTempVar t, t
- | _ -> newTempVar resType', resType'
- in
- (* Remember that this variable has been created for this
- * specific call. We will use this in collapseCallCast and
- * above in finishCall. *)
- IH.add callTempVars tmp.vid ();
- addCall (Some (var tmp)) (Lval(var tmp)) restyp'
- end
- end;
-
- finishExp !prechunk !pres !prestype
-
-
- | A.COMMA el ->
- if asconst then
- ignore (warn "COMMA in constant");
- let rec loop sofar = function
- [e] ->
- let (se, e', t') = doExp false e what in (* Pass on the action *)
- (sofar @@ se, e', t')
-(*
- finishExp (sofar @@ se) e' t' (* does not hurt to do it twice.
- * GN: it seems it does *)
-*)
- | e :: rest ->
- let (se, _, _) = doExp false e ADrop in
- loop (sofar @@ se) rest
- | [] -> E.s (error "empty COMMA expression")
- in
- loop empty el
-
- | A.QUESTION (e1,e2,e3) when what = ADrop ->
- if asconst then
- ignore (warn "QUESTION with ADrop in constant");
- let (se3,_,_) = doExp false e3 ADrop in
- let se2 =
- match e2 with
- A.NOTHING -> skipChunk
- | _ -> let (se2,_,_) = doExp false e2 ADrop in se2
- in
- finishExp (doCondition asconst e1 se2 se3) zero intType
-
- | A.QUESTION (e1, e2, e3) -> begin (* what is not ADrop *)
- (* Compile the conditional expression *)
- let ce1 = doCondExp asconst e1 in
- (* Now we must find the type of both branches, in order to compute
- * the type of the result *)
- let se2, e2'o (* is an option. None means use e1 *), t2 =
- match e2 with
- A.NOTHING -> begin (* The same as the type of e1 *)
- match ce1 with
- CEExp (_, e1') -> empty, None, typeOf e1' (* Do not promote
- to bool *)
- | _ -> empty, None, intType
- end
- | _ ->
- let se2, e2', t2 = doExp asconst e2 (AExp None) in
- se2, Some e2', t2
- in
- (* Do e3 for real *)
- let se3, e3', t3 = doExp asconst e3 (AExp None) in
- (* Compute the type of the result *)
- let tresult = conditionalConversion t2 t3 in
- match ce1 with
- CEExp (se1, e1') when isConstFalse e1' && canDrop se2 ->
- finishExp (se1 @@ se3) (snd (castTo t3 tresult e3')) tresult
- | CEExp (se1, e1') when isConstTrue e1' && canDrop se3 ->
- begin
- match e2'o with
- None -> (* use e1' *)
- finishExp (se1 @@ se2) (snd (castTo t2 tresult e1')) tresult
- | Some e2' ->
- finishExp (se1 @@ se2) (snd (castTo t2 tresult e2')) tresult
- end
-
- | _ -> (* Use a conditional *) begin
- match e2 with
- A.NOTHING ->
- let tmp = var (newTempVar tresult) in
- let (se1, _, _) = doExp asconst e1 (ASet(tmp, tresult)) in
- let (se3, _, _) = doExp asconst e3 (ASet(tmp, tresult)) in
- finishExp (se1 @@ ifChunk (Lval(tmp)) lu
- skipChunk se3)
- (Lval(tmp))
- tresult
- | _ ->
- let lv, lvt =
- match what with
- | ASet (lv, lvt) -> lv, lvt
- | _ ->
- let tmp = newTempVar tresult in
- var tmp, tresult
- in
- (* Now do e2 and e3 for real *)
- let (se2, _, _) = doExp asconst e2 (ASet(lv, lvt)) in
- let (se3, _, _) = doExp asconst e3 (ASet(lv, lvt)) in
- finishExp (doCondition asconst e1 se2 se3) (Lval(lv)) tresult
- end
-
-(*
- (* Do these only to collect the types *)
- let se2, e2', t2' =
- match e2 with
- A.NOTHING -> (* A GNU thing. Use e1 as e2 *)
- doExp isconst e1 (AExp None)
- | _ -> doExp isconst e2 (AExp None) in
- (* Do e3 for real *)
- let se3, e3', t3' = doExp isconst e3 (AExp None) in
- (* Compute the type of the result *)
- let tresult = conditionalConversion e2' t2' e3' t3' in
- if (isEmpty se2 || e2 = A.NOTHING)
- && isEmpty se3 && isconst then begin
- (* Use the Question. This allows Question in initializers without
- * having to do constant folding *)
- let se1, e1', t1 = doExp isconst e1 (AExp None) in
- ignore (checkBool t1 e1');
- let e2'' =
- if e2 = A.NOTHING then
- mkCastT e1' t1 tresult
- else mkCastT e2' t2' tresult (* We know se2 is empty *)
- in
- let e3'' = mkCastT e3' t3' tresult in
- let resexp =
- match e1' with
- Const(CInt64(i, _, _)) when i <> Int64.zero -> e2''
- | Const(CInt64(z, _, _)) when z = Int64.zero -> e3''
- | _ -> Question(e1', e2'', e3'')
- in
- finishExp se1 resexp tresult
- end else begin (* Now use a conditional *)
- match e2 with
- A.NOTHING ->
- let tmp = var (newTempVar tresult) in
- let (se1, _, _) = doExp isconst e1 (ASet(tmp, tresult)) in
- let (se3, _, _) = doExp isconst e3 (ASet(tmp, tresult)) in
- finishExp (se1 @@ ifChunk (Lval(tmp)) lu
- skipChunk se3)
- (Lval(tmp))
- tresult
- | _ ->
- let lv, lvt =
- match what with
- | ASet (lv, lvt) -> lv, lvt
- | _ ->
- let tmp = newTempVar tresult in
- var tmp, tresult
- in
- (* Now do e2 and e3 for real *)
- let (se2, _, _) = doExp isconst e2 (ASet(lv, lvt)) in
- let (se3, _, _) = doExp isconst e3 (ASet(lv, lvt)) in
- finishExp (doCondition isconst e1 se2 se3) (Lval(lv)) tresult
- end
-*)
- end
-
- | A.GNU_BODY b -> begin
- (* Find the last A.COMPUTATION and remember it. This one is invoked
- * on the reversed list of statements. *)
- let rec findLastComputation = function
- s :: _ ->
- let rec findLast = function
- A.SEQUENCE (_, s, loc) -> findLast s
- | CASE (_, s, _) -> findLast s
- | CASERANGE (_, _, s, _) -> findLast s
- | LABEL (_, s, _) -> findLast s
- | (A.COMPUTATION _) as s -> s
- | _ -> raise Not_found
- in
- findLast s
- | [] -> raise Not_found
- in
- (* Save the previous data *)
- let old_gnu = ! gnu_body_result in
- let lastComp, isvoidbody =
- match what with
- ADrop -> (* We are dropping the result *)
- A.NOP cabslu, true
- | _ ->
- try findLastComputation (List.rev b.A.bstmts), false
- with Not_found ->
- E.s (error "Cannot find COMPUTATION in GNU.body")
- (* A.NOP cabslu, true *)
- in
- (* Prepare some data to be filled by doExp *)
- let data : (exp * typ) option ref = ref None in
- gnu_body_result := (lastComp, data);
-
- let se = doBody b in
-
- gnu_body_result := old_gnu;
- match !data with
- None when isvoidbody -> finishExp se zero voidType
- | None -> E.s (bug "Cannot find COMPUTATION in GNU.body")
- | Some (e, t) -> finishExp se e t
- end
-
- | A.LABELADDR l -> begin (* GCC's taking the address of a label *)
- let l = lookupLabel l in (* To support locallly declared labels *)
- let addrval =
- try H.find gotoTargetHash l
- with Not_found -> begin
- let res = !gotoTargetNextAddr in
- incr gotoTargetNextAddr;
- H.add gotoTargetHash l res;
- res
- end
- in
- finishExp empty (mkCast (integer addrval) voidPtrType) voidPtrType
- end
-
- | A.EXPR_PATTERN _ -> E.s (E.bug "EXPR_PATTERN in cabs2cil input")
-
- with e -> begin
- ignore (E.log "error in doExp (%s)@!" (Printexc.to_string e));
- E.hadErrors := true;
- (i2c (dInstr (dprintf "booo_exp(%t)" d_thisloc) !currentLoc),
- integer 0, intType)
- end
-
-(* bop is always the arithmetic version. Change it to the appropriate pointer
- * version if necessary *)
-and doBinOp (bop: binop) (e1: exp) (t1: typ) (e2: exp) (t2: typ) : typ * exp =
- let doArithmetic () =
- let tres = arithmeticConversion t1 t2 in
- (* Keep the operator since it is arithmetic *)
- tres,
- optConstFoldBinOp false bop (mkCastT e1 t1 tres) (mkCastT e2 t2 tres) tres
- in
- let doArithmeticComp () =
- let tres = arithmeticConversion t1 t2 in
- (* Keep the operator since it is arithemtic *)
- intType,
- optConstFoldBinOp false bop
- (mkCastT e1 t1 tres) (mkCastT e2 t2 tres) intType
- in
- let doIntegralArithmetic () =
- let tres = unrollType (arithmeticConversion t1 t2) in
- match tres with
- TInt _ ->
- tres,
- optConstFoldBinOp false bop
- (mkCastT e1 t1 tres) (mkCastT e2 t2 tres) tres
- | _ -> E.s (error "%a operator on a non-integer type" d_binop bop)
- in
- let pointerComparison e1 t1 e2 t2 =
- (* XL: Do not cast both sides -- what's the point? *)
- intType,
- optConstFoldBinOp false bop e1 e2 intType
- in
-
- match bop with
- (Mult|Div) -> doArithmetic ()
- | (Mod|BAnd|BOr|BXor) -> doIntegralArithmetic ()
- | (Shiftlt|Shiftrt) -> (* ISO 6.5.7. Only integral promotions. The result
- * has the same type as the left hand side *)
- if !msvcMode then
- (* MSVC has a bug. We duplicate it here *)
- doIntegralArithmetic ()
- else
- let t1' = integralPromotion t1 in
- let t2' = integralPromotion t2 in
- t1',
- optConstFoldBinOp false bop (mkCastT e1 t1 t1') (mkCastT e2 t2 t2') t1'
-
- | (PlusA|MinusA)
- when isArithmeticType t1 && isArithmeticType t2 -> doArithmetic ()
- | (Eq|Ne|Lt|Le|Ge|Gt)
- when isArithmeticType t1 && isArithmeticType t2 ->
- doArithmeticComp ()
- | PlusA when isPointerType t1 && isIntegralType t2 ->
- t1,
- optConstFoldBinOp false PlusPI e1
- (mkCastT e2 t2 (integralPromotion t2)) t1
- | PlusA when isIntegralType t1 && isPointerType t2 ->
- t2,
- optConstFoldBinOp false PlusPI e2
- (mkCastT e1 t1 (integralPromotion t1)) t2
- | MinusA when isPointerType t1 && isIntegralType t2 ->
- t1,
- optConstFoldBinOp false MinusPI e1
- (mkCastT e2 t2 (integralPromotion t2)) t1
- | MinusA when isPointerType t1 && isPointerType t2 ->
- let commontype = t1 in
- intType,
- optConstFoldBinOp false MinusPP (mkCastT e1 t1 commontype)
- (mkCastT e2 t2 commontype) intType
- | (Le|Lt|Ge|Gt|Eq|Ne) when isPointerType t1 && isPointerType t2 ->
- pointerComparison e1 t1 e2 t2
- | (Eq|Ne) when isPointerType t1 && isZero e2 ->
- pointerComparison e1 t1 (mkCastT zero !upointType t1) t1
- | (Eq|Ne) when isPointerType t2 && isZero e1 ->
- pointerComparison (mkCastT zero !upointType t2) t2 e2 t2
-
-
- | (Eq|Ne|Le|Lt|Ge|Gt) when isPointerType t1 && isArithmeticType t2 ->
- ignore (warnOpt "Comparison of pointer and non-pointer");
- (* Cast both values to void * *)
- doBinOp bop (mkCastT e1 t1 voidPtrType) voidPtrType
- (mkCastT e2 t2 voidPtrType) voidPtrType
- | (Eq|Ne|Le|Lt|Ge|Gt) when isArithmeticType t1 && isPointerType t2 ->
- ignore (warnOpt "Comparison of pointer and non-pointer");
- (* Cast both values to void * *)
- doBinOp bop (mkCastT e1 t1 voidPtrType) voidPtrType
- (mkCastT e2 t2 voidPtrType) voidPtrType
-
- | _ -> E.s (error "doBinOp: %a\n" d_plainexp (BinOp(bop,e1,e2,intType)))
-
-(* Constant fold a conditional. This is because we want to avoid having
- * conditionals in the initializers. So, we try very hard to avoid creating
- * new statements. *)
-and doCondExp (asconst: bool) (** Try to evaluate the conditional expression
- * to TRUE or FALSE, because it occurs in a
- * constant *)
- (e: A.expression) : condExpRes =
- let rec addChunkBeforeCE (c0: chunk) = function
- CEExp (c, e) -> CEExp (c0 @@ c, e)
- | CEAnd (ce1, ce2) -> CEAnd (addChunkBeforeCE c0 ce1, ce2)
- | CEOr (ce1, ce2) -> CEOr (addChunkBeforeCE c0 ce1, ce2)
- | CENot ce1 -> CENot (addChunkBeforeCE c0 ce1)
- in
- let rec canDropCE = function
- CEExp (c, e) -> canDrop c
- | CEAnd (ce1, ce2) | CEOr (ce1, ce2) -> canDropCE ce1 && canDropCE ce2
- | CENot (ce1) -> canDropCE ce1
- in
- match e with
- A.BINARY (A.AND, e1, e2) -> begin
- let ce1 = doCondExp asconst e1 in
- let ce2 = doCondExp asconst e2 in
- match ce1, ce2 with
- CEExp (se1, ((Const _) as ci1)), _ ->
- if isConstTrue ci1 then
- addChunkBeforeCE se1 ce2
- else
- (* se2 might contain labels so we cannot always drop it *)
- if canDropCE ce2 then
- ce1
- else
- CEAnd (ce1, ce2)
- | CEExp(se1, e1'), CEExp (se2, e2') when
- !useLogicalOperators && isEmpty se1 && isEmpty se2 ->
- CEExp (empty, BinOp(LAnd,
- mkCast e1' intType,
- mkCast e2' intType, intType))
- | _ -> CEAnd (ce1, ce2)
- end
-
- | A.BINARY (A.OR, e1, e2) -> begin
- let ce1 = doCondExp asconst e1 in
- let ce2 = doCondExp asconst e2 in
- match ce1, ce2 with
- CEExp (se1, (Const(CInt64 _) as ci1)), _ ->
- if isConstFalse ci1 then
- addChunkBeforeCE se1 ce2
- else
- (* se2 might contain labels so we cannot drop it *)
- if canDropCE ce2 then
- ce1
- else
- CEOr (ce1, ce2)
-
- | CEExp (se1, e1'), CEExp (se2, e2') when
- !useLogicalOperators && isEmpty se1 && isEmpty se2 ->
- CEExp (empty, BinOp(LOr, mkCast e1' intType,
- mkCast e2' intType, intType))
- | _ -> CEOr (ce1, ce2)
- end
-
- | A.UNARY(A.NOT, e1) -> begin
- match doCondExp asconst e1 with
- CEExp (se1, (Const _ as ci1)) ->
- if isConstFalse ci1 then
- CEExp (se1, one)
- else
- CEExp (se1, zero)
- | CEExp (se1, e) when isEmpty se1 ->
- let t = typeOf e in
- if not ((isPointerType t) || (isArithmeticType t))then
- E.s (error "Bad operand to !");
- CEExp (empty, UnOp(LNot, e, intType))
-
- | ce1 -> CENot ce1
- end
-
- | _ ->
- let (se, e, t) = doExp asconst e (AExp None) in
- ignore (checkBool t e);
- CEExp (se, if !lowerConstants then constFold asconst e else e)
-
-and compileCondExp (ce: condExpRes) (st: chunk) (sf: chunk) : chunk =
- match ce with
- | CEAnd (ce1, ce2) ->
- let (sf1, sf2) =
- (* If sf is small then will copy it *)
- try (sf, duplicateChunk sf)
- with Failure _ ->
- let lab = newLabelName "_L" in
- (gotoChunk lab lu, consLabel lab sf !currentLoc false)
- in
- let st' = compileCondExp ce2 st sf1 in
- let sf' = sf2 in
- compileCondExp ce1 st' sf'
-
- | CEOr (ce1, ce2) ->
- let (st1, st2) =
- (* If st is small then will copy it *)
- try (st, duplicateChunk st)
- with Failure _ ->
- let lab = newLabelName "_L" in
- (gotoChunk lab lu, consLabel lab st !currentLoc false)
- in
- let st' = st1 in
- let sf' = compileCondExp ce2 st2 sf in
- compileCondExp ce1 st' sf'
-
- | CENot ce1 -> compileCondExp ce1 sf st
-
- | CEExp (se, e) -> begin
- match e with
- Const(CInt64(i,_,_)) when i <> Int64.zero && canDrop sf -> se @@ st
- | Const(CInt64(z,_,_)) when z = Int64.zero && canDrop st -> se @@ sf
- | _ -> se @@ ifChunk e !currentLoc st sf
- end
-
-
-(* A special case for conditionals *)
-and doCondition (isconst: bool) (* If we are in constants, we do our best to
- * eliminate the conditional *)
- (e: A.expression)
- (st: chunk)
- (sf: chunk) : chunk =
- compileCondExp (doCondExp isconst e) st sf
-
-
-and doPureExp (e : A.expression) : exp =
- let (se, e', _) = doExp true e (AExp None) in
- if isNotEmpty se then
- E.s (error "doPureExp: not pure");
- e'
-
-and doInitializer
- (vi: varinfo)
- (inite: A.init_expression)
- (* Return the accumulated chunk, the initializer and the new type (might be
- * different for arrays) *)
- : chunk * init * typ =
-
- (* Setup the pre-initializer *)
- let topPreInit = ref NoInitPre in
- if debugInit then
- ignore (E.log "\nStarting a new initializer for %s : %a\n"
- vi.vname d_type vi.vtype);
- let topSetupInit (o: offset) (e: exp) =
- if debugInit then
- ignore (E.log " set %a := %a\n" d_lval (Var vi, o) d_exp e);
- let newinit = setOneInit !topPreInit o e in
- if newinit != !topPreInit then topPreInit := newinit
- in
- let acc, restl =
- let so = makeSubobj vi vi.vtype NoOffset in
- doInit vi.vglob topSetupInit so empty [ (A.NEXT_INIT, inite) ]
- in
- if restl <> [] then
- ignore (warn "Ignoring some initializers");
- (* sm: we used to do array-size fixups here, but they only worked
- * for toplevel array types; now, collectInitializer does the job,
- * including for nested array types *)
- let typ' = unrollType vi.vtype in
- if debugInit then
- ignore (E.log "Collecting the initializer for %s\n" vi.vname);
- let (init, typ'') = collectInitializer !topPreInit typ' in
- if debugInit then
- ignore (E.log "Finished the initializer for %s\n init=%a\n typ=%a\n acc=%a\n"
- vi.vname d_init init d_type typ' d_chunk acc);
- acc, init, typ''
-
-
-
-(* Consume some initializers. Watch out here. Make sure we use only
- * tail-recursion because these things can be big. *)
-and doInit
- (isconst: bool)
- (setone: offset -> exp -> unit) (* Use to announce an intializer *)
- (so: subobj)
- (acc: chunk)
- (initl: (A.initwhat * A.init_expression) list)
-
- (* Return the resulting chunk along with some unused initializers *)
- : chunk * (A.initwhat * A.init_expression) list =
-
- let whoami () = d_lval () (Var so.host, so.soOff) in
-
- let initl1 =
- match initl with
- | (A.NEXT_INIT,
- A.SINGLE_INIT (A.CAST ((s, dt), ie))) :: rest ->
- let s', dt', ie' = preprocessCast s dt ie in
- (A.NEXT_INIT, A.SINGLE_INIT (A.CAST ((s', dt'), ie'))) :: rest
- | _ -> initl
- in
- (* Sometimes we have a cast in front of a compound (in GCC). This
- * appears as a single initializer. Ignore the cast *)
- let initl2 =
- match initl1 with
- (what,
- A.SINGLE_INIT (A.CAST (_, A.COMPOUND_INIT ci))) :: rest ->
- (what, A.COMPOUND_INIT ci) :: rest
- | _ -> initl1
- in
- let allinitl = initl2 in
-
- if debugInit then begin
- ignore (E.log "doInit for %t %s (current %a). Looking at: " whoami
- (if so.eof then "(eof)" else "")
- d_lval (Var so.host, so.curOff));
- (match allinitl with
- [] -> ignore (E.log "[]")
- | (what, ie) :: _ ->
- withCprint
- Cprint.print_init_expression (A.COMPOUND_INIT [(what, ie)]));
- ignore (E.log "\n");
- end;
- match unrollType so.soTyp, allinitl with
- _, [] -> acc, [] (* No more initializers return *)
-
- (* No more subobjects *)
- | _, (A.NEXT_INIT, _) :: _ when so.eof -> acc, allinitl
-
-
- (* If we are at an array of characters and the initializer is a
- * string literal (optionally enclosed in braces) then explode the
- * string into characters *)
- | TArray(bt, leno, _),
- (A.NEXT_INIT,
- (A.SINGLE_INIT(A.CONSTANT (A.CONST_STRING s))|
- A.COMPOUND_INIT
- [(A.NEXT_INIT,
- A.SINGLE_INIT(A.CONSTANT
- (A.CONST_STRING s)))])) :: restil
- when (match unrollType bt with
- TInt((IChar|IUChar|ISChar), _) -> true
- | TInt _ ->
- (*Base type is a scalar other than char. Maybe a wchar_t?*)
- E.s (error "Using a string literal to initialize something other than a character array.\n")
- | _ -> false (* OK, this is probably an array of strings. Handle *)
- ) (* it with the other arrays below.*)
- ->
- let charinits =
- let init c = A.NEXT_INIT, A.SINGLE_INIT(A.CONSTANT (A.CONST_CHAR [c]))
- in
- let collector =
- (* ISO 6.7.8 para 14: final NUL added only if no size specified, or
- * if there is room for it; btw, we can't rely on zero-init of
- * globals, since this array might be a local variable *)
- if ((isNone leno) or ((String.length s) < (integerArrayLength leno)))
- then ref [init Int64.zero]
- else ref []
- in
- for pos = String.length s - 1 downto 0 do
- collector := init (Int64.of_int (Char.code (s.[pos]))) :: !collector
- done;
- !collector
- in
- (* Create a separate object for the array *)
- let so' = makeSubobj so.host so.soTyp so.soOff in
- (* Go inside the array *)
- let leno = integerArrayLength leno in
- so'.stack <- [InArray(so'.curOff, bt, leno, ref 0)];
- normalSubobj so';
- let acc', initl' = doInit isconst setone so' acc charinits in
- if initl' <> [] then
- ignore (warn "Too many initializers for character array %t" whoami);
- (* Advance past the array *)
- advanceSubobj so;
- (* Continue *)
- let res = doInit isconst setone so acc' restil in
- res
-
- (* If we are at an array of WIDE characters and the initializer is a
- * WIDE string literal (optionally enclosed in braces) then explore
- * the WIDE string into characters *)
- (* [weimer] Wed Jan 30 15:38:05 PST 2002
- * Despite what the compiler says, this match case is used and it is
- * important. *)
- | TArray(bt, leno, _),
- (A.NEXT_INIT,
- (A.SINGLE_INIT(A.CONSTANT (A.CONST_WSTRING s)) |
- A.COMPOUND_INIT
- [(A.NEXT_INIT,
- A.SINGLE_INIT(A.CONSTANT
- (A.CONST_WSTRING s)))])) :: restil
- when(let bt' = unrollType bt in
- match bt' with
- (* compare bt to wchar_t, ignoring signed vs. unsigned *)
- TInt _ when (bitsSizeOf bt') = (bitsSizeOf !wcharType) -> true
- | TInt _ ->
- (*Base type is a scalar other than wchar_t. Maybe a char?*)
- E.s (error "Using a wide string literal to initialize something other than a wchar_t array.\n")
- | _ -> false (* OK, this is probably an array of strings. Handle *)
- ) (* it with the other arrays below.*)
- ->
- let maxWChar = (* (2**(bitsSizeOf !wcharType)) - 1 *)
- Int64.sub (Int64.shift_left Int64.one (bitsSizeOf !wcharType))
- Int64.one in
- let charinits =
- let init c =
- if (compare c maxWChar > 0) then (* if c > maxWChar *)
- E.s (error "cab2cil:doInit:character 0x%Lx too big." c);
- A.NEXT_INIT,
- A.SINGLE_INIT(A.CONSTANT (A.CONST_INT (Int64.to_string c)))
- in
- (List.map init s) @
- (
- (* ISO 6.7.8 para 14: final NUL added only if no size specified, or
- * if there is room for it; btw, we can't rely on zero-init of
- * globals, since this array might be a local variable *)
- if ((isNone leno) or ((List.length s) < (integerArrayLength leno)))
- then [init Int64.zero]
- else [])
-(*
- List.map
- (fun c ->
- if (compare c maxWChar > 0) then (* if c > maxWChar *)
- E.s (error "cab2cil:doInit:character 0x%Lx too big." c)
- else
- (A.NEXT_INIT,
- A.SINGLE_INIT(A.CONSTANT (A.CONST_INT (Int64.to_string c)))))
- s
-*)
- in
- (* Create a separate object for the array *)
- let so' = makeSubobj so.host so.soTyp so.soOff in
- (* Go inside the array *)
- let leno = integerArrayLength leno in
- so'.stack <- [InArray(so'.curOff, bt, leno, ref 0)];
- normalSubobj so';
- let acc', initl' = doInit isconst setone so' acc charinits in
- if initl' <> [] then
- (* sm: see above regarding ISO 6.7.8 para 14, which is not implemented
- * for wchar_t because, as far as I can tell, we don't even put in
- * the automatic NUL (!) *)
- ignore (warn "Too many initializers for wchar_t array %t" whoami);
- (* Advance past the array *)
- advanceSubobj so;
- (* Continue *)
- doInit isconst setone so acc' restil
-
- (* If we are at an array and we see a single initializer then it must
- * be one for the first element *)
- | TArray(bt, leno, al), (A.NEXT_INIT, A.SINGLE_INIT oneinit) :: restil ->
- (* Grab the length if there is one *)
- let leno = integerArrayLength leno in
- so.stack <- InArray(so.soOff, bt, leno, ref 0) :: so.stack;
- normalSubobj so;
- (* Start over with the fields *)
- doInit isconst setone so acc allinitl
-
- (* If we are at a composite and we see a single initializer of the same
- * type as the composite then grab it all. If the type is not the same
- * then we must go on and try to initialize the fields *)
- | TComp (comp, _), (A.NEXT_INIT, A.SINGLE_INIT oneinit) :: restil ->
- let se, oneinit', t' = doExp isconst oneinit (AExp None) in
- if (match unrollType t' with
- TComp (comp', _) when comp'.ckey = comp.ckey -> true
- | _ -> false)
- then begin
- (* Initialize the whole struct *)
- setone so.soOff oneinit';
- (* Advance to the next subobject *)
- advanceSubobj so;
- doInit isconst setone so (acc @@ se) restil
- end else begin (* Try to initialize fields *)
- let toinit = fieldsToInit comp None in
- so.stack <- InComp(so.soOff, comp, toinit) :: so.stack;
- normalSubobj so;
- doInit isconst setone so acc allinitl
- end
-
- (* A scalar with a single initializer *)
- | _, (A.NEXT_INIT, A.SINGLE_INIT oneinit) :: restil ->
- let se, oneinit', t' = doExp isconst oneinit (AExp(Some so.soTyp)) in
-(*
- ignore (E.log "oneinit'=%a, t'=%a, so.soTyp=%a\n"
- d_exp oneinit' d_type t' d_type so.soTyp);
-*)
- setone so.soOff (mkCastT oneinit' t' so.soTyp);
- (* Move on *)
- advanceSubobj so;
- doInit isconst setone so (acc @@ se) restil
-
-
- (* An array with a compound initializer. The initializer is for the
- * array elements *)
- | TArray (bt, leno, _), (A.NEXT_INIT, A.COMPOUND_INIT initl) :: restil ->
- (* Create a separate object for the array *)
- let so' = makeSubobj so.host so.soTyp so.soOff in
- (* Go inside the array *)
- let leno = integerArrayLength leno in
- so'.stack <- [InArray(so'.curOff, bt, leno, ref 0)];
- normalSubobj so';
- let acc', initl' = doInit isconst setone so' acc initl in
- if initl' <> [] then
- ignore (warn "Too many initializers for array %t" whoami);
- (* Advance past the array *)
- advanceSubobj so;
- (* Continue *)
- let res = doInit isconst setone so acc' restil in
- res
-
- (* We have a designator that tells us to select the matching union field.
- * This is to support a GCC extension *)
- | TComp(ci, _), [(A.NEXT_INIT,
- A.COMPOUND_INIT [(A.INFIELD_INIT ("___matching_field",
- A.NEXT_INIT),
- A.SINGLE_INIT oneinit)])]
- when not ci.cstruct ->
- (* Do the expression to find its type *)
- let _, _, t' = doExp isconst oneinit (AExp None) in
- let tsig = typeSigWithAttrs (fun _ -> []) t' in
- let rec findField = function
- [] -> E.s (error "Cannot find matching union field in cast")
- | fi :: rest
- when Util.equals (typeSigWithAttrs (fun _ -> []) fi.ftype) tsig
- -> fi
- | _ :: rest -> findField rest
- in
- let fi = findField ci.cfields in
- (* Change the designator and redo *)
- doInit isconst setone so acc [(A.INFIELD_INIT (fi.fname, A.NEXT_INIT),
- A.SINGLE_INIT oneinit)]
-
-
- (* A structure with a composite initializer. We initialize the fields*)
- | TComp (comp, _), (A.NEXT_INIT, A.COMPOUND_INIT initl) :: restil ->
- (* Create a separate subobject iterator *)
- let so' = makeSubobj so.host so.soTyp so.soOff in
- (* Go inside the comp *)
- so'.stack <- [InComp(so'.curOff, comp, fieldsToInit comp None)];
- normalSubobj so';
- let acc', initl' = doInit isconst setone so' acc initl in
- if initl' <> [] then
- ignore (warn "Too many initializers for structure");
- (* Advance past the structure *)
- advanceSubobj so;
- (* Continue *)
- doInit isconst setone so acc' restil
-
- (* A scalar with a initializer surrounded by braces *)
- | _, (A.NEXT_INIT, A.COMPOUND_INIT [(A.NEXT_INIT,
- A.SINGLE_INIT oneinit)]) :: restil ->
- let se, oneinit', t' = doExp isconst oneinit (AExp(Some so.soTyp)) in
- setone so.soOff (mkCastT oneinit' t' so.soTyp);
- (* Move on *)
- advanceSubobj so;
- doInit isconst setone so (acc @@ se) restil
-
- | t, (A.NEXT_INIT, _) :: _ ->
- E.s (unimp "doInit: unexpected NEXT_INIT for %a\n" d_type t);
-
- (* We have a designator *)
- | _, (what, ie) :: restil when what != A.NEXT_INIT ->
- (* Process a designator and position to the designated subobject *)
- let rec addressSubobj
- (so: subobj)
- (what: A.initwhat)
- (acc: chunk) : chunk =
- (* Always start from the current element *)
- so.stack <- []; so.eof <- false;
- normalSubobj so;
- let rec address (what: A.initwhat) (acc: chunk) : chunk =
- match what with
- A.NEXT_INIT -> acc
- | A.INFIELD_INIT (fn, whatnext) -> begin
- match unrollType so.soTyp with
- TComp (comp, _) ->
- let toinit = fieldsToInit comp (Some fn) in
- so.stack <- InComp(so.soOff, comp, toinit) :: so.stack;
- normalSubobj so;
- address whatnext acc
-
- | _ -> E.s (error "Field designator %s not in a struct " fn)
- end
-
- | A.ATINDEX_INIT(idx, whatnext) -> begin
- match unrollType so.soTyp with
- TArray (bt, leno, _) ->
- let ilen = integerArrayLength leno in
- let nextidx', doidx =
- let (doidx, idxe', _) =
- doExp true idx (AExp(Some intType)) in
- match constFold true idxe', isNotEmpty doidx with
- Const(CInt64(x, _, _)), false -> Int64.to_int x, doidx
- | _ -> E.s (error
- "INDEX initialization designator is not a constant")
- in
- if nextidx' < 0 || nextidx' >= ilen then
- E.s (error "INDEX designator is outside bounds");
- so.stack <-
- InArray(so.soOff, bt, ilen, ref nextidx') :: so.stack;
- normalSubobj so;
- address whatnext (acc @@ doidx)
-
- | _ -> E.s (error "INDEX designator for a non-array")
- end
-
- | A.ATINDEXRANGE_INIT _ ->
- E.s (bug "addressSubobj: INDEXRANGE")
- in
- address what acc
- in
- (* First expand the INDEXRANGE by making copies *)
- let rec expandRange (top: A.initwhat -> A.initwhat) = function
- | A.INFIELD_INIT (fn, whatnext) ->
- expandRange (fun what -> top (A.INFIELD_INIT(fn, what))) whatnext
- | A.ATINDEX_INIT (idx, whatnext) ->
- expandRange (fun what -> top (A.ATINDEX_INIT(idx, what))) whatnext
-
- | A.ATINDEXRANGE_INIT (idxs, idxe) ->
- let (doidxs, idxs', _) =
- doExp true idxs (AExp(Some intType)) in
- let (doidxe, idxe', _) =
- doExp true idxe (AExp(Some intType)) in
- if isNotEmpty doidxs || isNotEmpty doidxe then
- E.s (error "Range designators are not constants\n");
- let first, last =
- match constFold true idxs', constFold true idxe' with
- Const(CInt64(s, _, _)),
- Const(CInt64(e, _, _)) ->
- Int64.to_int s, Int64.to_int e
- | _ -> E.s (error
- "INDEX_RANGE initialization designator is not a constant")
- in
- if first < 0 || first > last then
- E.s (error
- "start index larger than end index in range initializer");
- let rec loop (i: int) =
- if i > last then restil
- else
- (top (A.ATINDEX_INIT(A.CONSTANT(A.CONST_INT(string_of_int i)),
- A.NEXT_INIT)), ie)
- :: loop (i + 1)
- in
- doInit isconst setone so acc (loop first)
-
- | A.NEXT_INIT -> (* We have not found any RANGE *)
- let acc' = addressSubobj so what acc in
- doInit isconst setone so (acc @@ acc')
- ((A.NEXT_INIT, ie) :: restil)
- in
- expandRange (fun x -> x) what
-
- | t, (what, ie) :: _ ->
- E.s (bug "doInit: cases for t=%a" d_type t)
-
-
-(* Create and add to the file (if not already added) a global. Return the
- * varinfo *)
-and createGlobal (specs : (typ * storage * bool * A.attribute list))
- (((n,ndt,a,cloc), inite) : A.init_name) : varinfo =
- try
- if debugGlobal then
- ignore (E.log "createGlobal: %s\n" n);
- (* Make a first version of the varinfo *)
- let vi = makeVarInfoCabs ~isformal:false
- ~isglobal:true (convLoc cloc) specs (n,ndt,a) in
- (* Add the variable to the environment before doing the initializer
- * because it might refer to the variable itself *)
- if isFunctionType vi.vtype then begin
- if inite != A.NO_INIT then
- E.s (error "Function declaration with initializer (%s)\n"
- vi.vname);
- (* sm: if it's a function prototype, and the storage class *)
- (* isn't specified, make it 'extern'; this fixes a problem *)
- (* with no-storage prototype and static definition *)
- if vi.vstorage = NoStorage then
- (*(trace "sm" (dprintf "adding extern to prototype of %s\n" n));*)
- vi.vstorage <- Extern;
- end;
- let vi, alreadyInEnv = makeGlobalVarinfo (inite != A.NO_INIT) vi in
-(*
- ignore (E.log "createGlobal %a: %s type=%a\n"
- d_loc (convLoc cloc) vi.vname d_plaintype vi.vtype);
-*)
- (* Do the initializer and complete the array type if necessary *)
- let init : init option =
- if inite = A.NO_INIT then
- None
- else
- let se, ie', et = doInitializer vi inite in
- (* Maybe we now have a better type *)
- vi.vtype <- et;
- if isNotEmpty se then
- E.s (error "global initializer");
- Some ie'
- in
-
- try
- let oldloc = H.find alreadyDefined vi.vname in
- if init != None then begin
- E.s (error "Global %s was already defined at %a\n"
- vi.vname d_loc oldloc);
- end;
- if debugGlobal then
- ignore (E.log " global %s was already defined\n" vi.vname);
- (* Do not declare it again *)
- vi
- with Not_found -> begin
- (* Not already defined *)
- if debugGlobal then
- ignore (E.log " first definition for %s\n" vi.vname);
- if init != None then begin
- (* weimer: Sat Dec 8 17:43:34 2001
- * MSVC NT Kernel headers include this lovely line:
- * extern const GUID __declspec(selectany) \
- * MOUNTDEV_MOUNTED_DEVICE_GUID = { 0x53f5630d, 0xb6bf, 0x11d0, { \
- * 0x94, 0xf2, 0x00, 0xa0, 0xc9, 0x1e, 0xfb, 0x8b } };
- * So we allow "extern" + "initializer" if "const" is
- * around. *)
- (* sm: As I read the ISO spec, in particular 6.9.2 and 6.7.8,
- * "extern int foo = 3" is exactly equivalent to "int foo = 3";
- * that is, if you put an initializer, then it is a definition,
- * and "extern" is redundantly giving the name external linkage.
- * gcc emits a warning, I guess because it is contrary to
- * usual practice, but I think CIL warnings should be about
- * semantic rather than stylistic issues, so I see no reason to
- * even emit a warning. *)
- if vi.vstorage = Extern then
- vi.vstorage <- NoStorage; (* equivalent and canonical *)
-
- H.add alreadyDefined vi.vname !currentLoc;
- IH.remove mustTurnIntoDef vi.vid;
- cabsPushGlobal (GVar(vi, {init = init}, !currentLoc));
- vi
- end else begin
- if not (isFunctionType vi.vtype)
- && not (IH.mem mustTurnIntoDef vi.vid) then
- begin
- IH.add mustTurnIntoDef vi.vid true
- end;
- if not alreadyInEnv then begin (* Only one declaration *)
- (* If it has function type it is a prototype *)
- cabsPushGlobal (GVarDecl (vi, !currentLoc));
- vi
- end else begin
- if debugGlobal then
- ignore (E.log " already in env %s\n" vi.vname);
- vi
- end
- end
- end
- with e -> begin
- ignore (E.log "error in createGlobal(%s: %a): %s\n" n
- d_loc !currentLoc
- (Printexc.to_string e));
- cabsPushGlobal (dGlobal (dprintf "booo - error in global %s (%t)"
- n d_thisloc) !currentLoc);
- dummyFunDec.svar
- end
-(*
- ignore (E.log "Env after processing global %s is:@!%t@!"
- n docEnv);
- ignore (E.log "Alpha after processing global %s is:@!%t@!"
- n docAlphaTable)
-*)
-
-(* Must catch the Static local variables. Make them global *)
-and createLocal ((_, sto, _, _) as specs)
- ((((n, ndt, a, cloc) : A.name),
- (inite: A.init_expression)) as init_name)
- : chunk =
- let loc = convLoc cloc in
- (* Check if we are declaring a function *)
- let rec isProto (dt: decl_type) : bool =
- match dt with
- | PROTO (JUSTBASE, _, _) -> true
- | PROTO (x, _, _) -> isProto x
- | PARENTYPE (_, x, _) -> isProto x
- | ARRAY (x, _, _) -> isProto x
- | PTR (_, x) -> isProto x
- | _ -> false
- in
- match ndt with
- (* Maybe we have a function prototype in local scope. Make it global. We
- * do this even if the storage is Static *)
- | _ when isProto ndt ->
- let vi = createGlobal specs init_name in
- (* Add it to the environment to shadow previous decls *)
- addLocalToEnv n (EnvVar vi);
- empty
-
- | _ when sto = Static ->
- if debugGlobal then
- ignore (E.log "createGlobal (local static): %s\n" n);
-
-
- (* Now alpha convert it to make sure that it does not conflict with
- * existing globals or locals from this function. *)
- let newname, _ = newAlphaName true "" n in
- (* Make it global *)
- let vi = makeVarInfoCabs ~isformal:false
- ~isglobal:true
- loc specs (newname, ndt, a) in
- (* However, we have a problem if a real global appears later with the
- * name that we have happened to choose for this one. Remember these names
- * for later. *)
- H.add staticLocals vi.vname vi;
- (* Add it to the environment as a local so that the name goes out of
- * scope properly *)
- addLocalToEnv n (EnvVar vi);
-
- (* Maybe this is an array whose length depends on something with local
- scope, e.g. "static char device[ sizeof(local) ]".
- Const-fold the type to fix this. *)
- vi.vtype <- constFoldType vi.vtype;
-
- let init : init option =
- if inite = A.NO_INIT then
- None
- else begin
- let se, ie', et = doInitializer vi inite in
- (* Maybe we now have a better type *)
- vi.vtype <- et;
- if isNotEmpty se then
- E.s (error "global static initializer");
- (* Maybe the initializer refers to the function itself.
- Push a prototype for the function, just in case. Hopefully,
- if does not refer to the locals *)
- cabsPushGlobal (GVarDecl (!currentFunctionFDEC.svar, !currentLoc));
- Some ie'
- end
- in
- cabsPushGlobal (GVar(vi, {init = init}, !currentLoc));
- empty
-
- (* Maybe we have an extern declaration. Make it a global *)
- | _ when sto = Extern ->
- let vi = createGlobal specs init_name in
- (* Add it to the local environment to ensure that it shadows previous
- * local variables *)
- addLocalToEnv n (EnvVar vi);
- empty
-
- | _ ->
- (* Make a variable of potentially variable size. If se0 <> empty then
- * it is a variable size variable *)
- let vi,se0,len,isvarsize =
- makeVarSizeVarInfo loc specs (n, ndt, a) in
-
- let vi = alphaConvertVarAndAddToEnv true vi in (* Replace vi *)
- let se1 =
- if isvarsize then begin (* Variable-sized array *)
- ignore (warn "Variable-sized local variable %s" vi.vname);
- (* Make a local variable to keep the length *)
- let savelen =
- makeVarInfoCabs
- ~isformal:false
- ~isglobal:false
- loc
- (TInt(IUInt, []), NoStorage, false, [])
- ("__lengthof" ^ vi.vname,JUSTBASE, [])
- in
- (* Register it *)
- let savelen = alphaConvertVarAndAddToEnv true savelen in
- (* Compute the sizeof *)
- let sizeof =
- BinOp(Mult,
- SizeOfE (Lval(Mem(Lval(var vi)), NoOffset)),
- Lval (var savelen), !typeOfSizeOf) in
- (* Register the length *)
- IH.add varSizeArrays vi.vid sizeof;
- (* There can be no initializer for this *)
- if inite != A.NO_INIT then
- E.s (error "Variable-sized array cannot have initializer");
- se0 +++ (Set(var savelen, len, !currentLoc))
- (* Initialize the variable *)
- +++ (Call(Some(var vi), Lval(var (allocaFun ())),
- [ sizeof ], !currentLoc))
- end else empty
- in
- if inite = A.NO_INIT then
- se1 (* skipChunk *)
- else begin
- let se4, ie', et = doInitializer vi inite in
- (* Fix the length *)
- (match vi.vtype, ie', et with
- (* We have a length now *)
- TArray(_,None, _), _, TArray(_, Some _, _) -> vi.vtype <- et
- (* Initializing a local array *)
- | TArray(TInt((IChar|IUChar|ISChar), _) as bt, None, a),
- SingleInit(Const(CStr s)), _ ->
- vi.vtype <- TArray(bt,
- Some (integer (String.length s + 1)),
- a)
- | _, _, _ -> ());
-
- (* Now create assignments instead of the initialization *)
- se1 @@ se4 @@ (assignInit (Var vi, NoOffset) ie' et empty)
- end
-
-and doAliasFun vtype (thisname:string) (othername:string)
- (sname:single_name) (loc: cabsloc) : unit =
- (* This prototype declares that name is an alias for
- othername, which must be defined in this file *)
-(* E.log "%s is alias for %s at %a\n" thisname othername *)
-(* d_loc !currentLoc; *)
- let rt, formals, isva, _ = splitFunctionType vtype in
- if isva then E.s (error "%a: alias unsupported with varargs."
- d_loc !currentLoc);
- let args = List.map
- (fun (n,_,_) -> A.VARIABLE n)
- (argsToList formals) in
- let call = A.CALL (A.VARIABLE othername, args) in
- let stmt = if isVoidType rt then A.COMPUTATION(call, loc)
- else A.RETURN(call, loc)
- in
- let body = { A.blabels = []; A.battrs = []; A.bstmts = [stmt] } in
- let fdef = A.FUNDEF (sname, body, loc, loc) in
- ignore (doDecl true fdef);
- (* get the new function *)
- let v,_ = try lookupGlobalVar thisname
- with Not_found -> E.s (bug "error in doDecl") in
- v.vattr <- dropAttribute "alias" v.vattr
-
-
-(* Do one declaration *)
-and doDecl (isglobal: bool) : A.definition -> chunk = function
- | A.DECDEF ((s, nl), loc) ->
- currentLoc := convLoc(loc);
- (* Do the specifiers exactly once *)
- let sugg =
- match nl with
- [] -> ""
- | ((n, _, _, _), _) :: _ -> n
- in
- let spec_res = doSpecList sugg s in
- (* Do all the variables and concatenate the resulting statements *)
- let doOneDeclarator (acc: chunk) (name: init_name) =
- let (n,ndt,a,l),_ = name in
- if isglobal then begin
- let bt,_,_,attrs = spec_res in
- let vtype, nattr =
- doType (AttrName false) bt (A.PARENTYPE(attrs, ndt, a)) in
- (match filterAttributes "alias" nattr with
- [] -> (* ordinary prototype. *)
- ignore (createGlobal spec_res name)
- (* E.log "%s is not aliased\n" name *)
- | [Attr("alias", [AStr othername])] ->
- if not (isFunctionType vtype) then begin
- ignore (warn
- "%a: CIL only supports attribute((alias)) for functions.\n"
- d_loc !currentLoc);
- ignore (createGlobal spec_res name)
- end else
- doAliasFun vtype n othername (s, (n,ndt,a,l)) loc
- | _ -> E.s (error "Bad alias attribute at %a" d_loc !currentLoc));
- acc
- end else
- acc @@ createLocal spec_res name
- in
- let res = List.fold_left doOneDeclarator empty nl in
-(*
- ignore (E.log "after doDecl %a: res=%a\n"
- d_loc !currentLoc d_chunk res);
-*)
- res
-
-
-
- | A.TYPEDEF (ng, loc) ->
- currentLoc := convLoc(loc);
- doTypedef ng; empty
-
- | A.ONLYTYPEDEF (s, loc) ->
- currentLoc := convLoc(loc);
- doOnlyTypedef s; empty
-
- | A.GLOBASM (s,loc) when isglobal ->
- currentLoc := convLoc(loc);
- cabsPushGlobal (GAsm (s, !currentLoc));
- empty
-
- | A.PRAGMA (a, loc) when isglobal -> begin
- currentLoc := convLoc(loc);
- match doAttr ("dummy", [a]) with
- [Attr("dummy", [a'])] ->
- let a'' =
- match a' with
- | ACons (s, args) -> Attr (s, args)
- | _ -> E.s (error "Unexpected attribute in #pragma")
- in
- cabsPushGlobal (GPragma (a'', !currentLoc));
- empty
-
- | _ -> E.s (error "Too many attributes in pragma")
- end
- | A.TRANSFORMER (_, _, _) -> E.s (E.bug "TRANSFORMER in cabs2cil input")
- | A.EXPRTRANSFORMER (_, _, _) ->
- E.s (E.bug "EXPRTRANSFORMER in cabs2cil input")
-
- (* If there are multiple definitions of extern inline, turn all but the
- * first into a prototype *)
- | A.FUNDEF (((specs,(n,dt,a,loc')) : A.single_name),
- (body : A.block), loc, _)
- when isglobal && isExtern specs && isInline specs
- && (H.mem genv (n ^ "__extinline")) ->
- currentLoc := convLoc(loc);
- let othervi, _ = lookupVar (n ^ "__extinline") in
- if othervi.vname = n then
- (* The previous entry in the env is also an extern inline version
- of n. *)
- ignore (warn "Duplicate extern inline definition for %s ignored" n)
- else begin
- (* Otherwise, the previous entry is an ordinary function that
- happens to be named __extinline. Renaming n to n__extinline
- would confict with other, so report an error. *)
- E.s (unimp("Trying to rename %s to\n %s__extinline, but %s__extinline"
- ^^ " already exists in the env.\n \"__extinline\" is"
- ^^ " reserved for CIL.\n") n n n)
- end;
- (* Treat it as a prototype *)
- doDecl isglobal (A.DECDEF ((specs, [((n,dt,a,loc'), A.NO_INIT)]), loc))
-
- | A.FUNDEF (((specs,(n,dt,a, _)) : A.single_name),
- (body : A.block), loc1, loc2) when isglobal ->
- begin
- let funloc = convLoc loc1 in
- let endloc = convLoc loc2 in
-(* ignore (E.log "Definition of %s at %a\n" n d_loc funloc); *)
- currentLoc := funloc;
- E.withContext
- (fun _ -> dprintf "2cil: %s" n)
- (fun _ ->
- try
- IH.clear callTempVars;
-
- (* Make the fundec right away, and we'll populate it later. We
- * need this throughout the code to create temporaries. *)
- currentFunctionFDEC :=
- { svar = makeGlobalVar "@tempname@" voidType;
- slocals = []; (* For now we'll put here both the locals and
- * the formals. Then "endFunction" will
- * separate them *)
- sformals = []; (* Not final yet *)
- smaxid = 0;
- sbody = dummyFunDec.sbody; (* Not final yet *)
- smaxstmtid = None;
- sallstmts = [];
- };
- !currentFunctionFDEC.svar.vdecl <- funloc;
-
- constrExprId := 0;
- (* Setup the environment. Add the formals to the locals. Maybe
- * they need alpha-conv *)
- enterScope (); (* Start the scope *)
-
- IH.clear varSizeArrays;
-
- (* Do not process transparent unions in function definitions.
- * We'll do it later *)
- transparentUnionArgs := [];
-
- (* Fix the NAME and the STORAGE *)
- let _ =
- let bt,sto,inl,attrs = doSpecList n specs in
- !currentFunctionFDEC.svar.vinline <- inl;
-
- let ftyp, funattr =
- doType (AttrName false) bt (A.PARENTYPE(attrs, dt, a)) in
- !currentFunctionFDEC.svar.vtype <- ftyp;
- !currentFunctionFDEC.svar.vattr <- funattr;
-
- (* If this is the definition of an extern inline then we change
- * its name, by adding the suffix __extinline. We also make it
- * static *)
- let n', sto' =
- let n' = n ^ "__extinline" in
- if inl && sto = Extern then
- n', Static
- else begin
- (* Maybe this is the body of a previous extern inline. Then
- * we must take that one out of the environment because it
- * is not used from here on. This will also ensure that
- * then we make this functions' varinfo we will not think
- * it is a duplicate definition *)
- (try
- ignore (lookupVar n'); (* if this succeeds, n' is defined*)
- let oldvi, _ = lookupVar n in
- if oldvi.vname = n' then begin
- (* oldvi is an extern inline function that has been
- renamed to n ^ "__extinline". Remove it from the
- environment. *)
- H.remove env n; H.remove genv n;
- H.remove env n'; H.remove genv n'
- end
- else
- (* oldvi is not a renamed extern inline function, and
- we should do nothing. The reason the lookup
- of n' succeeded is probably because there's
- an ordinary function that happens to be named,
- n ^ "__extinline", probably as a result of a previous
- pass through CIL. See small2/extinline.c*)
- ()
- with Not_found -> ());
- n, sto
- end
- in
- (* Now we have the name and the storage *)
- !currentFunctionFDEC.svar.vname <- n';
- !currentFunctionFDEC.svar.vstorage <- sto'
- in
-
- (* Add the function itself to the environment. Add it before
- * you do the body because the function might be recursive. Add
- * it also before you add the formals to the environment
- * because there might be a formal with the same name as the
- * function and we want it to take precedence. *)
- (* Make a variable out of it and put it in the environment *)
- !currentFunctionFDEC.svar <-
- fst (makeGlobalVarinfo true !currentFunctionFDEC.svar);
-
- (* If it is extern inline then we add it to the global
- * environment for the original name as well. This will ensure
- * that all uses of this function will refer to the renamed
- * function *)
- addGlobalToEnv n (EnvVar !currentFunctionFDEC.svar);
-
- if H.mem alreadyDefined !currentFunctionFDEC.svar.vname then
- E.s (error "There is a definition already for %s" n);
-
-(*
- ignore (E.log "makefunvar:%s@! type=%a@! vattr=%a@!"
- n d_type thisFunctionVI.vtype
- d_attrlist thisFunctionVI.vattr);
-*)
-
- (* makeGlobalVarinfo might have changed the type of the function
- * (when combining it with the type of the prototype). So get the
- * type only now. *)
-
- (**** Process the TYPE and the FORMALS ***)
- let _ =
- let (returnType, formals_t, isvararg, funta) =
- splitFunctionTypeVI !currentFunctionFDEC.svar
- in
- (* Record the returnType for doStatement *)
- currentReturnType := returnType;
-
-
- (* Create the formals and add them to the environment. *)
- (* sfg: extract locations for the formals from dt *)
- let doFormal (loc : location) (fn, ft, fa) =
- let f = makeVarinfo false fn ft in
- (f.vdecl <- loc;
- f.vattr <- fa;
- alphaConvertVarAndAddToEnv true f)
- in
- let rec doFormals fl' ll' =
- begin
- match (fl', ll') with
- | [], _ -> []
-
- | fl, [] -> (* no more locs available *)
- List.map (doFormal !currentLoc) fl
-
- | f::fl, (_,(_,_,_,l))::ll ->
- (* sfg: these lets seem to be necessary to
- * force the right order of evaluation *)
- let f' = doFormal (convLoc l) f in
- let fl' = doFormals fl ll in
- f' :: fl'
- end
- in
- let fmlocs = (match dt with PROTO(_, fml, _) -> fml | _ -> []) in
- let formals = doFormals (argsToList formals_t) fmlocs in
-
- (* Recreate the type based on the formals. *)
- let ftype = TFun(returnType,
- Some (List.map (fun f -> (f.vname,
- f.vtype,
- f.vattr)) formals),
- isvararg, funta) in
- (*
- ignore (E.log "Funtype of %s: %a\n" n' d_type ftype);
- *)
- (* Now fix the names of the formals in the type of the function
- * as well *)
- !currentFunctionFDEC.svar.vtype <- ftype;
- !currentFunctionFDEC.sformals <- formals;
- in
- (* Now change the type of transparent union args back to what it
- * was so that the body type checks. We must do it this late
- * because makeGlobalVarinfo from above might choke if we give
- * the function a type containing transparent unions *)
- let _ =
- let rec fixbackFormals (idx: int) (args: varinfo list) : unit=
- match args with
- [] -> ()
- | a :: args' ->
- (* Fix the type back to a transparent union type *)
- (try
- let origtype = List.assq idx !transparentUnionArgs in
- a.vtype <- origtype;
- with Not_found -> ());
- fixbackFormals (idx + 1) args'
- in
- fixbackFormals 0 !currentFunctionFDEC.sformals;
- transparentUnionArgs := [];
- in
-
- (********** Now do the BODY *************)
- let _ =
- let stmts = doBody body in
- (* Finish everything *)
- exitScope ();
-
- (* Now fill in the computed goto statement with cases. Do this
- * before mkFunctionbody which resolves the gotos *)
- (match !gotoTargetData with
- Some (switchv, switch) ->
- let switche, l =
- match switch.skind with
- Switch (switche, _, _, l) -> switche, l
- | _ -> E.s(bug "the computed goto statement not a switch")
- in
- (* Build a default chunk that segfaults *)
- let default =
- defaultChunk
- l
- (i2c (Set ((Mem (mkCast (integer 0) intPtrType),
- NoOffset),
- integer 0, l)))
- in
- let bodychunk = ref default in
- H.iter (fun lname laddr ->
- bodychunk :=
- caseRangeChunk
- [integer laddr] l
- (gotoChunk lname l @@ !bodychunk))
- gotoTargetHash;
- (* Now recreate the switch *)
- let newswitch = switchChunk switche !bodychunk l in
- (* We must still share the old switch statement since we
- * have already inserted the goto's *)
- let newswitchkind =
- match newswitch.stmts with
- [ s]
- when newswitch.postins == [] && newswitch.cases == []->
- s.skind
- | _ -> E.s (bug "Unexpected result from switchChunk")
- in
- switch.skind <- newswitchkind
-
- | None -> ());
- (* Now finish the body and store it *)
- !currentFunctionFDEC.sbody <- mkFunctionBody stmts;
- (* Reset the global parameters *)
- gotoTargetData := None;
- H.clear gotoTargetHash;
- gotoTargetNextAddr := 0;
- in
-
-
-
-(*
- ignore (E.log "endFunction %s at %t:@! sformals=%a@! slocals=%a@!"
- !currentFunctionFDEC.svar.vname d_thisloc
- (docList ~sep:(chr ',') (fun v -> text v.vname))
- !currentFunctionFDEC.sformals
- (docList ~sep:(chr ',') (fun v -> text v.vname))
- !currentFunctionFDEC.slocals);
-*)
-
- let rec dropFormals formals locals =
- match formals, locals with
- [], l -> l
- | f :: formals, l :: locals ->
- if f != l then
- E.s (bug "formal %s is not in locals (found instead %s)"
- f.vname l.vname);
- dropFormals formals locals
- | _ -> E.s (bug "Too few locals")
- in
- !currentFunctionFDEC.slocals
- <- dropFormals !currentFunctionFDEC.sformals
- (List.rev !currentFunctionFDEC.slocals);
- setMaxId !currentFunctionFDEC;
-
- (* Now go over the types of the formals and pull out the formals
- * with transparent union type. Replace them with some shadow
- * parameters and then add assignments *)
- let _ =
- let newformals, newbody =
- List.fold_right (* So that the formals come out in order *)
- (fun f (accform, accbody) ->
- match isTransparentUnion f.vtype with
- None -> (f :: accform, accbody)
- | Some fstfield ->
- (* A new shadow to be placed in the formals. Use
- * makeTempVar to update smaxid and all others. *)
- let shadow =
- makeTempVar !currentFunctionFDEC fstfield.ftype in
- (* Now take it out of the locals and replace it with
- * the current formal. It is not worth optimizing this
- * one. *)
- !currentFunctionFDEC.slocals <-
- f ::
- (List.filter (fun x -> x.vid <> shadow.vid)
- !currentFunctionFDEC.slocals);
- (shadow :: accform,
- mkStmt (Instr [Set ((Var f, Field(fstfield,
- NoOffset)),
- Lval (var shadow),
- !currentLoc)]) :: accbody))
- !currentFunctionFDEC.sformals
- ([], !currentFunctionFDEC.sbody.bstmts)
- in
- !currentFunctionFDEC.sbody.bstmts <- newbody;
- (* To make sure sharing with the type is proper *)
- setFormals !currentFunctionFDEC newformals;
- in
-
- (* Now see whether we can fall through to the end of the function
- * *)
- (* weimer: Sat Dec 8 17:30:47 2001 MSVC NT kernel headers include
- * functions like long convert(x) { __asm { mov eax, x \n cdq } }
- * That set a return value via an ASM statement. As a result, I
- * am changing this so a final ASM statement does not count as
- * "fall through" for the purposes of this warning. *)
- (* matth: But it's better to assume assembly will fall through,
- * since most such blocks do. It's probably better to print an
- * unnecessary warning than to break CIL's invariant that
- * return statements are inserted properly. *)
- let instrFallsThrough (i : instr) = match i with
- Set _ -> true
- | Call (None, Lval (Var e, NoOffset), _, _) ->
- (* See if this is exit, or if it has the noreturn attribute *)
- if e.vname = "exit" then false
- else if hasAttribute "noreturn" e.vattr then false
- else true
- | Call _ -> true
- | Asm _ -> true
- in
- let rec stmtFallsThrough (s: stmt) : bool =
- match s.skind with
- Instr(il) ->
- List.fold_left (fun acc elt ->
- acc && instrFallsThrough elt) true il
- | Return _ | Break _ | Continue _ -> false
- | Goto _ -> false
- | If (_, b1, b2, _) ->
- blockFallsThrough b1 || blockFallsThrough b2
- | Switch (e, b, targets, _) ->
- (* See if there is a "default" case *)
- if not
- (List.exists (fun s ->
- List.exists (function Default _ -> true | _ -> false)
- s.labels)
- targets) then begin
-(*
- ignore (E.log "Switch falls through because no default");
-
-*) true (* We fall through because there is no default *)
- end else begin
- (* We must examine all cases. If any falls through,
- * then the switch falls through. *)
- blockFallsThrough b || blockCanBreak b
- end
-(*
- | Loop (b, _, _, _) ->
- (* A loop falls through if it can break. *)
- blockCanBreak b
-*)
- | While (_, b, _) -> blockCanBreak b
- | DoWhile (_, b, _) -> blockCanBreak b
- | For (_, _, _, b, _) -> blockCanBreak b
- | Block b -> blockFallsThrough b
- | TryFinally (b, h, _) -> blockFallsThrough h
- | TryExcept (b, _, h, _) -> true (* Conservative *)
- and blockFallsThrough b =
- let rec fall = function
- [] -> true
- | s :: rest ->
- if stmtFallsThrough s then begin
-(*
- ignore (E.log "Stmt %a falls through\n" d_stmt s);
-*)
- fall rest
- end else begin
-(*
- ignore (E.log "Stmt %a DOES NOT fall through\n"
- d_stmt s);
-*)
- (* If we are not falling thorough then maybe there
- * are labels who are *)
- labels rest
- end
- and labels = function
- [] -> false
- (* We have a label, perhaps we can jump here *)
- | s :: rest when s.labels <> [] ->
-(*
- ignore (E.log "invoking fall %a: %a\n"
- d_loc !currentLoc d_stmt s);
-*)
- fall (s :: rest)
- | _ :: rest -> labels rest
- in
- let res = fall b.bstmts in
-(*
- ignore (E.log "blockFallsThrough=%b %a\n" res d_block b);
-*)
- res
- (* will we leave this statement or block with a break command? *)
- and stmtCanBreak (s: stmt) : bool =
- match s.skind with
- Instr _ | Return _ | Continue _ | Goto _ -> false
- | Break _ -> true
- | If (_, b1, b2, _) ->
- blockCanBreak b1 || blockCanBreak b2
- | Switch _ | (*Loop _*) While _ | DoWhile _ | For _ ->
- (* switches and loops catch any breaks in their bodies *)
- false
- | Block b -> blockCanBreak b
- | TryFinally (b, h, _) -> blockCanBreak b || blockCanBreak h
- | TryExcept (b, _, h, _) -> blockCanBreak b || blockCanBreak h
- and blockCanBreak b =
- List.exists stmtCanBreak b.bstmts
- in
- if blockFallsThrough !currentFunctionFDEC.sbody then begin
-(*
- let retval =
- match unrollType !currentReturnType with
- TVoid _ -> None
- | (TInt _ | TEnum _ | TFloat _ | TPtr _) as rt ->
- ignore (warn "Body of function %s falls-through. Adding a return statement\n" !currentFunctionFDEC.svar.vname);
- Some (mkCastT zero intType rt)
- | _ ->
- ignore (warn "Body of function %s falls-through and cannot find an appropriate return value\n" !currentFunctionFDEC.svar.vname);
- None
- in
- if not (hasAttribute "noreturn"
- !currentFunctionFDEC.svar.vattr) then
- !currentFunctionFDEC.sbody.bstmts <-
- !currentFunctionFDEC.sbody.bstmts
- @ [mkStmt (Return(retval, endloc))]
-*)
- end;
-
- (* ignore (E.log "The env after finishing the body of %s:\n%t\n"
- n docEnv); *)
- cabsPushGlobal (GFun (!currentFunctionFDEC, funloc));
- empty
- with E.Error as e -> raise e
- | e -> begin
- ignore (E.log "error in collectFunction %s: %s\n"
- n (Printexc.to_string e));
- cabsPushGlobal (GAsm("error in function " ^ n, !currentLoc));
- empty
- end)
- () (* argument of E.withContext *)
- end (* FUNDEF *)
-
- | LINKAGE (n, loc, dl) ->
- currentLoc := convLoc loc;
- if n <> "C" then
- ignore (warn "Encountered linkage specification \"%s\"" n);
- if not isglobal then
- E.s (error "Encountered linkage specification in local scope");
- (* For now drop the linkage on the floor !!! *)
- List.iter
- (fun d ->
- let s = doDecl isglobal d in
- if isNotEmpty s then
- E.s (bug "doDecl returns non-empty statement for global"))
- dl;
- empty
-
- | _ -> E.s (error "unexpected form of declaration")
-
-and doTypedef ((specs, nl): A.name_group) =
- try
- (* Do the specifiers exactly once *)
- let bt, sto, inl, attrs = doSpecList (suggestAnonName nl) specs in
- if sto <> NoStorage || inl then
- E.s (error "Storage or inline specifier not allowed in typedef");
- let createTypedef ((n,ndt,a,loc) : A.name) =
- (* E.s (error "doTypeDef") *)
- try
- let newTyp, tattr =
- doType AttrType bt (A.PARENTYPE(attrs, ndt, a)) in
- let newTyp' = cabsTypeAddAttributes tattr newTyp in
- (* Create a new name for the type. Use the same name space as that of
- * variables to avoid confusion between variable names and types. This
- * is actually necessary in some cases. *)
- let n', _ = newAlphaName true "" n in
- let ti = { tname = n'; ttype = newTyp'; treferenced = false } in
- (* Since we use the same name space, we might later hit a global with
- * the same name and we would want to change the name of the global.
- * It is better to change the name of the type instead. So, remember
- * all types whose names have changed *)
- H.add typedefs n' ti;
- let namedTyp = TNamed(ti, []) in
- (* Register the type. register it as local because we might be in a
- * local context *)
- addLocalToEnv (kindPlusName "type" n) (EnvTyp namedTyp);
- cabsPushGlobal (GType (ti, !currentLoc))
- with E.Error as e -> raise e
- | e -> begin
- ignore (E.log "Error on A.TYPEDEF (%s)\n"
- (Printexc.to_string e));
- cabsPushGlobal (GAsm ("booo_typedef:" ^ n, !currentLoc))
- end
- in
- List.iter createTypedef nl
- with E.Error as e -> raise e
- | e -> begin
- ignore (E.log "Error on A.TYPEDEF (%s)\n"
- (Printexc.to_string e));
- let fstname =
- match nl with
- [] -> "<missing name>"
- | (n, _, _, _) :: _ -> n
- in
- cabsPushGlobal (GAsm ("booo_typedef: " ^ fstname, !currentLoc))
- end
-
-and doOnlyTypedef (specs: A.spec_elem list) : unit =
- try
- let bt, sto, inl, attrs = doSpecList "" specs in
- if sto <> NoStorage || inl then
- E.s (error "Storage or inline specifier not allowed in typedef");
- let restyp, nattr = doType AttrType bt (A.PARENTYPE(attrs,
- A.JUSTBASE, [])) in
- if nattr <> [] then
- ignore (warn "Ignoring identifier attribute");
- (* doSpec will register the type. *)
- (* See if we are defining a composite or enumeration type, and in that
- * case move the attributes from the defined type into the composite type
- * *)
- let isadef =
- List.exists
- (function
- A.SpecType(A.Tstruct(_, Some _, _)) -> true
- | A.SpecType(A.Tunion(_, Some _, _)) -> true
- | A.SpecType(A.Tenum(_, Some _, _)) -> true
- | _ -> false) specs
- in
- match restyp with
- TComp(ci, al) ->
- if isadef then begin
- ci.cattr <- cabsAddAttributes ci.cattr al;
- (* The GCompTag was already added *)
- end else (* Add a GCompTagDecl *)
- cabsPushGlobal (GCompTagDecl(ci, !currentLoc))
- | TEnum(ei, al) ->
- if isadef then begin
- ei.eattr <- cabsAddAttributes ei.eattr al;
- end else
- cabsPushGlobal (GEnumTagDecl(ei, !currentLoc))
- | _ ->
- ignore (warn "Ignoring un-named typedef that does not introduce a struct or enumeration type\n")
-
- with E.Error as e -> raise e
- | e -> begin
- ignore (E.log "Error on A.ONLYTYPEDEF (%s)\n"
- (Printexc.to_string e));
- cabsPushGlobal (GAsm ("booo_typedef", !currentLoc))
- end
-
-and assignInit (lv: lval)
- (ie: init)
- (iet: typ)
- (acc: chunk) : chunk =
- match ie with
- SingleInit e ->
- let (_, e'') = castTo iet (typeOfLval lv) e in
- acc +++ (Set(lv, e'', !currentLoc))
- | CompoundInit (t, initl) ->
- foldLeftCompound
- ~doinit:(fun off i it acc ->
- assignInit (addOffsetLval off lv) i it acc)
- ~ct:t
- ~initl:initl
- ~acc:acc
-(*
- | ArrayInit (bt, len, initl) ->
- let idx = ref ( -1 ) in
- List.fold_left
- (fun acc i ->
- assignInit (addOffsetLval (Index(integer !idx, NoOffset)) lv) i bt acc)
- acc
- initl
-*)
- (* Now define the processors for body and statement *)
-and doBody (blk: A.block) : chunk =
- enterScope ();
- (* Rename the labels and add them to the environment *)
- List.iter (fun l -> ignore (genNewLocalLabel l)) blk.blabels;
- (* See if we have some attributes *)
- let battrs = doAttributes blk.A.battrs in
-
- let bodychunk =
- afterConversion
- (List.fold_left (* !!! @ evaluates its arguments backwards *)
- (fun prev s -> let res = doStatement s in
- prev @@ res)
- empty
- blk.A.bstmts)
- in
- exitScope ();
-
-
- if battrs == [] then
- bodychunk
- else begin
- let b = c2block bodychunk in
- b.battrs <- battrs;
- s2c (mkStmt (Block b))
- end
-
-and doStatement (s : A.statement) : chunk =
- try
- match s with
- A.NOP _ -> skipChunk
- | A.COMPUTATION (e, loc) ->
- currentLoc := convLoc loc;
- let (lasts, data) = !gnu_body_result in
- if lasts == s then begin (* This is the last in a GNU_BODY *)
- let (s', e', t') = doExp false e (AExp None) in
- data := Some (e', t'); (* Record the result *)
- s'
- end else
- let (s', _, _) = doExp false e ADrop in
- (* drop the side-effect free expression *)
- (* And now do some peep-hole optimizations *)
- s'
-
- | A.BLOCK (b, loc) ->
- currentLoc := convLoc loc;
- doBody b
-
- | A.SEQUENCE (s1, s2, loc) ->
- (doStatement s1) @@ (doStatement s2)
-
- | A.IF(e,st,sf,loc) ->
- let st' = doStatement st in
- let sf' = doStatement sf in
- currentLoc := convLoc loc;
- doCondition false e st' sf'
-
- | A.WHILE(e,s,loc) ->
-(*
- startLoop true;
- let s' = doStatement s in
- exitLoop ();
- let loc' = convLoc loc in
- currentLoc := loc';
- loopChunk ((doCondition false e skipChunk
- (breakChunk loc'))
- @@ s')
-*)
- (** We need to convert A.WHILE(e,s) where e may have side effects
- into Cil.While(e',s') where e' is side-effect free. *)
-
- (* Let e == (sCond , eCond) with sCond a sequence of statements
- and eCond a side-effect free expression. *)
- let (sCond, eCond, _) = doExp false e (AExp None) in
-
- (* Then doStatement(A.WHILE((sCond , eCond), s))
- = sCond ; Cil.While(eCond, (doStatement(s) ; sCond))
- where doStatement(A.CONTINUE) = (sCond ; Cil.Continue). *)
-
- startLoop (DuplicateBeforeContinue sCond);
- let s' = doStatement s in
- exitLoop ();
- let loc' = convLoc loc in
- currentLoc := loc';
- sCond @@ (whileChunk eCond (s' @@ sCond))
-
- | A.DOWHILE(e,s,loc) ->
-(*
- startLoop false;
- let s' = doStatement s in
- let loc' = convLoc loc in
- currentLoc := loc';
- let s'' =
- consLabContinue (doCondition false e skipChunk (breakChunk loc'))
- in
- exitLoop ();
- loopChunk (s' @@ s'')
-*)
- (** We need to convert A.DOWHILE(e,s) where e may have side effects
- into Cil.DoWhile(e',s') where e' is side-effect free. *)
-
- (* Let e == (sCond , eCond) with sCond a sequence of statements
- and eCond a side-effect free expression. *)
- let (sCond, eCond, _) = doExp false e (AExp None) in
-
- (* Then doStatement(A.DOWHILE((sCond , eCond), s))
- = Cil.DoWhile(eCond, (doStatement(s) ; sCond))
- where doStatement(A.CONTINUE) = (sCond ; Cil.Continue). *)
-
- startLoop (DuplicateBeforeContinue sCond);
- let s' = doStatement s in
- exitLoop ();
- let loc' = convLoc loc in
- currentLoc := loc';
- doWhileChunk eCond (s' @@ sCond)
-
- | A.FOR(fc1,e2,e3,s,loc) ->
-(*begin
- let loc' = convLoc loc in
- currentLoc := loc';
- enterScope (); (* Just in case we have a declaration *)
- let (se1, _, _) =
- match fc1 with
- FC_EXP e1 -> doExp false e1 ADrop
- | FC_DECL d1 -> (doDecl false d1, zero, voidType)
- in
- let (se3, _, _) = doExp false e3 ADrop in
- startLoop false;
- let s' = doStatement s in
- currentLoc := loc';
- let s'' = consLabContinue se3 in
- exitLoop ();
- let res =
- match e2 with
- A.NOTHING -> (* This means true *)
- se1 @@ loopChunk (s' @@ s'')
- | _ ->
- se1 @@ loopChunk ((doCondition false e2 skipChunk (breakChunk loc'))
- @@ s' @@ s'')
- in
- exitScope ();
- res
- end
-*)
- (** We need to convert A.FOR(e1,e2,e3,s) where e1, e2 and e3 may
- have side effects into Cil.For(bInit,e2',bIter,s') where e2'
- is side-effect free. **)
-
- (* Let e1 == bInit be a block of statements
- Let e2 == (bCond , eCond) with bCond a block of statements
- and eCond a side-effect free expression
- Let e3 == bIter be a sequence of statements. *)
- let (bInit, _, _) = match fc1 with
- | FC_EXP e1 -> doExp false e1 ADrop
- | FC_DECL d1 -> (doDecl false d1, zero, voidType) in
- let (bCond, eCond, _) = doExp false e2 (AExp None) in
- let eCond' = match eCond with
- | Const(CStr "exp_nothing") -> Cil.one
- | _ -> eCond in
- let (bIter, _, _) = doExp false e3 ADrop in
-
- (* Then doStatement(A.FOR(bInit, (bCond , eCond), bIter, s))
- = Cil.For({bInit; bCond}, eCond', {bIter; bCond}, {doStatement(s)})
- where doStatement(A.CONTINUE) = Cil.Continue. *)
-
- startLoop ContinueUnchanged;
- let s' = doStatement s in
- exitLoop ();
- let loc' = convLoc loc in
- currentLoc := loc';
- (forChunk (bInit @@ bCond) eCond' (bIter @@ bCond) s')
-
- | A.BREAK loc ->
- let loc' = convLoc loc in
- currentLoc := loc';
- breakChunk loc'
-
- | A.CONTINUE loc ->
- let loc' = convLoc loc in
- currentLoc := loc';
-(*
- continueOrLabelChunk loc'
-*)
- continueDuplicateChunk loc'
-
- | A.RETURN (A.NOTHING, loc) ->
- let loc' = convLoc loc in
- currentLoc := loc';
- if not (isVoidType !currentReturnType) then
- ignore (warn "Return statement without a value in function returning %a\n" d_type !currentReturnType);
- returnChunk None loc'
-
- | A.RETURN (e, loc) ->
- let loc' = convLoc loc in
- currentLoc := loc';
- (* Sometimes we return the result of a void function call *)
- if isVoidType !currentReturnType then begin
- ignore (warn "Return statement with a value in function returning void");
- let (se, _, _) = doExp false e ADrop in
- se @@ returnChunk None loc'
- end else begin
- let (se, e', et) =
- doExp false e (AExp (Some !currentReturnType)) in
- let (et'', e'') = castTo et (!currentReturnType) e' in
- se @@ (returnChunk (Some e'') loc')
- end
-
- | A.SWITCH (e, s, loc) ->
- let loc' = convLoc loc in
- currentLoc := loc';
- let (se, e', et) = doExp false e (AExp (Some intType)) in
- let (et'', e'') = castTo et intType e' in
- let s' = doStatement s in
- se @@ (switchChunk e'' s' loc')
-
- | A.CASE (e, s, loc) ->
- let loc' = convLoc loc in
- currentLoc := loc';
- let (se, e', et) = doExp true e (AExp None) in
- if isNotEmpty se then
- E.s (error "Case statement with a non-constant");
- caseRangeChunk [if !lowerConstants then constFold false e' else e']
- loc' (doStatement s)
-
- | A.CASERANGE (el, eh, s, loc) ->
- let loc' = convLoc loc in
- currentLoc := loc';
- let (sel, el', etl) = doExp false el (AExp None) in
- let (seh, eh', etl) = doExp false eh (AExp None) in
- if isNotEmpty sel || isNotEmpty seh then
- E.s (error "Case statement with a non-constant");
- let il, ih =
- match constFold true el', constFold true eh' with
- Const(CInt64(il, _, _)), Const(CInt64(ih, _, _)) ->
- Int64.to_int il, Int64.to_int ih
- | _ -> E.s (unimp "Cannot understand the constants in case range")
- in
- if il > ih then
- E.s (error "Empty case range");
- let rec mkAll (i: int) =
- if i > ih then [] else integer i :: mkAll (i + 1)
- in
- caseRangeChunk (mkAll il) loc' (doStatement s)
-
-
- | A.DEFAULT (s, loc) ->
- let loc' = convLoc loc in
- currentLoc := loc';
- defaultChunk loc' (doStatement s)
-
- | A.LABEL (l, s, loc) ->
- let loc' = convLoc loc in
- currentLoc := loc';
- (* Lookup the label because it might have been locally defined *)
- consLabel (lookupLabel l) (doStatement s) loc' true
-
- | A.GOTO (l, loc) ->
- let loc' = convLoc loc in
- currentLoc := loc';
- (* Maybe we need to rename this label *)
- gotoChunk (lookupLabel l) loc'
-
- | A.COMPGOTO (e, loc) -> begin
- let loc' = convLoc loc in
- currentLoc := loc';
- (* Do the expression *)
- let se, e', t' = doExp false e (AExp (Some voidPtrType)) in
- match !gotoTargetData with
- Some (switchv, switch) -> (* We have already generated this one *)
- se
- @@ i2c(Set (var switchv, mkCast e' uintType, loc'))
- @@ s2c(mkStmt(Goto (ref switch, loc')))
-
- | None -> begin
- (* Make a temporary variable *)
- let vchunk = createLocal
- (TInt(IUInt, []), NoStorage, false, [])
- (("__compgoto", A.JUSTBASE, [], loc), A.NO_INIT)
- in
- if not (isEmpty vchunk) then
- E.s (unimp "Non-empty chunk in creating temporary for goto *");
- let switchv, _ =
- try lookupVar "__compgoto"
- with Not_found -> E.s (bug "Cannot find temporary for goto *");
- in
- (* Make a switch statement. We'll fill in the statements at the
- * end of the function *)
- let switch = mkStmt (Switch (Lval(var switchv),
- mkBlock [], [], loc')) in
- (* And make a label for it since we'll goto it *)
- switch.labels <- [Label ("__docompgoto", loc', false)];
- gotoTargetData := Some (switchv, switch);
- se @@ i2c (Set(var switchv, mkCast e' uintType, loc')) @@
- s2c switch
- end
- end
-
- | A.DEFINITION d ->
- let s = doDecl false d in
-(*
- ignore (E.log "Def at %a: %a\n" d_loc !currentLoc d_chunk s);
-*)
- s
-
-
-
- | A.ASM (asmattr, tmpls, details, loc) ->
- (* Make sure all the outs are variables *)
- let loc' = convLoc loc in
- let attr' = doAttributes asmattr in
- currentLoc := loc';
- let stmts : chunk ref = ref empty in
- let (tmpls', outs', ins', clobs') =
- match details with
- | None ->
- let tmpls' =
- if !msvcMode then
- tmpls
- else
- let pattern = Str.regexp "%" in
- let escape = Str.global_replace pattern "%%" in
- List.map escape tmpls
- in
- (tmpls', [], [], [])
- | Some { aoutputs = outs; ainputs = ins; aclobbers = clobs } ->
- let outs' =
- List.map
- (fun (c, e) ->
- let (se, e', t) = doExp false e (AExp None) in
- let lv =
- match e' with
- | Lval lval
- | StartOf lval -> lval
- | _ -> E.s (error "Expected lval for ASM outputs")
- in
- stmts := !stmts @@ se;
- (c, lv)) outs
- in
- (* Get the side-effects out of expressions *)
- let ins' =
- List.map
- (fun (c, e) ->
- let (se, e', et) = doExp false e (AExp None) in
- stmts := !stmts @@ se;
- (c, e'))
- ins
- in
- (tmpls, outs', ins', clobs)
- in
- !stmts @@
- (i2c (Asm(attr', tmpls', outs', ins', clobs', loc')))
-
- | TRY_FINALLY (b, h, loc) ->
- let loc' = convLoc loc in
- currentLoc := loc';
- let b': chunk = doBody b in
- let h': chunk = doBody h in
- if b'.cases <> [] || h'.cases <> [] then
- E.s (error "Try statements cannot contain switch cases");
-
- s2c (mkStmt (TryFinally (c2block b', c2block h', loc')))
-
- | TRY_EXCEPT (b, e, h, loc) ->
- let loc' = convLoc loc in
- currentLoc := loc';
- let b': chunk = doBody b in
- (* Now do e *)
- let ((se: chunk), e', t') = doExp false e (AExp None) in
- let h': chunk = doBody h in
- if b'.cases <> [] || h'.cases <> [] || se.cases <> [] then
- E.s (error "Try statements cannot contain switch cases");
- (* Now take se and try to convert it to a list of instructions. This
- * might not be always possible *)
- let il' =
- match compactStmts se.stmts with
- [] -> se.postins
- | [ s ] -> begin
- match s.skind with
- Instr il -> il @ se.postins
- | _ -> E.s (error "Except expression contains unexpected statement")
- end
- | _ -> E.s (error "Except expression contains too many statements")
- in
- s2c (mkStmt (TryExcept (c2block b', (il', e'), c2block h', loc')))
-
- with e -> begin
- (ignore (E.log "Error in doStatement (%s)\n" (Printexc.to_string e)));
- consLabel "booo_statement" empty (convLoc (A.get_statementloc s)) false
- end
-
-
-(* Translate a file *)
-let convFile ((fname : string), (dl : Cabs.definition list)) : Cil.file =
- Cil.initCIL (); (* make sure we have initialized CIL *)
- (* Clean up the global types *)
- E.hadErrors := false;
- initGlobals();
- startFile ();
- IH.clear noProtoFunctions;
- H.clear compInfoNameEnv;
- H.clear enumInfoNameEnv;
- IH.clear mustTurnIntoDef;
- H.clear alreadyDefined;
- H.clear staticLocals;
- H.clear typedefs;
- H.clear isomorphicStructs;
- annonCompFieldNameId := 0;
- if !E.verboseFlag || !Cilutil.printStages then
- ignore (E.log "Converting CABS->CIL\n");
- (* Setup the built-ins, but do not add their prototypes to the file *)
- let setupBuiltin name (resTyp, argTypes, isva) =
- let v =
- makeGlobalVar name (TFun(resTyp,
- Some (List.map (fun at -> ("", at, []))
- argTypes),
- isva, [])) in
- ignore (alphaConvertVarAndAddToEnv true v)
- in
- H.iter setupBuiltin (if !msvcMode then msvcBuiltins else gccBuiltins);
-
- let globalidx = ref 0 in
- let doOneGlobal (d: A.definition) =
- let s = doDecl true d in
- if isNotEmpty s then
- E.s (bug "doDecl returns non-empty statement for global");
- (* See if this is one of the globals which we can leave alone. Increment
- * globalidx and see if we must leave this alone. *)
- if
- (match d with
- A.DECDEF _ -> true
- | A.FUNDEF _ -> true
- | _ -> false) && (incr globalidx; !globalidx = !nocil) then begin
- (* Create a file where we put the CABS output *)
- let temp_cabs_name = "__temp_cabs" in
- let temp_cabs = open_out temp_cabs_name in
- (* Now print the CABS in there *)
- Cprint.commit (); Cprint.flush ();
- let old = !Cprint.out in (* Save the old output channel *)
- Cprint.out := temp_cabs;
- Cprint.print_def d;
- Cprint.commit (); Cprint.flush ();
- flush !Cprint.out;
- Cprint.out := old;
- close_out temp_cabs;
- (* Now read everythign in *and create a GText from it *)
- let temp_cabs = open_in temp_cabs_name in
- let buff = Buffer.create 1024 in
- Buffer.add_string buff "// Start of CABS form\n";
- Buffer.add_channel buff temp_cabs (in_channel_length temp_cabs);
- Buffer.add_string buff "// End of CABS form\n";
- close_in temp_cabs;
- (* Try to pop the last thing in the file *)
- (match !theFile with
- _ :: rest -> theFile := rest
- | _ -> ());
- (* Insert in the file a GText *)
- cabsPushGlobal (GText(Buffer.contents buff))
- end
- in
- List.iter doOneGlobal dl;
- let globals = ref (popGlobals ()) in
-
- IH.clear noProtoFunctions;
- IH.clear mustTurnIntoDef;
- H.clear alreadyDefined;
- H.clear compInfoNameEnv;
- H.clear enumInfoNameEnv;
- H.clear isomorphicStructs;
- H.clear staticLocals;
- H.clear typedefs;
- H.clear env;
- H.clear genv;
- IH.clear callTempVars;
-
- if false then ignore (E.log "Cabs2cil converted %d globals\n" !globalidx);
- (* We are done *)
- { fileName = fname;
- globals = !globals;
- globinit = None;
- globinitcalled = false;
- }
-
-
-
-
diff --git a/cil/src/frontc/cabs2cil.mli b/cil/src/frontc/cabs2cil.mli
deleted file mode 100644
index 986f5a287948ee535602cde48a016a32c5e55896..0000000000000000000000000000000000000000
--- a/cil/src/frontc/cabs2cil.mli
+++ /dev/null
@@ -1,49 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-val convFile: Cabs.file -> Cil.file
-
-(** NDC added command line parameter **)
-(* Turn on tranformation that forces correct parameter evaluation order *)
-val forceRLArgEval: bool ref
-
-(* Set this integer to the index of the global to be left in CABS form. Use
- * -1 to disable *)
-val nocil: int ref
-
-(* Indicates whether we're allowed to duplicate small chunks of code. *)
-val allowDuplication: bool ref
diff --git a/cil/src/frontc/cabsvisit.ml b/cil/src/frontc/cabsvisit.ml
deleted file mode 100644
index b2f9784a9ec6d90d87260f4fdb1c25a918f034a7..0000000000000000000000000000000000000000
--- a/cil/src/frontc/cabsvisit.ml
+++ /dev/null
@@ -1,577 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* cabsvisit.ml *)
-(* tree visitor and rewriter for cabs *)
-
-open Cabs
-open Trace
-open Pretty
-module E = Errormsg
-
-(* basic interface for a visitor object *)
-
-(* Different visiting actions. 'a will be instantiated with exp, instr, etc. *)
-type 'a visitAction =
- SkipChildren (* Do not visit the children. Return
- * the node as it is *)
- | ChangeTo of 'a (* Replace the expression with the
- * given one *)
- | DoChildren (* Continue with the children of this
- * node. Rebuild the node on return
- * if any of the children changes
- * (use == test) *)
- | ChangeDoChildrenPost of 'a * ('a -> 'a) (* First consider that the entire
- * exp is replaced by the first
- * paramenter. Then continue with
- * the children. On return rebuild
- * the node if any of the children
- * has changed and then apply the
- * function on the node *)
-
-type nameKind =
- NVar (* Variable or function prototype
- name *)
- | NFun (* A function definition name *)
- | NField (* The name of a field *)
- | NType (* The name of a type *)
-
-(* All visit methods are called in preorder! (but you can use
- * ChangeDoChildrenPost to change the order) *)
-class type cabsVisitor = object
- method vexpr: expression -> expression visitAction (* expressions *)
- method vinitexpr: init_expression -> init_expression visitAction
- method vstmt: statement -> statement list visitAction
- method vblock: block -> block visitAction
- method vvar: string -> string (* use of a variable
- * names *)
- method vdef: definition -> definition list visitAction
- method vtypespec: typeSpecifier -> typeSpecifier visitAction
- method vdecltype: decl_type -> decl_type visitAction
-
- (* For each declaration we call vname *)
- method vname: nameKind -> specifier -> name -> name visitAction
- method vspec: specifier -> specifier visitAction (* specifier *)
- method vattr: attribute -> attribute list visitAction
-
- method vEnterScope: unit -> unit
- method vExitScope: unit -> unit
-end
-
-let visitorLocation = ref { filename = "";
- lineno = -1;
- byteno = -1;}
-
- (* a default visitor which does nothing to the tree *)
-class nopCabsVisitor : cabsVisitor = object
- method vexpr (e:expression) = DoChildren
- method vinitexpr (e:init_expression) = DoChildren
- method vstmt (s: statement) =
- visitorLocation := get_statementloc s;
- DoChildren
- method vblock (b: block) = DoChildren
- method vvar (s: string) = s
- method vdef (d: definition) =
- visitorLocation := get_definitionloc d;
- DoChildren
- method vtypespec (ts: typeSpecifier) = DoChildren
- method vdecltype (dt: decl_type) = DoChildren
- method vname k (s:specifier) (n: name) = DoChildren
- method vspec (s:specifier) = DoChildren
- method vattr (a: attribute) = DoChildren
-
- method vEnterScope () = ()
- method vExitScope () = ()
-end
-
- (* Map but try not to copy the list unless necessary *)
-let rec mapNoCopy (f: 'a -> 'a) = function
- [] -> []
- | (i :: resti) as li ->
- let i' = f i in
- let resti' = mapNoCopy f resti in
- if i' != i || resti' != resti then i' :: resti' else li
-
-let rec mapNoCopyList (f: 'a -> 'a list) = function
- [] -> []
- | (i :: resti) as li ->
- let il' = f i in
- let resti' = mapNoCopyList f resti in
- match il' with
- [i'] when i' == i && resti' == resti -> li
- | _ -> il' @ resti'
-
-let doVisit (vis: cabsVisitor)
- (startvisit: 'a -> 'a visitAction)
- (children: cabsVisitor -> 'a -> 'a)
- (node: 'a) : 'a =
- let action = startvisit node in
- match action with
- SkipChildren -> node
- | ChangeTo node' -> node'
- | _ ->
- let nodepre = match action with
- ChangeDoChildrenPost (node', _) -> node'
- | _ -> node
- in
- let nodepost = children vis nodepre in
- match action with
- ChangeDoChildrenPost (_, f) -> f nodepost
- | _ -> nodepost
-
-(* A visitor for lists *)
-let doVisitList (vis: cabsVisitor)
- (startvisit: 'a -> 'a list visitAction)
- (children: cabsVisitor -> 'a -> 'a)
- (node: 'a) : 'a list =
- let action = startvisit node in
- match action with
- SkipChildren -> [node]
- | ChangeTo nodes' -> nodes'
- | _ ->
- let nodespre = match action with
- ChangeDoChildrenPost (nodespre, _) -> nodespre
- | _ -> [node]
- in
- let nodespost = mapNoCopy (children vis) nodespre in
- match action with
- ChangeDoChildrenPost (_, f) -> f nodespost
- | _ -> nodespost
-
-
-let rec visitCabsTypeSpecifier (vis: cabsVisitor) (ts: typeSpecifier) =
- doVisit vis vis#vtypespec childrenTypeSpecifier ts
-
-and childrenTypeSpecifier vis ts =
- let childrenFieldGroup ((s, nel) as input) =
- let s' = visitCabsSpecifier vis s in
- let doOneField ((n, eo) as input) =
- let n' = visitCabsName vis NField s' n in
- let eo' =
- match eo with
- None -> None
- | Some e -> let e' = visitCabsExpression vis e in
- if e' != e then Some e' else eo
- in
- if n' != n || eo' != eo then (n', eo') else input
- in
- let nel' = mapNoCopy doOneField nel in
- if s' != s || nel' != nel then (s', nel') else input
- in
- match ts with
- Tstruct (n, Some fg, extraAttrs) ->
- (*(trace "sm" (dprintf "visiting struct %s\n" n));*)
- let fg' = mapNoCopy childrenFieldGroup fg in
- if fg' != fg then Tstruct( n, Some fg', extraAttrs) else ts
- | Tunion (n, Some fg, extraAttrs) ->
- let fg' = mapNoCopy childrenFieldGroup fg in
- if fg' != fg then Tunion( n, Some fg', extraAttrs) else ts
- | Tenum (n, Some ei, extraAttrs) ->
- let doOneEnumItem ((s, e, loc) as ei) =
- let e' = visitCabsExpression vis e in
- if e' != e then (s, e', loc) else ei
- in
- vis#vEnterScope ();
- let ei' = mapNoCopy doOneEnumItem ei in
- vis#vExitScope();
- if ei' != ei then Tenum( n, Some ei', extraAttrs) else ts
- | TtypeofE e ->
- let e' = visitCabsExpression vis e in
- if e' != e then TtypeofE e' else ts
- | TtypeofT (s, dt) ->
- let s' = visitCabsSpecifier vis s in
- let dt' = visitCabsDeclType vis false dt in
- if s != s' || dt != dt' then TtypeofT (s', dt') else ts
- | ts -> ts
-
-and childrenSpecElem (vis: cabsVisitor) (se: spec_elem) : spec_elem =
- match se with
- SpecTypedef | SpecInline | SpecStorage _ | SpecPattern _ -> se
- | SpecCV _ -> se (* cop out *)
- | SpecAttr a -> begin
- let al' = visitCabsAttribute vis a in
- match al' with
- [a''] when a'' == a -> se
- | [a''] -> SpecAttr a''
- | _ -> E.s (E.unimp "childrenSpecElem: visitCabsAttribute returned a list")
- end
- | SpecType ts ->
- let ts' = visitCabsTypeSpecifier vis ts in
- if ts' != ts then SpecType ts' else se
-
-and visitCabsSpecifier (vis: cabsVisitor) (s: specifier) : specifier =
- doVisit vis vis#vspec childrenSpec s
-and childrenSpec vis s = mapNoCopy (childrenSpecElem vis) s
-
-
-and visitCabsDeclType vis (isfundef: bool) (dt: decl_type) : decl_type =
- doVisit vis vis#vdecltype (childrenDeclType isfundef) dt
-and childrenDeclType isfundef vis dt =
- match dt with
- JUSTBASE -> dt
- | PARENTYPE (prea, dt1, posta) ->
- let prea' = mapNoCopyList (visitCabsAttribute vis) prea in
- let dt1' = visitCabsDeclType vis isfundef dt1 in
- let posta'= mapNoCopyList (visitCabsAttribute vis) posta in
- if prea' != prea || dt1' != dt1 || posta' != posta then
- PARENTYPE (prea', dt1', posta') else dt
- | ARRAY (dt1, al, e) ->
- let dt1' = visitCabsDeclType vis isfundef dt1 in
- let al' = mapNoCopy (childrenAttribute vis) al in
- let e'= visitCabsExpression vis e in
- if dt1' != dt1 || al' != al || e' != e then ARRAY(dt1', al', e') else dt
- | PTR (al, dt1) ->
- let al' = mapNoCopy (childrenAttribute vis) al in
- let dt1' = visitCabsDeclType vis isfundef dt1 in
- if al' != al || dt1' != dt1 then PTR(al', dt1') else dt
- | PROTO (dt1, snl, b) ->
- (* Do not propagate isfundef further *)
- let dt1' = visitCabsDeclType vis false dt1 in
- let _ = vis#vEnterScope () in
- let snl' = mapNoCopy (childrenSingleName vis NVar) snl in
- (* Exit the scope only if not in a function definition *)
- let _ = if not isfundef then vis#vExitScope () in
- if dt1' != dt1 || snl' != snl then PROTO(dt1', snl', b) else dt
-
-
-and childrenNameGroup vis (kind: nameKind) ((s, nl) as input) =
- let s' = visitCabsSpecifier vis s in
- let nl' = mapNoCopy (visitCabsName vis kind s') nl in
- if s' != s || nl' != nl then (s', nl') else input
-
-
-and childrenInitNameGroup vis ((s, inl) as input) =
- let s' = visitCabsSpecifier vis s in
- let inl' = mapNoCopy (childrenInitName vis s') inl in
- if s' != s || inl' != inl then (s', inl') else input
-
-and visitCabsName vis (k: nameKind) (s: specifier)
- (n: name) : name =
- doVisit vis (vis#vname k s) (childrenName s k) n
-and childrenName (s: specifier) (k: nameKind) vis (n: name) : name =
- let (sn, dt, al, loc) = n in
- let dt' = visitCabsDeclType vis (k = NFun) dt in
- let al' = mapNoCopy (childrenAttribute vis) al in
- if dt' != dt || al' != al then (sn, dt', al', loc) else n
-
-and childrenInitName vis (s: specifier) (inn: init_name) : init_name =
- let (n, ie) = inn in
- let n' = visitCabsName vis NVar s n in
- let ie' = visitCabsInitExpression vis ie in
- if n' != n || ie' != ie then (n', ie') else inn
-
-and childrenSingleName vis (k: nameKind) (sn: single_name) : single_name =
- let s, n = sn in
- let s' = visitCabsSpecifier vis s in
- let n' = visitCabsName vis k s' n in
- if s' != s || n' != n then (s', n') else sn
-
-and visitCabsDefinition vis (d: definition) : definition list =
- doVisitList vis vis#vdef childrenDefinition d
-and childrenDefinition vis d =
- match d with
- FUNDEF (sn, b, l, lend) ->
- let sn' = childrenSingleName vis NFun sn in
- let b' = visitCabsBlock vis b in
- (* End the scope that was started by childrenFunctionName *)
- vis#vExitScope ();
- if sn' != sn || b' != b then FUNDEF (sn', b', l, lend) else d
-
- | DECDEF ((s, inl), l) ->
- let s' = visitCabsSpecifier vis s in
- let inl' = mapNoCopy (childrenInitName vis s') inl in
- if s' != s || inl' != inl then DECDEF ((s', inl'), l) else d
- | TYPEDEF (ng, l) ->
- let ng' = childrenNameGroup vis NType ng in
- if ng' != ng then TYPEDEF (ng', l) else d
- | ONLYTYPEDEF (s, l) ->
- let s' = visitCabsSpecifier vis s in
- if s' != s then ONLYTYPEDEF (s', l) else d
- | GLOBASM _ -> d
- | PRAGMA (e, l) ->
- let e' = visitCabsExpression vis e in
- if e' != e then PRAGMA (e', l) else d
- | LINKAGE (n, l, dl) ->
- let dl' = mapNoCopyList (visitCabsDefinition vis) dl in
- if dl' != dl then LINKAGE (n, l, dl') else d
-
- | TRANSFORMER _ -> d
- | EXPRTRANSFORMER _ -> d
-
-and visitCabsBlock vis (b: block) : block =
- doVisit vis vis#vblock childrenBlock b
-
-and childrenBlock vis (b: block) : block =
- let _ = vis#vEnterScope () in
- let battrs' = mapNoCopyList (visitCabsAttribute vis) b.battrs in
- let bstmts' = mapNoCopyList (visitCabsStatement vis) b.bstmts in
- let _ = vis#vExitScope () in
- if battrs' != b.battrs || bstmts' != b.bstmts then
- { blabels = b.blabels; battrs = battrs'; bstmts = bstmts' }
- else
- b
-
-and visitCabsStatement vis (s: statement) : statement list =
- doVisitList vis vis#vstmt childrenStatement s
-and childrenStatement vis s =
- let ve e = visitCabsExpression vis e in
- let vs l s =
- match visitCabsStatement vis s with
- [s'] -> s'
- | sl -> BLOCK ({blabels = []; battrs = []; bstmts = sl }, l)
- in
- match s with
- NOP _ -> s
- | COMPUTATION (e, l) ->
- let e' = ve e in
- if e' != e then COMPUTATION (e', l) else s
- | BLOCK (b, l) ->
- let b' = visitCabsBlock vis b in
- if b' != b then BLOCK (b', l) else s
- | SEQUENCE (s1, s2, l) ->
- let s1' = vs l s1 in
- let s2' = vs l s2 in
- if s1' != s1 || s2' != s2 then SEQUENCE (s1', s2', l) else s
- | IF (e, s1, s2, l) ->
- let e' = ve e in
- let s1' = vs l s1 in
- let s2' = vs l s2 in
- if e' != e || s1' != s1 || s2' != s2 then IF (e', s1', s2', l) else s
- | WHILE (e, s1, l) ->
- let e' = ve e in
- let s1' = vs l s1 in
- if e' != e || s1' != s1 then WHILE (e', s1', l) else s
- | DOWHILE (e, s1, l) ->
- let e' = ve e in
- let s1' = vs l s1 in
- if e' != e || s1' != s1 then DOWHILE (e', s1', l) else s
- | FOR (fc1, e2, e3, s4, l) ->
- let _ = vis#vEnterScope () in
- let fc1' =
- match fc1 with
- FC_EXP e1 ->
- let e1' = ve e1 in
- if e1' != e1 then FC_EXP e1' else fc1
- | FC_DECL d1 ->
- let d1' =
- match visitCabsDefinition vis d1 with
- [d1'] -> d1'
- | _ -> E.s (E.unimp "visitCabs: for can have only one definition")
- in
- if d1' != d1 then FC_DECL d1' else fc1
- in
- let e2' = ve e2 in
- let e3' = ve e3 in
- let s4' = vs l s4 in
- let _ = vis#vExitScope () in
- if fc1' != fc1 || e2' != e2 || e3' != e3 || s4' != s4
- then FOR (fc1', e2', e3', s4', l) else s
- | BREAK _ | CONTINUE _ | GOTO _ -> s
- | RETURN (e, l) ->
- let e' = ve e in
- if e' != e then RETURN (e', l) else s
- | SWITCH (e, s1, l) ->
- let e' = ve e in
- let s1' = vs l s1 in
- if e' != e || s1' != s1 then SWITCH (e', s1', l) else s
- | CASE (e, s1, l) ->
- let e' = ve e in
- let s1' = vs l s1 in
- if e' != e || s1' != s1 then CASE (e', s1', l) else s
- | CASERANGE (e1, e2, s3, l) ->
- let e1' = ve e1 in
- let e2' = ve e2 in
- let s3' = vs l s3 in
- if e1' != e1 || e2' != e2 || s3' != s3 then
- CASERANGE (e1', e2', s3', l) else s
- | DEFAULT (s1, l) ->
- let s1' = vs l s1 in
- if s1' != s1 then DEFAULT (s1', l) else s
- | LABEL (n, s1, l) ->
- let s1' = vs l s1 in
- if s1' != s1 then LABEL (n, s1', l) else s
- | COMPGOTO (e, l) ->
- let e' = ve e in
- if e' != e then COMPGOTO (e', l) else s
- | DEFINITION d -> begin
- match visitCabsDefinition vis d with
- [d'] when d' == d -> s
- | [d'] -> DEFINITION d'
- | dl -> let l = get_definitionloc d in
- let dl' = List.map (fun d' -> DEFINITION d') dl in
- BLOCK ({blabels = []; battrs = []; bstmts = dl' }, l)
- end
- | ASM (sl, b, details, l) ->
- let childrenStringExp ((s, e) as input) =
- let e' = ve e in
- if e' != e then (s, e') else input
- in
- let details' = match details with
- | None -> details
- | Some { aoutputs = outl; ainputs = inl; aclobbers = clobs } ->
- let outl' = mapNoCopy childrenStringExp outl in
- let inl' = mapNoCopy childrenStringExp inl in
- if outl' == outl && inl' == inl then
- details
- else
- Some { aoutputs = outl'; ainputs = inl'; aclobbers = clobs }
- in
- if details' != details then
- ASM (sl, b, details', l) else s
- | TRY_FINALLY (b1, b2, l) ->
- let b1' = visitCabsBlock vis b1 in
- let b2' = visitCabsBlock vis b2 in
- if b1' != b1 || b2' != b2 then TRY_FINALLY(b1', b2', l) else s
- | TRY_EXCEPT (b1, e, b2, l) ->
- let b1' = visitCabsBlock vis b1 in
- let e' = visitCabsExpression vis e in
- let b2' = visitCabsBlock vis b2 in
- if b1' != b1 || e' != e || b2' != b2 then TRY_EXCEPT(b1', e', b2', l) else s
-
-
-and visitCabsExpression vis (e: expression) : expression =
- doVisit vis vis#vexpr childrenExpression e
-and childrenExpression vis e =
- let ve e = visitCabsExpression vis e in
- match e with
- NOTHING | LABELADDR _ -> e
- | UNARY (uo, e1) ->
- let e1' = ve e1 in
- if e1' != e1 then UNARY (uo, e1') else e
- | BINARY (bo, e1, e2) ->
- let e1' = ve e1 in
- let e2' = ve e2 in
- if e1' != e1 || e2' != e2 then BINARY (bo, e1', e2') else e
- | QUESTION (e1, e2, e3) ->
- let e1' = ve e1 in
- let e2' = ve e2 in
- let e3' = ve e3 in
- if e1' != e1 || e2' != e2 || e3' != e3 then
- QUESTION (e1', e2', e3') else e
- | CAST ((s, dt), ie) ->
- let s' = visitCabsSpecifier vis s in
- let dt' = visitCabsDeclType vis false dt in
- let ie' = visitCabsInitExpression vis ie in
- if s' != s || dt' != dt || ie' != ie then CAST ((s', dt'), ie') else e
- | CALL (f, el) ->
- let f' = ve f in
- let el' = mapNoCopy ve el in
- if f' != f || el' != el then CALL (f', el') else e
- | COMMA el ->
- let el' = mapNoCopy ve el in
- if el' != el then COMMA (el') else e
- | CONSTANT _ -> e
- | VARIABLE s ->
- let s' = vis#vvar s in
- if s' != s then VARIABLE s' else e
- | EXPR_SIZEOF (e1) ->
- let e1' = ve e1 in
- if e1' != e1 then EXPR_SIZEOF (e1') else e
- | TYPE_SIZEOF (s, dt) ->
- let s' = visitCabsSpecifier vis s in
- let dt' = visitCabsDeclType vis false dt in
- if s' != s || dt' != dt then TYPE_SIZEOF (s' ,dt') else e
- | EXPR_ALIGNOF (e1) ->
- let e1' = ve e1 in
- if e1' != e1 then EXPR_ALIGNOF (e1') else e
- | TYPE_ALIGNOF (s, dt) ->
- let s' = visitCabsSpecifier vis s in
- let dt' = visitCabsDeclType vis false dt in
- if s' != s || dt' != dt then TYPE_ALIGNOF (s' ,dt') else e
- | INDEX (e1, e2) ->
- let e1' = ve e1 in
- let e2' = ve e2 in
- if e1' != e1 || e2' != e2 then INDEX (e1', e2') else e
- | MEMBEROF (e1, n) ->
- let e1' = ve e1 in
- if e1' != e1 then MEMBEROF (e1', n) else e
- | MEMBEROFPTR (e1, n) ->
- let e1' = ve e1 in
- if e1' != e1 then MEMBEROFPTR (e1', n) else e
- | GNU_BODY b ->
- let b' = visitCabsBlock vis b in
- if b' != b then GNU_BODY b' else e
- | EXPR_PATTERN _ -> e
-
-and visitCabsInitExpression vis (ie: init_expression) : init_expression =
- doVisit vis vis#vinitexpr childrenInitExpression ie
-and childrenInitExpression vis ie =
- let rec childrenInitWhat iw =
- match iw with
- NEXT_INIT -> iw
- | INFIELD_INIT (n, iw1) ->
- let iw1' = childrenInitWhat iw1 in
- if iw1' != iw1 then INFIELD_INIT (n, iw1') else iw
- | ATINDEX_INIT (e, iw1) ->
- let e' = visitCabsExpression vis e in
- let iw1' = childrenInitWhat iw1 in
- if e' != e || iw1' != iw1 then ATINDEX_INIT (e', iw1') else iw
- | ATINDEXRANGE_INIT (e1, e2) ->
- let e1' = visitCabsExpression vis e1 in
- let e2' = visitCabsExpression vis e2 in
- if e1' != e1 || e2' != e2 then ATINDEXRANGE_INIT (e1, e2) else iw
- in
- match ie with
- NO_INIT -> ie
- | SINGLE_INIT e ->
- let e' = visitCabsExpression vis e in
- if e' != e then SINGLE_INIT e' else ie
- | COMPOUND_INIT il ->
- let childrenOne ((iw, ie) as input) =
- let iw' = childrenInitWhat iw in
- let ie' = visitCabsInitExpression vis ie in
- if iw' != iw || ie' != ie then (iw', ie') else input
- in
- let il' = mapNoCopy childrenOne il in
- if il' != il then COMPOUND_INIT il' else ie
-
-
-and visitCabsAttribute vis (a: attribute) : attribute list =
- doVisitList vis vis#vattr childrenAttribute a
-
-and childrenAttribute vis ((n, el) as input) =
- let el' = mapNoCopy (visitCabsExpression vis) el in
- if el' != el then (n, el') else input
-
-and visitCabsAttributes vis (al: attribute list) : attribute list =
- mapNoCopyList (visitCabsAttribute vis) al
-
-let visitCabsFile (vis: cabsVisitor) ((fname, f): file) : file =
- (fname, mapNoCopyList (visitCabsDefinition vis) f)
-
- (* end of file *)
-
diff --git a/cil/src/frontc/cabsvisit.mli b/cil/src/frontc/cabsvisit.mli
deleted file mode 100644
index d2387892b739e0faa327a6670a5c276f57b733b0..0000000000000000000000000000000000000000
--- a/cil/src/frontc/cabsvisit.mli
+++ /dev/null
@@ -1,115 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* cabsvisit.mli *)
-(* interface for cabsvisit.ml *)
-
-(* Different visiting actions. 'a will be instantiated with exp, instr, etc. *)
-type 'a visitAction =
- SkipChildren (* Do not visit the children. Return
- * the node as it is *)
- | ChangeTo of 'a (* Replace the expression with the
- * given one *)
- | DoChildren (* Continue with the children of this
- * node. Rebuild the node on return
- * if any of the children changes
- * (use == test) *)
- | ChangeDoChildrenPost of 'a * ('a -> 'a) (* First consider that the entire
- * exp is replaced by the first
- * paramenter. Then continue with
- * the children. On return rebuild
- * the node if any of the children
- * has changed and then apply the
- * function on the node *)
-
-type nameKind =
- NVar (** Variable or function prototype
- name *)
- | NFun (** Function definition name *)
- | NField (** The name of a field *)
- | NType (** The name of a type *)
-
-
-(* All visit methods are called in preorder! (but you can use
- * ChangeDoChildrenPost to change the order) *)
-class type cabsVisitor = object
- method vexpr: Cabs.expression -> Cabs.expression visitAction (* expressions *)
- method vinitexpr: Cabs.init_expression -> Cabs.init_expression visitAction
- method vstmt: Cabs.statement -> Cabs.statement list visitAction
- method vblock: Cabs.block -> Cabs.block visitAction
- method vvar: string -> string (* use of a variable
- * names *)
- method vdef: Cabs.definition -> Cabs.definition list visitAction
- method vtypespec: Cabs.typeSpecifier -> Cabs.typeSpecifier visitAction
- method vdecltype: Cabs.decl_type -> Cabs.decl_type visitAction
-
- (* For each declaration we call vname *)
- method vname: nameKind -> Cabs.specifier -> Cabs.name -> Cabs.name visitAction
- method vspec: Cabs.specifier -> Cabs.specifier visitAction (* specifier *)
- method vattr: Cabs.attribute -> Cabs.attribute list visitAction
-
-
- method vEnterScope: unit -> unit
- method vExitScope: unit -> unit
-end
-
-
-class nopCabsVisitor: cabsVisitor
-
-
-val visitCabsTypeSpecifier: cabsVisitor ->
- Cabs.typeSpecifier -> Cabs.typeSpecifier
-val visitCabsSpecifier: cabsVisitor -> Cabs.specifier -> Cabs.specifier
-
-(** Visits a decl_type. The bool argument is saying whether we are ina
- * function definition and thus the scope in a PROTO should extend until the
- * end of the function *)
-val visitCabsDeclType: cabsVisitor -> bool -> Cabs.decl_type -> Cabs.decl_type
-val visitCabsDefinition: cabsVisitor -> Cabs.definition -> Cabs.definition list
-val visitCabsBlock: cabsVisitor -> Cabs.block -> Cabs.block
-val visitCabsStatement: cabsVisitor -> Cabs.statement -> Cabs.statement list
-val visitCabsExpression: cabsVisitor -> Cabs.expression -> Cabs.expression
-val visitCabsAttributes: cabsVisitor -> Cabs.attribute list
- -> Cabs.attribute list
-val visitCabsName: cabsVisitor -> nameKind
- -> Cabs.specifier -> Cabs.name -> Cabs.name
-val visitCabsFile: cabsVisitor -> Cabs.file -> Cabs.file
-
-
-
-(** Set by the visitor to the current location *)
-val visitorLocation: Cabs.cabsloc ref
diff --git a/cil/src/frontc/clexer.mli b/cil/src/frontc/clexer.mli
deleted file mode 100644
index 01acfd0483c8968eb8fd4ef40a3ea6a8bcd0f035..0000000000000000000000000000000000000000
--- a/cil/src/frontc/clexer.mli
+++ /dev/null
@@ -1,55 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-
-(* This interface is generated manually. The corresponding .ml file is
- * generated automatically and is placed in ../obj/clexer.ml. The reason we
- * want this interface is to avoid confusing make with freshly generated
- * interface files *)
-
-
-val init: filename:string -> Lexing.lexbuf
-val finish: unit -> unit
-
-(* This is the main parser function *)
-val initial: Lexing.lexbuf -> Cparser.token
-
-
-val push_context: unit -> unit (* Start a context *)
-val add_type: string -> unit (* Add a new string as a type name *)
-val add_identifier: string -> unit (* Add a new string as a variable name *)
-val pop_context: unit -> unit (* Remove all names added in this context *)
diff --git a/cil/src/frontc/clexer.mll b/cil/src/frontc/clexer.mll
deleted file mode 100644
index 41c8692248a6be66ff39165d0e0841fea0e04413..0000000000000000000000000000000000000000
--- a/cil/src/frontc/clexer.mll
+++ /dev/null
@@ -1,666 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2003,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * Ben Liblit <liblit@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-(* FrontC -- lexical analyzer
-**
-** 1.0 3.22.99 Hugues Cassé First version.
-** 2.0 George Necula 12/12/00: Many extensions
-*)
-{
-open Cparser
-open Pretty
-exception Eof
-exception InternalError of string
-module E = Errormsg
-module H = Hashtbl
-
-let matchingParsOpen = ref 0
-
-let currentLoc () =
- let l, f, c = E.getPosition () in
- { Cabs.lineno = l;
- Cabs.filename = f;
- Cabs.byteno = c;}
-
-(* string -> unit *)
-let addComment c =
- let l = currentLoc() in
- let i = GrowArray.max_init_index Cabs.commentsGA in
- GrowArray.setg Cabs.commentsGA (i+1) (l,c,false)
-
-let int64_to_char value =
- if (compare value (Int64.of_int 255) > 0) || (compare value Int64.zero < 0) then
- begin
- let msg = Printf.sprintf "clexer:intlist_to_string: character 0x%Lx too big" value in
- E.parse_error msg;
- end
- else
- Char.chr (Int64.to_int value)
-
-(* takes a not-nul-terminated list, and converts it to a string. *)
-let rec intlist_to_string (str: int64 list):string =
- match str with
- [] -> "" (* add nul-termination *)
- | value::rest ->
- let this_char = int64_to_char value in
- (String.make 1 this_char) ^ (intlist_to_string rest)
-
-(* Some debugging support for line numbers *)
-let dbgToken (t: token) =
- if false then begin
- ignore (E.log "%a" insert
- (match t with
- IDENT (n, l) -> dprintf "IDENT(%s,%d)\n" n l.Cabs.lineno
- | LBRACE l -> dprintf "LBRACE(%d)\n" l.Cabs.lineno
- | RBRACE l -> dprintf "RBRACE(%d)\n" l.Cabs.lineno
- | IF l -> dprintf "IF(%d)\n" l.Cabs.lineno
- | SWITCH l -> dprintf "SWITCH(%d)\n" l.Cabs.lineno
- | RETURN l -> dprintf "RETURN(%d)\n" l.Cabs.lineno
- | _ -> nil));
- t
- end else
- t
-
-
-(*
-** Keyword hashtable
-*)
-let lexicon = H.create 211
-let init_lexicon _ =
- H.clear lexicon;
- List.iter
- (fun (key, builder) -> H.add lexicon key builder)
- [ ("auto", fun loc -> AUTO loc);
- ("const", fun loc -> CONST loc);
- ("__const", fun loc -> CONST loc);
- ("__const__", fun loc -> CONST loc);
- ("static", fun loc -> STATIC loc);
- ("extern", fun loc -> EXTERN loc);
- ("long", fun loc -> LONG loc);
- ("short", fun loc -> SHORT loc);
- ("register", fun loc -> REGISTER loc);
- ("signed", fun loc -> SIGNED loc);
- ("__signed", fun loc -> SIGNED loc);
- ("unsigned", fun loc -> UNSIGNED loc);
- ("volatile", fun loc -> VOLATILE loc);
- ("__volatile", fun loc -> VOLATILE loc);
- (* WW: see /usr/include/sys/cdefs.h for why __signed and __volatile
- * are accepted GCC-isms *)
- ("char", fun loc -> CHAR loc);
- ("int", fun loc -> INT loc);
- ("float", fun loc -> FLOAT loc);
- ("double", fun loc -> DOUBLE loc);
- ("void", fun loc -> VOID loc);
- ("enum", fun loc -> ENUM loc);
- ("struct", fun loc -> STRUCT loc);
- ("typedef", fun loc -> TYPEDEF loc);
- ("union", fun loc -> UNION loc);
- ("break", fun loc -> BREAK loc);
- ("continue", fun loc -> CONTINUE loc);
- ("goto", fun loc -> GOTO loc);
- ("return", fun loc -> dbgToken (RETURN loc));
- ("switch", fun loc -> dbgToken (SWITCH loc));
- ("case", fun loc -> CASE loc);
- ("default", fun loc -> DEFAULT loc);
- ("while", fun loc -> WHILE loc);
- ("do", fun loc -> DO loc);
- ("for", fun loc -> FOR loc);
- ("if", fun loc -> dbgToken (IF loc));
- ("else", fun _ -> ELSE);
- (*** Implementation specific keywords ***)
- ("__signed__", fun loc -> SIGNED loc);
- ("__inline__", fun loc -> INLINE loc);
- ("inline", fun loc -> INLINE loc);
- ("__inline", fun loc -> INLINE loc);
- ("_inline", fun loc -> INLINE loc);
- ("__attribute__", fun loc -> ATTRIBUTE loc);
- ("__attribute", fun loc -> ATTRIBUTE loc);
-(*
- ("__attribute_used__", fun loc -> ATTRIBUTE_USED loc);
-*)
- ("__blockattribute__", fun _ -> BLOCKATTRIBUTE);
- ("__blockattribute", fun _ -> BLOCKATTRIBUTE);
- ("__asm__", fun loc -> ASM loc);
- ("asm", fun loc -> ASM loc);
- ("__typeof__", fun loc -> TYPEOF loc);
- ("__typeof", fun loc -> TYPEOF loc);
- ("typeof", fun loc -> TYPEOF loc);
- ("__alignof", fun loc -> ALIGNOF loc);
- ("__alignof__", fun loc -> ALIGNOF loc);
- ("__volatile__", fun loc -> VOLATILE loc);
- ("__volatile", fun loc -> VOLATILE loc);
-
- ("__FUNCTION__", fun loc -> FUNCTION__ loc);
- ("__func__", fun loc -> FUNCTION__ loc); (* ISO 6.4.2.2 *)
- ("__PRETTY_FUNCTION__", fun loc -> PRETTY_FUNCTION__ loc);
- ("__label__", fun _ -> LABEL__);
- (*** weimer: GCC arcana ***)
- ("__restrict", fun loc -> RESTRICT loc);
- ("restrict", fun loc -> RESTRICT loc);
-(* ("__extension__", EXTENSION); *)
- (**** MS VC ***)
- ("__int64", fun _ -> INT64 (currentLoc ()));
- ("__int32", fun loc -> INT loc);
- ("_cdecl", fun _ -> MSATTR ("_cdecl", currentLoc ()));
- ("__cdecl", fun _ -> MSATTR ("__cdecl", currentLoc ()));
- ("_stdcall", fun _ -> MSATTR ("_stdcall", currentLoc ()));
- ("__stdcall", fun _ -> MSATTR ("__stdcall", currentLoc ()));
- ("_fastcall", fun _ -> MSATTR ("_fastcall", currentLoc ()));
- ("__fastcall", fun _ -> MSATTR ("__fastcall", currentLoc ()));
- ("__w64", fun _ -> MSATTR("__w64", currentLoc ()));
- ("__declspec", fun loc -> DECLSPEC loc);
- ("__forceinline", fun loc -> INLINE loc); (* !! we turn forceinline
- * into inline *)
- ("__try", fun loc -> TRY loc);
- ("__except", fun loc -> EXCEPT loc);
- ("__finally", fun loc -> FINALLY loc);
- (* weimer: some files produced by 'GCC -E' expect this type to be
- * defined *)
- ("__builtin_va_list",
- fun _ -> NAMED_TYPE ("__builtin_va_list", currentLoc ()));
- ("__builtin_va_arg", fun loc -> BUILTIN_VA_ARG loc);
- ("__builtin_types_compatible_p", fun loc -> BUILTIN_TYPES_COMPAT loc);
- ("__builtin_offsetof", fun loc -> BUILTIN_OFFSETOF loc);
- (* On some versions of GCC __thread is a regular identifier *)
- ("__thread", fun loc ->
- if Machdep.__thread_is_keyword then
- THREAD loc
- else
- IDENT ("__thread", loc));
- ]
-
-(* Mark an identifier as a type name. The old mapping is preserved and will
- * be reinstated when we exit this context *)
-let add_type name =
- (* ignore (print_string ("adding type name " ^ name ^ "\n")); *)
- H.add lexicon name (fun loc -> NAMED_TYPE (name, loc))
-
-let context : string list list ref = ref []
-
-let push_context _ = context := []::!context
-
-let pop_context _ =
- match !context with
- [] -> raise (InternalError "Empty context stack")
- | con::sub ->
- (context := sub;
- List.iter (fun name ->
- (* ignore (print_string ("removing lexicon for " ^ name ^ "\n")); *)
- H.remove lexicon name) con)
-
-(* Mark an identifier as a variable name. The old mapping is preserved and
- * will be reinstated when we exit this context *)
-let add_identifier name =
- match !context with
- [] -> () (* Just ignore raise (InternalError "Empty context stack") *)
- | con::sub ->
- (context := (name::con)::sub;
- (* print_string ("adding IDENT for " ^ name ^ "\n"); *)
- H.add lexicon name (fun loc ->
- dbgToken (IDENT (name, loc))))
-
-
-(*
-** Useful primitives
-*)
-let scan_ident id =
- let here = currentLoc () in
- try (H.find lexicon id) here
- (* default to variable name, as opposed to type *)
- with Not_found -> dbgToken (IDENT (id, here))
-
-
-(*
-** Buffer processor
-*)
-
-
-let init ~(filename: string) : Lexing.lexbuf =
- init_lexicon ();
- (* Inititialize the pointer in Errormsg *)
- Lexerhack.add_type := add_type;
- Lexerhack.push_context := push_context;
- Lexerhack.pop_context := pop_context;
- Lexerhack.add_identifier := add_identifier;
- E.startParsing filename
-
-
-let finish () =
- E.finishParsing ()
-
-(*** Error handling ***)
-let error msg =
- E.parse_error msg
-
-
-(*** escape character management ***)
-let scan_escape (char: char) : int64 =
- let result = match char with
- 'n' -> '\n'
- | 'r' -> '\r'
- | 't' -> '\t'
- | 'b' -> '\b'
- | 'f' -> '\012' (* ASCII code 12 *)
- | 'v' -> '\011' (* ASCII code 11 *)
- | 'a' -> '\007' (* ASCII code 7 *)
- | 'e' | 'E' -> '\027' (* ASCII code 27. This is a GCC extension *)
- | '\'' -> '\''
- | '"'-> '"' (* '"' *)
- | '?' -> '?'
- | '(' when not !Cprint.msvcMode -> '('
- | '{' when not !Cprint.msvcMode -> '{'
- | '[' when not !Cprint.msvcMode -> '['
- | '%' when not !Cprint.msvcMode -> '%'
- | '\\' -> '\\'
- | other -> error ("Unrecognized escape sequence: \\" ^ (String.make 1 other))
- in
- Int64.of_int (Char.code result)
-
-let scan_hex_escape str =
- let radix = Int64.of_int 16 in
- let the_value = ref Int64.zero in
- (* start at character 2 to skip the \x *)
- for i = 2 to (String.length str) - 1 do
- let thisDigit = Cabs.valueOfDigit (String.get str i) in
- (* the_value := !the_value * 16 + thisDigit *)
- the_value := Int64.add (Int64.mul !the_value radix) thisDigit
- done;
- !the_value
-
-let scan_oct_escape str =
- let radix = Int64.of_int 8 in
- let the_value = ref Int64.zero in
- (* start at character 1 to skip the \x *)
- for i = 1 to (String.length str) - 1 do
- let thisDigit = Cabs.valueOfDigit (String.get str i) in
- (* the_value := !the_value * 8 + thisDigit *)
- the_value := Int64.add (Int64.mul !the_value radix) thisDigit
- done;
- !the_value
-
-let lex_hex_escape remainder lexbuf =
- let prefix = scan_hex_escape (Lexing.lexeme lexbuf) in
- prefix :: remainder lexbuf
-
-let lex_oct_escape remainder lexbuf =
- let prefix = scan_oct_escape (Lexing.lexeme lexbuf) in
- prefix :: remainder lexbuf
-
-let lex_simple_escape remainder lexbuf =
- let lexchar = Lexing.lexeme_char lexbuf 1 in
- let prefix = scan_escape lexchar in
- prefix :: remainder lexbuf
-
-let lex_unescaped remainder lexbuf =
- let prefix = Int64.of_int (Char.code (Lexing.lexeme_char lexbuf 0)) in
- prefix :: remainder lexbuf
-
-let lex_comment remainder lexbuf =
- let ch = Lexing.lexeme_char lexbuf 0 in
- let prefix = Int64.of_int (Char.code ch) in
- if ch = '\n' then E.newline();
- prefix :: remainder lexbuf
-
-let make_char (i:int64):char =
- let min_val = Int64.zero in
- let max_val = Int64.of_int 255 in
- (* if i < 0 || i > 255 then error*)
- if compare i min_val < 0 || compare i max_val > 0 then begin
- let msg = Printf.sprintf "clexer:make_char: character 0x%Lx too big" i in
- error msg
- end;
- Char.chr (Int64.to_int i)
-
-
-(* ISO standard locale-specific function to convert a wide character
- * into a sequence of normal characters. Here we work on strings.
- * We convert L"Hi" to "H\000i\000"
- matth: this seems unused.
-let wbtowc wstr =
- let len = String.length wstr in
- let dest = String.make (len * 2) '\000' in
- for i = 0 to len-1 do
- dest.[i*2] <- wstr.[i] ;
- done ;
- dest
-*)
-
-(* This function converst the "Hi" in L"Hi" to { L'H', L'i', L'\0' }
- matth: this seems unused.
-let wstr_to_warray wstr =
- let len = String.length wstr in
- let res = ref "{ " in
- for i = 0 to len-1 do
- res := !res ^ (Printf.sprintf "L'%c', " wstr.[i])
- done ;
- res := !res ^ "}" ;
- !res
-*)
-
-(* Pragmas get explicit end-of-line tokens.
- * Elsewhere they are silently discarded as whitespace. *)
-let pragmaLine = ref false
-
-}
-
-let decdigit = ['0'-'9']
-let octdigit = ['0'-'7']
-let hexdigit = ['0'-'9' 'a'-'f' 'A'-'F']
-let letter = ['a'- 'z' 'A'-'Z']
-
-
-let usuffix = ['u' 'U']
-let lsuffix = "l"|"L"|"ll"|"LL"
-let intsuffix = lsuffix | usuffix | usuffix lsuffix | lsuffix usuffix
- | usuffix ? "i64"
-
-
-let hexprefix = '0' ['x' 'X']
-
-let intnum = decdigit+ intsuffix?
-let octnum = '0' octdigit+ intsuffix?
-let hexnum = hexprefix hexdigit+ intsuffix?
-
-let exponent = ['e' 'E']['+' '-']? decdigit+
-let fraction = '.' decdigit+
-let decfloat = (intnum? fraction)
- |(intnum exponent)
- |(intnum? fraction exponent)
- | (intnum '.')
- | (intnum '.' exponent)
-
-let hexfraction = hexdigit* '.' hexdigit+ | hexdigit+
-let binexponent = ['p' 'P'] ['+' '-']? decdigit+
-let hexfloat = hexprefix hexfraction binexponent
- | hexprefix hexdigit+ binexponent
-
-let floatsuffix = ['f' 'F' 'l' 'L']
-let floatnum = (decfloat | hexfloat) floatsuffix?
-
-let ident = (letter|'_')(letter|decdigit|'_'|'$')*
-let blank = [' ' '\t' '\012' '\r']+
-let escape = '\\' _
-let hex_escape = '\\' ['x' 'X'] hexdigit+
-let oct_escape = '\\' octdigit octdigit? octdigit?
-
-(* Pragmas that are not parsed by CIL. We lex them as PRAGMA_LINE tokens *)
-
-let no_parse_pragma =
- "warning" | "GCC"
- (* Solaris-style pragmas: *)
- | "ident" | "section" | "option" | "asm" | "use_section" | "weak"
- | "redefine_extname"
- | "TCS_align"
- (* Added by XL *)
- | "global_register"
-
-rule initial =
- parse "/*" { let il = comment lexbuf in
- let sl = intlist_to_string il in
- addComment sl;
- initial lexbuf}
-| "//" { let il = onelinecomment lexbuf in
- let sl = intlist_to_string il in
- addComment sl;
- E.newline();
- initial lexbuf
- }
-| blank {initial lexbuf}
-| '\n' { E.newline ();
- if !pragmaLine then
- begin
- pragmaLine := false;
- PRAGMA_EOL
- end
- else
- initial lexbuf }
-| '\\' '\r' * '\n' {
- E.newline ();
- initial lexbuf
- }
-| '#' { hash lexbuf}
-| "_Pragma" { PRAGMA (currentLoc ()) }
-| '\'' { CST_CHAR (chr lexbuf, currentLoc ())}
-| "L'" { CST_WCHAR (chr lexbuf, currentLoc ()) }
-| '"' { (* '"' *)
-(* matth: BUG: this could be either a regular string or a wide string.
- * e.g. if it's the "world" in
- * L"Hello, " "world"
- * then it should be treated as wide even though there's no L immediately
- * preceding it. See test/small1/wchar5.c for a failure case. *)
- try CST_STRING (str lexbuf, currentLoc ())
- with e ->
- raise (InternalError
- ("str: " ^
- Printexc.to_string e))}
-| "L\"" { (* weimer: wchar_t string literal *)
- try CST_WSTRING(str lexbuf, currentLoc ())
- with e ->
- raise (InternalError
- ("wide string: " ^
- Printexc.to_string e))}
-| floatnum {CST_FLOAT (Lexing.lexeme lexbuf, currentLoc ())}
-| hexnum {CST_INT (Lexing.lexeme lexbuf, currentLoc ())}
-| octnum {CST_INT (Lexing.lexeme lexbuf, currentLoc ())}
-| intnum {CST_INT (Lexing.lexeme lexbuf, currentLoc ())}
-| "!quit!" {EOF}
-| "..." {ELLIPSIS}
-| "+=" {PLUS_EQ}
-| "-=" {MINUS_EQ}
-| "*=" {STAR_EQ}
-| "/=" {SLASH_EQ}
-| "%=" {PERCENT_EQ}
-| "|=" {PIPE_EQ}
-| "&=" {AND_EQ}
-| "^=" {CIRC_EQ}
-| "<<=" {INF_INF_EQ}
-| ">>=" {SUP_SUP_EQ}
-| "<<" {INF_INF}
-| ">>" {SUP_SUP}
-| "==" {EQ_EQ}
-| "!=" {EXCLAM_EQ}
-| "<=" {INF_EQ}
-| ">=" {SUP_EQ}
-| "=" {EQ}
-| "<" {INF}
-| ">" {SUP}
-| "++" {PLUS_PLUS (currentLoc ())}
-| "--" {MINUS_MINUS (currentLoc ())}
-| "->" {ARROW}
-| '+' {PLUS (currentLoc ())}
-| '-' {MINUS (currentLoc ())}
-| '*' {STAR (currentLoc ())}
-| '/' {SLASH}
-| '%' {PERCENT}
-| '!' {EXCLAM (currentLoc ())}
-| "&&" {AND_AND (currentLoc ())}
-| "||" {PIPE_PIPE}
-| '&' {AND (currentLoc ())}
-| '|' {PIPE}
-| '^' {CIRC}
-| '?' {QUEST}
-| ':' {COLON}
-| '~' {TILDE (currentLoc ())}
-
-| '{' {dbgToken (LBRACE (currentLoc ()))}
-| '}' {dbgToken (RBRACE (currentLoc ()))}
-| '[' {LBRACKET}
-| ']' {RBRACKET}
-| '(' {dbgToken (LPAREN (currentLoc ())) }
-| ')' {RPAREN}
-| ';' {dbgToken (SEMICOLON (currentLoc ())) }
-| ',' {COMMA}
-| '.' {DOT}
-| "sizeof" {SIZEOF (currentLoc ())}
-| "__asm" { if !Cprint.msvcMode then
- MSASM (msasm lexbuf, currentLoc ())
- else (ASM (currentLoc ())) }
-
-(* If we see __pragma we eat it and the matching parentheses as well *)
-| "__pragma" { matchingParsOpen := 0;
- let _ = matchingpars lexbuf in
- initial lexbuf
- }
-
-(* sm: tree transformation keywords *)
-| "@transform" {AT_TRANSFORM (currentLoc ())}
-| "@transformExpr" {AT_TRANSFORMEXPR (currentLoc ())}
-| "@specifier" {AT_SPECIFIER (currentLoc ())}
-| "@expr" {AT_EXPR (currentLoc ())}
-| "@name" {AT_NAME}
-
-(* __extension__ is a black. The parser runs into some conflicts if we let it
- * pass *)
-| "__extension__" {initial lexbuf }
-| ident {scan_ident (Lexing.lexeme lexbuf)}
-| eof {EOF}
-| _ {E.parse_error "Invalid symbol"}
-and comment =
- parse
- "*/" { [] }
-(*| '\n' { E.newline (); lex_unescaped comment lexbuf }*)
-| _ { lex_comment comment lexbuf }
-
-
-and onelinecomment = parse
- '\n' {[]}
-| _ { lex_comment onelinecomment lexbuf }
-
-and matchingpars = parse
- '\n' { E.newline (); matchingpars lexbuf }
-| blank { matchingpars lexbuf }
-| '(' { incr matchingParsOpen; matchingpars lexbuf }
-| ')' { decr matchingParsOpen;
- if !matchingParsOpen = 0 then
- ()
- else
- matchingpars lexbuf
- }
-| "/*" { let il = comment lexbuf in
- let sl = intlist_to_string il in
- addComment sl;
- matchingpars lexbuf}
-| '"' { (* '"' *)
- let _ = str lexbuf in
- matchingpars lexbuf
- }
-| _ { matchingpars lexbuf }
-
-(* # <line number> <file name> ... *)
-and hash = parse
- '\n' { E.newline (); initial lexbuf}
-| blank { hash lexbuf}
-| intnum { (* We are seeing a line number. This is the number for the
- * next line *)
- let s = Lexing.lexeme lexbuf in
- begin try
- E.setCurrentLine (int_of_string s - 1)
- with Failure _ ->
- E.warn "Bad line number in preprocessed file: %s" s
- end;
- (* A file name must follow *)
- file lexbuf }
-| "line" { hash lexbuf } (* MSVC line number info *)
- (* For pragmas with irregular syntax, like #pragma warning,
- * we parse them as a whole line. *)
-| "pragma" blank (no_parse_pragma as pragmaName)
- { let here = currentLoc () in
- PRAGMA_LINE (pragmaName ^ pragma lexbuf, here)
- }
-| "pragma" { pragmaLine := true; PRAGMA (currentLoc ()) }
-| _ { endline lexbuf}
-
-and file = parse
- '\n' {E.newline (); initial lexbuf}
-| blank {file lexbuf}
-| '"' [^ '\012' '\t' '"']* '"' { (* '"' *)
- let n = Lexing.lexeme lexbuf in
- let n1 = String.sub n 1
- ((String.length n) - 2) in
- E.setCurrentFile n1;
- endline lexbuf}
-
-| _ {endline lexbuf}
-
-and endline = parse
- '\n' { E.newline (); initial lexbuf}
-| eof { EOF }
-| _ { endline lexbuf}
-
-and pragma = parse
- '\n' { E.newline (); "" }
-| _ { let cur = Lexing.lexeme lexbuf in
- cur ^ (pragma lexbuf) }
-
-and str = parse
- '"' {[]} (* no nul terminiation in CST_STRING '"' *)
-| hex_escape {lex_hex_escape str lexbuf}
-| oct_escape {lex_oct_escape str lexbuf}
-| escape {lex_simple_escape str lexbuf}
-| _ {lex_unescaped str lexbuf}
-
-and chr = parse
- '\'' {[]}
-| hex_escape {lex_hex_escape chr lexbuf}
-| oct_escape {lex_oct_escape chr lexbuf}
-| escape {lex_simple_escape chr lexbuf}
-| _ {lex_unescaped chr lexbuf}
-
-and msasm = parse
- blank { msasm lexbuf }
-| '{' { msasminbrace lexbuf }
-| _ { let cur = Lexing.lexeme lexbuf in
- cur ^ (msasmnobrace lexbuf) }
-
-and msasminbrace = parse
- '}' { "" }
-| _ { let cur = Lexing.lexeme lexbuf in
- cur ^ (msasminbrace lexbuf) }
-and msasmnobrace = parse
- ['}' ';' '\n'] { lexbuf.Lexing.lex_curr_pos <-
- lexbuf.Lexing.lex_curr_pos - 1;
- "" }
-| "__asm" { lexbuf.Lexing.lex_curr_pos <-
- lexbuf.Lexing.lex_curr_pos - 5;
- "" }
-| _ { let cur = Lexing.lexeme lexbuf in
-
- cur ^ (msasmnobrace lexbuf) }
-
-{
-
-}
diff --git a/cil/src/frontc/cparser.mly b/cil/src/frontc/cparser.mly
deleted file mode 100644
index f1e1ef94b0c3a69a6981d0660c86dedd43d4f33c..0000000000000000000000000000000000000000
--- a/cil/src/frontc/cparser.mly
+++ /dev/null
@@ -1,1521 +0,0 @@
-/*(*
- *
- * Copyright (c) 2001-2003,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * Ben Liblit <liblit@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- **)
-(**
-** 1.0 3.22.99 Hugues Cassé First version.
-** 2.0 George Necula 12/12/00: Practically complete rewrite.
-*)
-*/
-%{
-open Cabs
-module E = Errormsg
-
-let parse_error msg : unit = (* sm: c++-mode highlight hack: -> ' <- *)
- E.parse_error msg
-
-let print = print_string
-
-(* unit -> string option *)
-(*
-let getComments () =
- match !comments with
- [] -> None
- | _ ->
- let r = Some(String.concat "\n" (List.rev !comments)) in
- comments := [];
- r
-*)
-
-let currentLoc () =
- let l, f, c = E.getPosition () in
- { lineno = l;
- filename = f;
- byteno = c;}
-
-let cabslu = {lineno = -10;
- filename = "cabs loc unknown";
- byteno = -10;}
-
-(* cabsloc -> cabsloc *)
-(*
-let handleLoc l =
- l.clcomment <- getComments();
- l
-*)
-
-(*
-** Expression building
-*)
-let smooth_expression lst =
- match lst with
- [] -> NOTHING
- | [expr] -> expr
- | _ -> COMMA (lst)
-
-
-let currentFunctionName = ref "<outside any function>"
-
-let announceFunctionName ((n, decl, _, _):name) =
- !Lexerhack.add_identifier n;
- (* Start a context that includes the parameter names and the whole body.
- * Will pop when we finish parsing the function body *)
- !Lexerhack.push_context ();
- (* Go through all the parameter names and mark them as identifiers *)
- let rec findProto = function
- PROTO (d, args, _) when isJUSTBASE d ->
- List.iter (fun (_, (an, _, _, _)) -> !Lexerhack.add_identifier an) args
-
- | PROTO (d, _, _) -> findProto d
- | PARENTYPE (_, d, _) -> findProto d
- | PTR (_, d) -> findProto d
- | ARRAY (d, _, _) -> findProto d
- | _ -> parse_error "Cannot find the prototype in a function definition";
- raise Parsing.Parse_error
-
- and isJUSTBASE = function
- JUSTBASE -> true
- | PARENTYPE (_, d, _) -> isJUSTBASE d
- | _ -> false
- in
- findProto decl;
- currentFunctionName := n
-
-
-
-let applyPointer (ptspecs: attribute list list) (dt: decl_type)
- : decl_type =
- (* Outer specification first *)
- let rec loop = function
- [] -> dt
- | attrs :: rest -> PTR(attrs, loop rest)
- in
- loop ptspecs
-
-let doDeclaration (loc: cabsloc) (specs: spec_elem list) (nl: init_name list) : definition =
- if isTypedef specs then begin
- (* Tell the lexer about the new type names *)
- List.iter (fun ((n, _, _, _), _) -> !Lexerhack.add_type n) nl;
- TYPEDEF ((specs, List.map (fun (n, _) -> n) nl), loc)
- end else
- if nl = [] then
- ONLYTYPEDEF (specs, loc)
- else begin
- (* Tell the lexer about the new variable names *)
- List.iter (fun ((n, _, _, _), _) -> !Lexerhack.add_identifier n) nl;
- DECDEF ((specs, nl), loc)
- end
-
-
-let doFunctionDef (loc: cabsloc)
- (lend: cabsloc)
- (specs: spec_elem list)
- (n: name)
- (b: block) : definition =
- let fname = (specs, n) in
- FUNDEF (fname, b, loc, lend)
-
-
-let doOldParDecl (names: string list)
- ((pardefs: name_group list), (isva: bool))
- : single_name list * bool =
- let findOneName n =
- (* Search in pardefs for the definition for this parameter *)
- let rec loopGroups = function
- [] -> ([SpecType Tint], (n, JUSTBASE, [], cabslu))
- | (specs, names) :: restgroups ->
- let rec loopNames = function
- [] -> loopGroups restgroups
- | ((n',_, _, _) as sn) :: _ when n' = n -> (specs, sn)
- | _ :: restnames -> loopNames restnames
- in
- loopNames names
- in
- loopGroups pardefs
- in
- let args = List.map findOneName names in
- (args, isva)
-
-let checkConnective (s : string) : unit =
-begin
- (* checking this means I could possibly have more connectives, with *)
- (* different meaning *)
- if (s <> "to") then (
- parse_error "transformer connective must be 'to'";
- raise Parsing.Parse_error
- )
- else ()
-end
-
-let int64_to_char value =
- if (compare value (Int64.of_int 255) > 0) || (compare value Int64.zero < 0) then
- begin
- let msg = Printf.sprintf "cparser:intlist_to_string: character 0x%Lx too big" value in
- parse_error msg;
- raise Parsing.Parse_error
- end
- else
- Char.chr (Int64.to_int value)
-
-(* takes a not-nul-terminated list, and converts it to a string. *)
-let rec intlist_to_string (str: int64 list):string =
- match str with
- [] -> "" (* add nul-termination *)
- | value::rest ->
- let this_char = int64_to_char value in
- (String.make 1 this_char) ^ (intlist_to_string rest)
-
-let fst3 (result, _, _) = result
-let snd3 (_, result, _) = result
-let trd3 (_, _, result) = result
-
-
-(*
- transform: __builtin_offsetof(type, member)
- into : (size_t) (&(type * ) 0)->member
- *)
-
-let transformOffsetOf (speclist, dtype) member =
- let rec addPointer = function
- | JUSTBASE ->
- PTR([], JUSTBASE)
- | PARENTYPE (attrs1, dtype, attrs2) ->
- PARENTYPE (attrs1, addPointer dtype, attrs2)
- | ARRAY (dtype, attrs, expr) ->
- ARRAY (addPointer dtype, attrs, expr)
- | PTR (attrs, dtype) ->
- PTR (attrs, addPointer dtype)
- | PROTO (dtype, names, variadic) ->
- PROTO (addPointer dtype, names, variadic)
- in
- let nullType = (speclist, addPointer dtype) in
- let nullExpr = CONSTANT (CONST_INT "0") in
- let castExpr = CAST (nullType, SINGLE_INIT nullExpr) in
-
- let rec replaceBase = function
- | VARIABLE field ->
- MEMBEROFPTR (castExpr, field)
- | MEMBEROF (base, field) ->
- MEMBEROF (replaceBase base, field)
- | INDEX (base, index) ->
- INDEX (replaceBase base, index)
- | _ ->
- parse_error "malformed offset expression in __builtin_offsetof";
- raise Parsing.Parse_error
- in
- let memberExpr = replaceBase member in
- let addrExpr = UNARY (ADDROF, memberExpr) in
- (* slight cheat: hard-coded assumption that size_t == unsigned int *)
- let sizeofType = [SpecType Tunsigned], JUSTBASE in
- let resultExpr = CAST (sizeofType, SINGLE_INIT addrExpr) in
- resultExpr
-
-%}
-
-%token <string * Cabs.cabsloc> IDENT
-%token <int64 list * Cabs.cabsloc> CST_CHAR
-%token <int64 list * Cabs.cabsloc> CST_WCHAR
-%token <string * Cabs.cabsloc> CST_INT
-%token <string * Cabs.cabsloc> CST_FLOAT
-%token <string * Cabs.cabsloc> NAMED_TYPE
-
-/* Each character is its own list element, and the terminating nul is not
- included in this list. */
-%token <int64 list * Cabs.cabsloc> CST_STRING
-%token <int64 list * Cabs.cabsloc> CST_WSTRING
-
-%token EOF
-%token<Cabs.cabsloc> CHAR INT DOUBLE FLOAT VOID INT64 INT32
-%token<Cabs.cabsloc> ENUM STRUCT TYPEDEF UNION
-%token<Cabs.cabsloc> SIGNED UNSIGNED LONG SHORT
-%token<Cabs.cabsloc> VOLATILE EXTERN STATIC CONST RESTRICT AUTO REGISTER
-%token<Cabs.cabsloc> THREAD
-
-%token<Cabs.cabsloc> SIZEOF ALIGNOF
-
-%token EQ PLUS_EQ MINUS_EQ STAR_EQ SLASH_EQ PERCENT_EQ
-%token AND_EQ PIPE_EQ CIRC_EQ INF_INF_EQ SUP_SUP_EQ
-%token ARROW DOT
-
-%token EQ_EQ EXCLAM_EQ INF SUP INF_EQ SUP_EQ
-%token<Cabs.cabsloc> PLUS MINUS STAR
-%token SLASH PERCENT
-%token<Cabs.cabsloc> TILDE AND
-%token PIPE CIRC
-%token<Cabs.cabsloc> EXCLAM AND_AND
-%token PIPE_PIPE
-%token INF_INF SUP_SUP
-%token<Cabs.cabsloc> PLUS_PLUS MINUS_MINUS
-
-%token RPAREN
-%token<Cabs.cabsloc> LPAREN RBRACE
-%token<Cabs.cabsloc> LBRACE
-%token LBRACKET RBRACKET
-%token COLON
-%token<Cabs.cabsloc> SEMICOLON
-%token COMMA ELLIPSIS QUEST
-
-%token<Cabs.cabsloc> BREAK CONTINUE GOTO RETURN
-%token<Cabs.cabsloc> SWITCH CASE DEFAULT
-%token<Cabs.cabsloc> WHILE DO FOR
-%token<Cabs.cabsloc> IF TRY EXCEPT FINALLY
-%token ELSE
-
-%token<Cabs.cabsloc> ATTRIBUTE INLINE ASM TYPEOF FUNCTION__ PRETTY_FUNCTION__
-%token LABEL__
-%token<Cabs.cabsloc> BUILTIN_VA_ARG ATTRIBUTE_USED
-%token BUILTIN_VA_LIST
-%token BLOCKATTRIBUTE
-%token<Cabs.cabsloc> BUILTIN_TYPES_COMPAT BUILTIN_OFFSETOF
-%token<Cabs.cabsloc> DECLSPEC
-%token<string * Cabs.cabsloc> MSASM MSATTR
-%token<string * Cabs.cabsloc> PRAGMA_LINE
-%token<Cabs.cabsloc> PRAGMA
-%token PRAGMA_EOL
-
-/* sm: cabs tree transformation specification keywords */
-%token<Cabs.cabsloc> AT_TRANSFORM AT_TRANSFORMEXPR AT_SPECIFIER AT_EXPR
-%token AT_NAME
-
-/* operator precedence */
-%nonassoc IF
-%nonassoc ELSE
-
-
-%left COMMA
-%right EQ PLUS_EQ MINUS_EQ STAR_EQ SLASH_EQ PERCENT_EQ
- AND_EQ PIPE_EQ CIRC_EQ INF_INF_EQ SUP_SUP_EQ
-%right QUEST COLON
-%left PIPE_PIPE
-%left AND_AND
-%left PIPE
-%left CIRC
-%left AND
-%left EQ_EQ EXCLAM_EQ
-%left INF SUP INF_EQ SUP_EQ
-%left INF_INF SUP_SUP
-%left PLUS MINUS
-%left STAR SLASH PERCENT CONST RESTRICT VOLATILE
-%right EXCLAM TILDE PLUS_PLUS MINUS_MINUS CAST RPAREN ADDROF SIZEOF ALIGNOF
-%left LBRACKET
-%left DOT ARROW LPAREN LBRACE
-%right NAMED_TYPE /* We'll use this to handle redefinitions of
- * NAMED_TYPE as variables */
-%left IDENT
-
-/* Non-terminals informations */
-%start interpret file
-%type <Cabs.definition list> file interpret globals
-
-%type <Cabs.definition> global
-
-
-%type <Cabs.attribute list> attributes attributes_with_asm asmattr
-%type <Cabs.statement> statement
-%type <Cabs.constant * cabsloc> constant
-%type <string * cabsloc> string_constant
-%type <Cabs.expression * cabsloc> expression
-%type <Cabs.expression> opt_expression
-%type <Cabs.init_expression> init_expression
-%type <Cabs.expression list * cabsloc> comma_expression
-%type <Cabs.expression list * cabsloc> paren_comma_expression
-%type <Cabs.expression list> arguments
-%type <Cabs.expression list> bracket_comma_expression
-%type <int64 list Queue.t * cabsloc> string_list
-%type <int64 list * cabsloc> wstring_list
-
-%type <Cabs.initwhat * Cabs.init_expression> initializer
-%type <(Cabs.initwhat * Cabs.init_expression) list> initializer_list
-%type <Cabs.initwhat> init_designators init_designators_opt
-
-%type <spec_elem list * cabsloc> decl_spec_list
-%type <typeSpecifier * cabsloc> type_spec
-%type <Cabs.field_group list> struct_decl_list
-
-
-%type <Cabs.name> old_proto_decl
-%type <Cabs.single_name> parameter_decl
-%type <Cabs.enum_item> enumerator
-%type <Cabs.enum_item list> enum_list
-%type <Cabs.definition> declaration function_def
-%type <cabsloc * spec_elem list * name> function_def_start
-%type <Cabs.spec_elem list * Cabs.decl_type> type_name
-%type <Cabs.block * cabsloc * cabsloc> block
-%type <Cabs.statement list> block_element_list
-%type <string list> local_labels local_label_names
-%type <string list> old_parameter_list_ne
-
-%type <Cabs.init_name> init_declarator
-%type <Cabs.init_name list> init_declarator_list
-%type <Cabs.name> declarator
-%type <Cabs.name * expression option> field_decl
-%type <(Cabs.name * expression option) list> field_decl_list
-%type <string * Cabs.decl_type> direct_decl
-%type <Cabs.decl_type> abs_direct_decl abs_direct_decl_opt
-%type <Cabs.decl_type * Cabs.attribute list> abstract_decl
-
- /* (* Each element is a "* <type_quals_opt>". *) */
-%type <attribute list list * cabsloc> pointer pointer_opt
-%type <Cabs.cabsloc> location
-%type <Cabs.spec_elem * cabsloc> cvspec
-%%
-
-interpret:
- file EOF {$1}
-;
-file: globals {$1}
-;
-globals:
- /* empty */ { [] }
-| global globals { $1 :: $2 }
-| SEMICOLON globals { $2 }
-;
-
-location:
- /* empty */ { currentLoc () } %prec IDENT
-
-
-/*** Global Definition ***/
-global:
-| declaration { $1 }
-| function_def { $1 }
-/*(* Some C header files ar shared with the C++ compiler and have linkage
- * specification *)*/
-| EXTERN string_constant declaration { LINKAGE (fst $2, (*handleLoc*) (snd $2), [ $3 ]) }
-| EXTERN string_constant LBRACE globals RBRACE
- { LINKAGE (fst $2, (*handleLoc*) (snd $2), $4) }
-| ASM LPAREN string_constant RPAREN SEMICOLON
- { GLOBASM (fst $3, (*handleLoc*) $1) }
-| pragma { $1 }
-/* (* Old-style function prototype. This should be somewhere else, like in
- * "declaration". For now we keep it at global scope only because in local
- * scope it looks too much like a function call *) */
-| IDENT LPAREN old_parameter_list_ne RPAREN old_pardef_list SEMICOLON
- { (* Convert pardecl to new style *)
- let pardecl, isva = doOldParDecl $3 $5 in
- (* Make the function declarator *)
- doDeclaration ((*handleLoc*) (snd $1)) []
- [((fst $1, PROTO(JUSTBASE, pardecl,isva), [], cabslu),
- NO_INIT)]
- }
-/* (* Old style function prototype, but without any arguments *) */
-| IDENT LPAREN RPAREN SEMICOLON
- { (* Make the function declarator *)
- doDeclaration ((*handleLoc*)(snd $1)) []
- [((fst $1, PROTO(JUSTBASE,[],false), [], cabslu),
- NO_INIT)]
- }
-/* transformer for a toplevel construct */
-| AT_TRANSFORM LBRACE global RBRACE IDENT/*to*/ LBRACE globals RBRACE {
- checkConnective(fst $5);
- TRANSFORMER($3, $7, $1)
- }
-/* transformer for an expression */
-| AT_TRANSFORMEXPR LBRACE expression RBRACE IDENT/*to*/ LBRACE expression RBRACE {
- checkConnective(fst $5);
- EXPRTRANSFORMER(fst $3, fst $7, $1)
- }
-| location error SEMICOLON { PRAGMA (VARIABLE "parse_error", $1) }
-;
-
-id_or_typename:
- IDENT {fst $1}
-| NAMED_TYPE {fst $1}
-| AT_NAME LPAREN IDENT RPAREN { "@name(" ^ fst $3 ^ ")" } /* pattern variable name */
-;
-
-maybecomma:
- /* empty */ { () }
-| COMMA { () }
-;
-
-/* *** Expressions *** */
-
-primary_expression: /*(* 6.5.1. *)*/
-| IDENT
- {VARIABLE (fst $1), snd $1}
-| constant
- {CONSTANT (fst $1), snd $1}
-| paren_comma_expression
- {smooth_expression (fst $1), snd $1}
-| LPAREN block RPAREN
- { GNU_BODY (fst3 $2), $1 }
-
- /*(* Next is Scott's transformer *)*/
-| AT_EXPR LPAREN IDENT RPAREN /* expression pattern variable */
- { EXPR_PATTERN(fst $3), $1 }
-;
-
-postfix_expression: /*(* 6.5.2 *)*/
-| primary_expression
- { $1 }
-| postfix_expression bracket_comma_expression
- {INDEX (fst $1, smooth_expression $2), snd $1}
-| postfix_expression LPAREN arguments RPAREN
- {CALL (fst $1, $3), snd $1}
-| BUILTIN_VA_ARG LPAREN expression COMMA type_name RPAREN
- { let b, d = $5 in
- CALL (VARIABLE "__builtin_va_arg",
- [fst $3; TYPE_SIZEOF (b, d)]), $1 }
-| BUILTIN_TYPES_COMPAT LPAREN type_name COMMA type_name RPAREN
- { let b1,d1 = $3 in
- let b2,d2 = $5 in
- CALL (VARIABLE "__builtin_types_compatible_p",
- [TYPE_SIZEOF(b1,d1); TYPE_SIZEOF(b2,d2)]), $1 }
-| BUILTIN_OFFSETOF LPAREN type_name COMMA offsetof_member_designator RPAREN
- { transformOffsetOf $3 (fst $5), $1 }
-| postfix_expression DOT id_or_typename
- {MEMBEROF (fst $1, $3), snd $1}
-| postfix_expression ARROW id_or_typename
- {MEMBEROFPTR (fst $1, $3), snd $1}
-| postfix_expression PLUS_PLUS
- {UNARY (POSINCR, fst $1), snd $1}
-| postfix_expression MINUS_MINUS
- {UNARY (POSDECR, fst $1), snd $1}
-/* (* We handle GCC constructor expressions *) */
-| LPAREN type_name RPAREN LBRACE initializer_list_opt RBRACE
- { CAST($2, COMPOUND_INIT $5), $1 }
-;
-
-offsetof_member_designator: /* GCC extension for __builtin_offsetof */
-| IDENT
- { VARIABLE (fst $1), snd $1 }
-| offsetof_member_designator DOT IDENT
- { MEMBEROF (fst $1, fst $3), snd $1 }
-| offsetof_member_designator bracket_comma_expression
- { INDEX (fst $1, smooth_expression $2), snd $1 }
-;
-
-unary_expression: /*(* 6.5.3 *)*/
-| postfix_expression
- { $1 }
-| PLUS_PLUS unary_expression
- {UNARY (PREINCR, fst $2), $1}
-| MINUS_MINUS unary_expression
- {UNARY (PREDECR, fst $2), $1}
-| SIZEOF unary_expression
- {EXPR_SIZEOF (fst $2), $1}
-| SIZEOF LPAREN type_name RPAREN
- {let b, d = $3 in TYPE_SIZEOF (b, d), $1}
-| ALIGNOF unary_expression
- {EXPR_ALIGNOF (fst $2), $1}
-| ALIGNOF LPAREN type_name RPAREN
- {let b, d = $3 in TYPE_ALIGNOF (b, d), $1}
-| PLUS cast_expression
- {UNARY (PLUS, fst $2), $1}
-| MINUS cast_expression
- {UNARY (MINUS, fst $2), $1}
-| STAR cast_expression
- {UNARY (MEMOF, fst $2), $1}
-| AND cast_expression
- {UNARY (ADDROF, fst $2), $1}
-| EXCLAM cast_expression
- {UNARY (NOT, fst $2), $1}
-| TILDE cast_expression
- {UNARY (BNOT, fst $2), $1}
-| AND_AND IDENT { LABELADDR (fst $2), $1 }
-;
-
-cast_expression: /*(* 6.5.4 *)*/
-| unary_expression
- { $1 }
-| LPAREN type_name RPAREN cast_expression
- { CAST($2, SINGLE_INIT (fst $4)), $1 }
-;
-
-multiplicative_expression: /*(* 6.5.5 *)*/
-| cast_expression
- { $1 }
-| multiplicative_expression STAR cast_expression
- {BINARY(MUL, fst $1, fst $3), snd $1}
-| multiplicative_expression SLASH cast_expression
- {BINARY(DIV, fst $1, fst $3), snd $1}
-| multiplicative_expression PERCENT cast_expression
- {BINARY(MOD, fst $1, fst $3), snd $1}
-;
-
-additive_expression: /*(* 6.5.6 *)*/
-| multiplicative_expression
- { $1 }
-| additive_expression PLUS multiplicative_expression
- {BINARY(ADD, fst $1, fst $3), snd $1}
-| additive_expression MINUS multiplicative_expression
- {BINARY(SUB, fst $1, fst $3), snd $1}
-;
-
-shift_expression: /*(* 6.5.7 *)*/
-| additive_expression
- { $1 }
-| shift_expression INF_INF additive_expression
- {BINARY(SHL, fst $1, fst $3), snd $1}
-| shift_expression SUP_SUP additive_expression
- {BINARY(SHR, fst $1, fst $3), snd $1}
-;
-
-
-relational_expression: /*(* 6.5.8 *)*/
-| shift_expression
- { $1 }
-| relational_expression INF shift_expression
- {BINARY(LT, fst $1, fst $3), snd $1}
-| relational_expression SUP shift_expression
- {BINARY(GT, fst $1, fst $3), snd $1}
-| relational_expression INF_EQ shift_expression
- {BINARY(LE, fst $1, fst $3), snd $1}
-| relational_expression SUP_EQ shift_expression
- {BINARY(GE, fst $1, fst $3), snd $1}
-;
-
-equality_expression: /*(* 6.5.9 *)*/
-| relational_expression
- { $1 }
-| equality_expression EQ_EQ relational_expression
- {BINARY(EQ, fst $1, fst $3), snd $1}
-| equality_expression EXCLAM_EQ relational_expression
- {BINARY(NE, fst $1, fst $3), snd $1}
-;
-
-
-bitwise_and_expression: /*(* 6.5.10 *)*/
-| equality_expression
- { $1 }
-| bitwise_and_expression AND equality_expression
- {BINARY(BAND, fst $1, fst $3), snd $1}
-;
-
-bitwise_xor_expression: /*(* 6.5.11 *)*/
-| bitwise_and_expression
- { $1 }
-| bitwise_xor_expression CIRC bitwise_and_expression
- {BINARY(XOR, fst $1, fst $3), snd $1}
-;
-
-bitwise_or_expression: /*(* 6.5.12 *)*/
-| bitwise_xor_expression
- { $1 }
-| bitwise_or_expression PIPE bitwise_xor_expression
- {BINARY(BOR, fst $1, fst $3), snd $1}
-;
-
-logical_and_expression: /*(* 6.5.13 *)*/
-| bitwise_or_expression
- { $1 }
-| logical_and_expression AND_AND bitwise_or_expression
- {BINARY(AND, fst $1, fst $3), snd $1}
-;
-
-logical_or_expression: /*(* 6.5.14 *)*/
-| logical_and_expression
- { $1 }
-| logical_or_expression PIPE_PIPE logical_and_expression
- {BINARY(OR, fst $1, fst $3), snd $1}
-;
-
-conditional_expression: /*(* 6.5.15 *)*/
-| logical_or_expression
- { $1 }
-| logical_or_expression QUEST opt_expression COLON conditional_expression
- {QUESTION (fst $1, $3, fst $5), snd $1}
-;
-
-/*(* The C spec says that left-hand sides of assignment expressions are unary
- * expressions. GCC allows cast expressions in there ! *)*/
-
-assignment_expression: /*(* 6.5.16 *)*/
-| conditional_expression
- { $1 }
-| cast_expression EQ assignment_expression
- {BINARY(ASSIGN, fst $1, fst $3), snd $1}
-| cast_expression PLUS_EQ assignment_expression
- {BINARY(ADD_ASSIGN, fst $1, fst $3), snd $1}
-| cast_expression MINUS_EQ assignment_expression
- {BINARY(SUB_ASSIGN, fst $1, fst $3), snd $1}
-| cast_expression STAR_EQ assignment_expression
- {BINARY(MUL_ASSIGN, fst $1, fst $3), snd $1}
-| cast_expression SLASH_EQ assignment_expression
- {BINARY(DIV_ASSIGN, fst $1, fst $3), snd $1}
-| cast_expression PERCENT_EQ assignment_expression
- {BINARY(MOD_ASSIGN, fst $1, fst $3), snd $1}
-| cast_expression AND_EQ assignment_expression
- {BINARY(BAND_ASSIGN, fst $1, fst $3), snd $1}
-| cast_expression PIPE_EQ assignment_expression
- {BINARY(BOR_ASSIGN, fst $1, fst $3), snd $1}
-| cast_expression CIRC_EQ assignment_expression
- {BINARY(XOR_ASSIGN, fst $1, fst $3), snd $1}
-| cast_expression INF_INF_EQ assignment_expression
- {BINARY(SHL_ASSIGN, fst $1, fst $3), snd $1}
-| cast_expression SUP_SUP_EQ assignment_expression
- {BINARY(SHR_ASSIGN, fst $1, fst $3), snd $1}
-;
-
-expression: /*(* 6.5.17 *)*/
- assignment_expression
- { $1 }
-;
-
-
-constant:
- CST_INT {CONST_INT (fst $1), snd $1}
-| CST_FLOAT {CONST_FLOAT (fst $1), snd $1}
-| CST_CHAR {CONST_CHAR (fst $1), snd $1}
-| CST_WCHAR {CONST_WCHAR (fst $1), snd $1}
-| string_constant {CONST_STRING (fst $1), snd $1}
-| wstring_list {CONST_WSTRING (fst $1), snd $1}
-;
-
-string_constant:
-/* Now that we know this constant isn't part of a wstring, convert it
- back to a string for easy viewing. */
- string_list {
- let queue, location = $1 in
- let buffer = Buffer.create (Queue.length queue) in
- Queue.iter
- (List.iter
- (fun value ->
- let char = int64_to_char value in
- Buffer.add_char buffer char))
- queue;
- Buffer.contents buffer, location
- }
-;
-one_string_constant:
-/* Don't concat multiple strings. For asm templates. */
- CST_STRING {intlist_to_string (fst $1) }
-;
-string_list:
- one_string {
- let queue = Queue.create () in
- Queue.add (fst $1) queue;
- queue, snd $1
- }
-| string_list one_string {
- Queue.add (fst $2) (fst $1);
- $1
- }
-;
-
-wstring_list:
- CST_WSTRING { $1 }
-| wstring_list one_string { (fst $1) @ (fst $2), snd $1 }
-| wstring_list CST_WSTRING { (fst $1) @ (fst $2), snd $1 }
-/* Only the first string in the list needs an L, so L"a" "b" is the same
- * as L"ab" or L"a" L"b". */
-
-one_string:
- CST_STRING {$1}
-| FUNCTION__ {(Cabs.explodeStringToInts
- !currentFunctionName), $1}
-| PRETTY_FUNCTION__ {(Cabs.explodeStringToInts
- !currentFunctionName), $1}
-;
-
-init_expression:
- expression { SINGLE_INIT (fst $1) }
-| LBRACE initializer_list_opt RBRACE
- { COMPOUND_INIT $2}
-
-initializer_list: /* ISO 6.7.8. Allow a trailing COMMA */
- initializer { [$1] }
-| initializer COMMA initializer_list_opt { $1 :: $3 }
-;
-initializer_list_opt:
- /* empty */ { [] }
-| initializer_list { $1 }
-;
-initializer:
- init_designators eq_opt init_expression { ($1, $3) }
-| gcc_init_designators init_expression { ($1, $2) }
-| init_expression { (NEXT_INIT, $1) }
-;
-eq_opt:
- EQ { () }
- /*(* GCC allows missing = *)*/
-| /*(* empty *)*/ { () }
-;
-init_designators:
- DOT id_or_typename init_designators_opt { INFIELD_INIT($2, $3) }
-| LBRACKET expression RBRACKET init_designators_opt
- { ATINDEX_INIT(fst $2, $4) }
-| LBRACKET expression ELLIPSIS expression RBRACKET
- { ATINDEXRANGE_INIT(fst $2, fst $4) }
-;
-init_designators_opt:
- /* empty */ { NEXT_INIT }
-| init_designators { $1 }
-;
-
-gcc_init_designators: /*(* GCC supports these strange things *)*/
- id_or_typename COLON { INFIELD_INIT($1, NEXT_INIT) }
-;
-
-arguments:
- /* empty */ { [] }
-| comma_expression { fst $1 }
-;
-
-opt_expression:
- /* empty */
- {NOTHING}
-| comma_expression
- {smooth_expression (fst $1)}
-;
-
-comma_expression:
- expression {[fst $1], snd $1}
-| expression COMMA comma_expression { fst $1 :: fst $3, snd $1 }
-| error COMMA comma_expression { $3 }
-;
-
-comma_expression_opt:
- /* empty */ { NOTHING }
-| comma_expression { smooth_expression (fst $1) }
-;
-
-paren_comma_expression:
- LPAREN comma_expression RPAREN { $2 }
-| LPAREN error RPAREN { [], $1 }
-;
-
-bracket_comma_expression:
- LBRACKET comma_expression RBRACKET { fst $2 }
-| LBRACKET error RBRACKET { [] }
-;
-
-
-/*** statements ***/
-block: /* ISO 6.8.2 */
- block_begin local_labels block_attrs block_element_list RBRACE
- {!Lexerhack.pop_context();
- { blabels = $2;
- battrs = $3;
- bstmts = $4 },
- $1, $5
- }
-| error location RBRACE { { blabels = [];
- battrs = [];
- bstmts = [] },
- $2, $3
- }
-;
-block_begin:
- LBRACE {!Lexerhack.push_context (); $1}
-;
-
-block_attrs:
- /* empty */ { [] }
-| BLOCKATTRIBUTE paren_attr_list_ne
- { [("__blockattribute__", $2)] }
-;
-
-/* statements and declarations in a block, in any order (for C99 support) */
-block_element_list:
- /* empty */ { [] }
-| declaration block_element_list { DEFINITION($1) :: $2 }
-| statement block_element_list { $1 :: $2 }
-/*(* GCC accepts a label at the end of a block *)*/
-| IDENT COLON { [ LABEL (fst $1, NOP (snd $1),
- snd $1)] }
-| pragma block_element_list { $2 }
-;
-
-local_labels:
- /* empty */ { [] }
-| LABEL__ local_label_names SEMICOLON local_labels { $2 @ $4 }
-;
-local_label_names:
- IDENT { [ fst $1 ] }
-| IDENT COMMA local_label_names { fst $1 :: $3 }
-;
-
-
-
-statement:
- SEMICOLON {NOP ((*handleLoc*) $1) }
-| comma_expression SEMICOLON
- {COMPUTATION (smooth_expression (fst $1), (*handleLoc*)(snd $1))}
-| block {BLOCK (fst3 $1, (*handleLoc*)(snd3 $1))}
-| IF paren_comma_expression statement %prec IF
- {IF (smooth_expression (fst $2), $3, NOP $1, $1)}
-| IF paren_comma_expression statement ELSE statement
- {IF (smooth_expression (fst $2), $3, $5, (*handleLoc*) $1)}
-| SWITCH paren_comma_expression statement
- {SWITCH (smooth_expression (fst $2), $3, (*handleLoc*) $1)}
-| WHILE paren_comma_expression statement
- {WHILE (smooth_expression (fst $2), $3, (*handleLoc*) $1)}
-| DO statement WHILE paren_comma_expression SEMICOLON
- {DOWHILE (smooth_expression (fst $4), $2, (*handleLoc*) $1)}
-| FOR LPAREN for_clause opt_expression
- SEMICOLON opt_expression RPAREN statement
- {FOR ($3, $4, $6, $8, (*handleLoc*) $1)}
-| IDENT COLON statement
- {LABEL (fst $1, $3, (*handleLoc*) (snd $1))}
-| CASE expression COLON statement
- {CASE (fst $2, $4, (*handleLoc*) $1)}
-| CASE expression ELLIPSIS expression COLON statement
- {CASERANGE (fst $2, fst $4, $6, (*handleLoc*) $1)}
-| DEFAULT COLON
- {DEFAULT (NOP $1, (*handleLoc*) $1)}
-| RETURN SEMICOLON {RETURN (NOTHING, (*handleLoc*) $1)}
-| RETURN comma_expression SEMICOLON
- {RETURN (smooth_expression (fst $2), (*handleLoc*) $1)}
-| BREAK SEMICOLON {BREAK ((*handleLoc*) $1)}
-| CONTINUE SEMICOLON {CONTINUE ((*handleLoc*) $1)}
-| GOTO IDENT SEMICOLON
- {GOTO (fst $2, (*handleLoc*) $1)}
-| GOTO STAR comma_expression SEMICOLON
- { COMPGOTO (smooth_expression (fst $3), (*handleLoc*) $1) }
-| ASM asmattr LPAREN asmtemplate asmoutputs RPAREN SEMICOLON
- { ASM ($2, $4, $5, (*handleLoc*) $1) }
-| MSASM { ASM ([], [fst $1], None, (*handleLoc*)(snd $1))}
-| TRY block EXCEPT paren_comma_expression block
- { let b, _, _ = $2 in
- let h, _, _ = $5 in
- if not !Cprint.msvcMode then
- parse_error "try/except in GCC code";
- TRY_EXCEPT (b, COMMA (fst $4), h, (*handleLoc*) $1) }
-| TRY block FINALLY block
- { let b, _, _ = $2 in
- let h, _, _ = $4 in
- if not !Cprint.msvcMode then
- parse_error "try/finally in GCC code";
- TRY_FINALLY (b, h, (*handleLoc*) $1) }
-
-| error location SEMICOLON { (NOP $2)}
-;
-
-
-for_clause:
- opt_expression SEMICOLON { FC_EXP $1 }
-| declaration { FC_DECL $1 }
-;
-
-declaration: /* ISO 6.7.*/
- decl_spec_list init_declarator_list SEMICOLON
- { doDeclaration ((*handleLoc*)(snd $1)) (fst $1) $2 }
-| decl_spec_list SEMICOLON
- { doDeclaration ((*handleLoc*)(snd $1)) (fst $1) [] }
-;
-init_declarator_list: /* ISO 6.7 */
- init_declarator { [$1] }
-| init_declarator COMMA init_declarator_list { $1 :: $3 }
-
-;
-init_declarator: /* ISO 6.7 */
- declarator { ($1, NO_INIT) }
-| declarator EQ init_expression
- { ($1, $3) }
-;
-
-decl_spec_list: /* ISO 6.7 */
- /* ISO 6.7.1 */
-| TYPEDEF decl_spec_list_opt { SpecTypedef :: $2, $1 }
-| EXTERN decl_spec_list_opt { SpecStorage EXTERN :: $2, $1 }
-| STATIC decl_spec_list_opt { SpecStorage STATIC :: $2, $1 }
-| AUTO decl_spec_list_opt { SpecStorage AUTO :: $2, $1 }
-| REGISTER decl_spec_list_opt { SpecStorage REGISTER :: $2, $1}
- /* ISO 6.7.2 */
-| type_spec decl_spec_list_opt_no_named { SpecType (fst $1) :: $2, snd $1 }
- /* ISO 6.7.4 */
-| INLINE decl_spec_list_opt { SpecInline :: $2, $1 }
-| cvspec decl_spec_list_opt { (fst $1) :: $2, snd $1 }
-| attribute_nocv decl_spec_list_opt { SpecAttr (fst $1) :: $2, snd $1 }
-/* specifier pattern variable (must be last in spec list) */
-| AT_SPECIFIER LPAREN IDENT RPAREN { [ SpecPattern(fst $3) ], $1 }
-;
-/* (* In most cases if we see a NAMED_TYPE we must shift it. Thus we declare
- * NAMED_TYPE to have right associativity *) */
-decl_spec_list_opt:
- /* empty */ { [] } %prec NAMED_TYPE
-| decl_spec_list { fst $1 }
-;
-/* (* We add this separate rule to handle the special case when an appearance
- * of NAMED_TYPE should not be considered as part of the specifiers but as
- * part of the declarator. IDENT has higher precedence than NAMED_TYPE *)
- */
-decl_spec_list_opt_no_named:
- /* empty */ { [] } %prec IDENT
-| decl_spec_list { fst $1 }
-;
-type_spec: /* ISO 6.7.2 */
- VOID { Tvoid, $1}
-| CHAR { Tchar, $1 }
-| SHORT { Tshort, $1 }
-| INT { Tint, $1 }
-| LONG { Tlong, $1 }
-| INT64 { Tint64, $1 }
-| FLOAT { Tfloat, $1 }
-| DOUBLE { Tdouble, $1 }
-| SIGNED { Tsigned, $1 }
-| UNSIGNED { Tunsigned, $1 }
-| STRUCT id_or_typename
- { Tstruct ($2, None, []), $1 }
-| STRUCT just_attributes id_or_typename
- { Tstruct ($3, None, $2), $1 }
-| STRUCT id_or_typename LBRACE struct_decl_list RBRACE
- { Tstruct ($2, Some $4, []), $1 }
-| STRUCT LBRACE struct_decl_list RBRACE
- { Tstruct ("", Some $3, []), $1 }
-| STRUCT just_attributes id_or_typename LBRACE struct_decl_list RBRACE
- { Tstruct ($3, Some $5, $2), $1 }
-| STRUCT just_attributes LBRACE struct_decl_list RBRACE
- { Tstruct ("", Some $4, $2), $1 }
-| UNION id_or_typename
- { Tunion ($2, None, []), $1 }
-| UNION id_or_typename LBRACE struct_decl_list RBRACE
- { Tunion ($2, Some $4, []), $1 }
-| UNION LBRACE struct_decl_list RBRACE
- { Tunion ("", Some $3, []), $1 }
-| UNION just_attributes id_or_typename LBRACE struct_decl_list RBRACE
- { Tunion ($3, Some $5, $2), $1 }
-| UNION just_attributes LBRACE struct_decl_list RBRACE
- { Tunion ("", Some $4, $2), $1 }
-| ENUM id_or_typename
- { Tenum ($2, None, []), $1 }
-| ENUM id_or_typename LBRACE enum_list maybecomma RBRACE
- { Tenum ($2, Some $4, []), $1 }
-| ENUM LBRACE enum_list maybecomma RBRACE
- { Tenum ("", Some $3, []), $1 }
-| ENUM just_attributes id_or_typename LBRACE enum_list maybecomma RBRACE
- { Tenum ($3, Some $5, $2), $1 }
-| ENUM just_attributes LBRACE enum_list maybecomma RBRACE
- { Tenum ("", Some $4, $2), $1 }
-| NAMED_TYPE { Tnamed (fst $1), snd $1 }
-| TYPEOF LPAREN expression RPAREN { TtypeofE (fst $3), $1 }
-| TYPEOF LPAREN type_name RPAREN { let s, d = $3 in
- TtypeofT (s, d), $1 }
-;
-struct_decl_list: /* (* ISO 6.7.2. Except that we allow empty structs. We
- * also allow missing field names. *)
- */
- /* empty */ { [] }
-| decl_spec_list SEMICOLON struct_decl_list
- { (fst $1,
- [(missingFieldDecl, None)]) :: $3 }
-/*(* GCC allows extra semicolons *)*/
-| SEMICOLON struct_decl_list
- { $2 }
-| decl_spec_list field_decl_list SEMICOLON struct_decl_list
- { (fst $1, $2)
- :: $4 }
-/*(* MSVC allows pragmas in strange places *)*/
-| pragma struct_decl_list { $2 }
-
-| error SEMICOLON struct_decl_list
- { $3 }
-;
-field_decl_list: /* (* ISO 6.7.2 *) */
- field_decl { [$1] }
-| field_decl COMMA field_decl_list { $1 :: $3 }
-;
-field_decl: /* (* ISO 6.7.2. Except that we allow unnamed fields. *) */
-| declarator { ($1, None) }
-| declarator COLON expression { ($1, Some (fst $3)) }
-| COLON expression { (missingFieldDecl, Some (fst $2)) }
-;
-
-enum_list: /* (* ISO 6.7.2.2 *) */
- enumerator {[$1]}
-| enum_list COMMA enumerator {$1 @ [$3]}
-| enum_list COMMA error { $1 }
-;
-enumerator:
- IDENT {(fst $1, NOTHING, snd $1)}
-| IDENT EQ expression {(fst $1, fst $3, snd $1)}
-;
-
-
-declarator: /* (* ISO 6.7.5. Plus Microsoft declarators.*) */
- pointer_opt direct_decl attributes_with_asm
- { let (n, decl) = $2 in
- (n, applyPointer (fst $1) decl, $3, (*(*handleLoc*)*)(snd $1)) }
-;
-
-
-direct_decl: /* (* ISO 6.7.5 *) */
- /* (* We want to be able to redefine named
- * types as variable names *) */
-| id_or_typename { ($1, JUSTBASE) }
-
-| LPAREN attributes declarator RPAREN
- { let (n,decl,al,loc) = $3 in
- (n, PARENTYPE($2,decl,al)) }
-
-| direct_decl LBRACKET attributes comma_expression_opt RBRACKET
- { let (n, decl) = $1 in
- (n, ARRAY(decl, $3, $4)) }
-| direct_decl LBRACKET attributes error RBRACKET
- { let (n, decl) = $1 in
- (n, ARRAY(decl, $3, NOTHING)) }
-| direct_decl parameter_list_startscope rest_par_list RPAREN
- { let (n, decl) = $1 in
- let (params, isva) = $3 in
- !Lexerhack.pop_context ();
- (n, PROTO(decl, params, isva))
- }
-;
-parameter_list_startscope:
- LPAREN { !Lexerhack.push_context () }
-;
-rest_par_list:
-| /* empty */ { ([], false) }
-| parameter_decl rest_par_list1 { let (params, isva) = $2 in
- ($1 :: params, isva)
- }
-;
-rest_par_list1:
- /* empty */ { ([], false) }
-| COMMA ELLIPSIS { ([], true) }
-| COMMA parameter_decl rest_par_list1 { let (params, isva) = $3 in
- ($2 :: params, isva)
- }
-;
-
-
-parameter_decl: /* (* ISO 6.7.5 *) */
- decl_spec_list declarator { (fst $1, $2) }
-| decl_spec_list abstract_decl { let d, a = $2 in
- (fst $1, ("", d, a, cabslu)) }
-| decl_spec_list { (fst $1, ("", JUSTBASE, [], cabslu)) }
-| LPAREN parameter_decl RPAREN { $2 }
-;
-
-/* (* Old style prototypes. Like a declarator *) */
-old_proto_decl:
- pointer_opt direct_old_proto_decl { let (n, decl, a) = $2 in
- (n, applyPointer (fst $1) decl,
- a, snd $1)
- }
-
-;
-
-direct_old_proto_decl:
- direct_decl LPAREN old_parameter_list_ne RPAREN old_pardef_list
- { let par_decl, isva = doOldParDecl $3 $5 in
- let n, decl = $1 in
- (n, PROTO(decl, par_decl, isva), [])
- }
-| direct_decl LPAREN RPAREN
- { let n, decl = $1 in
- (n, PROTO(decl, [], false), [])
- }
-
-/* (* appears sometimesm but generates a shift-reduce conflict. *)
-| LPAREN STAR direct_decl LPAREN old_parameter_list_ne RPAREN RPAREN LPAREN RPAREN old_pardef_list
- { let par_decl, isva
- = doOldParDecl $5 $10 in
- let n, decl = $3 in
- (n, PROTO(decl, par_decl, isva), [])
- }
-*/
-;
-
-old_parameter_list_ne:
-| IDENT { [fst $1] }
-| IDENT COMMA old_parameter_list_ne { let rest = $3 in
- (fst $1 :: rest) }
-;
-
-old_pardef_list:
- /* empty */ { ([], false) }
-| decl_spec_list old_pardef SEMICOLON ELLIPSIS
- { ([(fst $1, $2)], true) }
-| decl_spec_list old_pardef SEMICOLON old_pardef_list
- { let rest, isva = $4 in
- ((fst $1, $2) :: rest, isva)
- }
-;
-
-old_pardef:
- declarator { [$1] }
-| declarator COMMA old_pardef { $1 :: $3 }
-| error { [] }
-;
-
-
-pointer: /* (* ISO 6.7.5 *) */
- STAR attributes pointer_opt { $2 :: fst $3, $1 }
-;
-pointer_opt:
- /**/ { let l = currentLoc () in
- ([], l) }
-| pointer { $1 }
-;
-
-type_name: /* (* ISO 6.7.6 *) */
- decl_spec_list abstract_decl { let d, a = $2 in
- if a <> [] then begin
- parse_error "attributes in type name";
- raise Parsing.Parse_error
- end;
- (fst $1, d)
- }
-| decl_spec_list { (fst $1, JUSTBASE) }
-;
-abstract_decl: /* (* ISO 6.7.6. *) */
- pointer_opt abs_direct_decl attributes { applyPointer (fst $1) $2, $3 }
-| pointer { applyPointer (fst $1) JUSTBASE, [] }
-;
-
-abs_direct_decl: /* (* ISO 6.7.6. We do not support optional declarator for
- * functions. Plus Microsoft attributes. See the
- * discussion for declarator. *) */
-| LPAREN attributes abstract_decl RPAREN
- { let d, a = $3 in
- PARENTYPE ($2, d, a)
- }
-
-| LPAREN error RPAREN
- { JUSTBASE }
-
-| abs_direct_decl_opt LBRACKET comma_expression_opt RBRACKET
- { ARRAY($1, [], $3) }
-/*(* The next should be abs_direct_decl_opt but we get conflicts *)*/
-| abs_direct_decl parameter_list_startscope rest_par_list RPAREN
- { let (params, isva) = $3 in
- !Lexerhack.pop_context ();
- PROTO ($1, params, isva)
- }
-;
-abs_direct_decl_opt:
- abs_direct_decl { $1 }
-| /* empty */ { JUSTBASE }
-;
-function_def: /* (* ISO 6.9.1 *) */
- function_def_start block
- { let (loc, specs, decl) = $1 in
- currentFunctionName := "<__FUNCTION__ used outside any functions>";
- !Lexerhack.pop_context (); (* The context pushed by
- * announceFunctionName *)
- doFunctionDef ((*handleLoc*) loc) (trd3 $2) specs decl (fst3 $2)
- }
-
-
-function_def_start: /* (* ISO 6.9.1 *) */
- decl_spec_list declarator
- { announceFunctionName $2;
- (snd $1, fst $1, $2)
- }
-
-/* (* Old-style function prototype *) */
-| decl_spec_list old_proto_decl
- { announceFunctionName $2;
- (snd $1, fst $1, $2)
- }
-/* (* New-style function that does not have a return type *) */
-| IDENT parameter_list_startscope rest_par_list RPAREN
- { let (params, isva) = $3 in
- let fdec =
- (fst $1, PROTO(JUSTBASE, params, isva), [], snd $1) in
- announceFunctionName fdec;
- (* Default is int type *)
- let defSpec = [SpecType Tint] in
- (snd $1, defSpec, fdec)
- }
-
-/* (* No return type and old-style parameter list *) */
-| IDENT LPAREN old_parameter_list_ne RPAREN old_pardef_list
- { (* Convert pardecl to new style *)
- let pardecl, isva = doOldParDecl $3 $5 in
- (* Make the function declarator *)
- let fdec = (fst $1,
- PROTO(JUSTBASE, pardecl,isva),
- [], snd $1) in
- announceFunctionName fdec;
- (* Default is int type *)
- let defSpec = [SpecType Tint] in
- (snd $1, defSpec, fdec)
- }
-/* (* No return type and no parameters *) */
-| IDENT LPAREN RPAREN
- { (* Make the function declarator *)
- let fdec = (fst $1,
- PROTO(JUSTBASE, [], false),
- [], snd $1) in
- announceFunctionName fdec;
- (* Default is int type *)
- let defSpec = [SpecType Tint] in
- (snd $1, defSpec, fdec)
- }
-;
-
-/* const/volatile as type specifier elements */
-cvspec:
- CONST { SpecCV(CV_CONST), $1 }
-| VOLATILE { SpecCV(CV_VOLATILE), $1 }
-| RESTRICT { SpecCV(CV_RESTRICT), $1 }
-;
-
-/*** GCC attributes ***/
-attributes:
- /* empty */ { []}
-| attribute attributes { fst $1 :: $2 }
-;
-
-/* (* In some contexts we can have an inline assembly to specify the name to
- * be used for a global. We treat this as a name attribute *) */
-attributes_with_asm:
- /* empty */ { [] }
-| attribute attributes_with_asm { fst $1 :: $2 }
-| ASM LPAREN string_constant RPAREN attributes
- { ("__asm__",
- [CONSTANT(CONST_STRING (fst $3))]) :: $5 }
-;
-
-/* things like __attribute__, but no const/volatile */
-attribute_nocv:
- ATTRIBUTE LPAREN paren_attr_list_ne RPAREN
- { ("__attribute__", $3), $1 }
-/*(*
-| ATTRIBUTE_USED { ("__attribute__",
- [ VARIABLE "used" ]), $1 }
-*)*/
-| DECLSPEC paren_attr_list_ne { ("__declspec", $2), $1 }
-| MSATTR { (fst $1, []), snd $1 }
- /* ISO 6.7.3 */
-| THREAD { ("__thread",[]), $1 }
-;
-
-/* __attribute__ plus const/volatile */
-attribute:
- attribute_nocv { $1 }
-| CONST { ("const", []), $1 }
-| RESTRICT { ("restrict",[]), $1 }
-| VOLATILE { ("volatile",[]), $1 }
-;
-
-/* (* sm: I need something that just includes __attribute__ and nothing more,
- * to support them appearing between the 'struct' keyword and the type name.
- * Actually, a declspec can appear there as well (on MSVC) *) */
-just_attribute:
- ATTRIBUTE LPAREN paren_attr_list_ne RPAREN
- { ("__attribute__", $3) }
-| DECLSPEC paren_attr_list_ne { ("__declspec", $2) }
-;
-
-/* this can't be empty, b/c I folded that possibility into the calling
- * productions to avoid some S/R conflicts */
-just_attributes:
- just_attribute { [$1] }
-| just_attribute just_attributes { $1 :: $2 }
-;
-
-/** (* PRAGMAS and ATTRIBUTES *) ***/
-pragma:
-| PRAGMA attr PRAGMA_EOL { PRAGMA ($2, $1) }
-| PRAGMA attr SEMICOLON PRAGMA_EOL { PRAGMA ($2, $1) }
-| PRAGMA_LINE { PRAGMA (VARIABLE (fst $1),
- snd $1) }
-;
-
-/* (* We want to allow certain strange things that occur in pragmas, so we
- * cannot use directly the language of expressions *) */
-primary_attr:
- IDENT { VARIABLE (fst $1) }
- /*(* The NAMED_TYPE here creates conflicts with IDENT *)*/
-| NAMED_TYPE { VARIABLE (fst $1) }
-| LPAREN attr RPAREN { $2 }
-| IDENT IDENT { CALL(VARIABLE (fst $1), [VARIABLE (fst $2)]) }
-| CST_INT { CONSTANT(CONST_INT (fst $1)) }
-| string_constant { CONSTANT(CONST_STRING (fst $1)) }
- /*(* Const when it appears in
- * attribute lists, is translated
- * to aconst *)*/
-| CONST { VARIABLE "aconst" }
-| IDENT COLON CST_INT { VARIABLE (fst $1 ^ ":" ^ fst $3) }
-
-| CST_INT COLON CST_INT { VARIABLE (fst $1 ^ ":" ^ fst $3) }
-| DEFAULT COLON CST_INT { VARIABLE ("default:" ^ fst $3) }
-
- /*(** GCC allows this as an
- * attribute for functions,
- * synonim for noreturn **)*/
-| VOLATILE { VARIABLE ("__noreturn__") }
-;
-
-postfix_attr:
- primary_attr { $1 }
- /* (* use a VARIABLE "" so that the
- * parentheses are printed *) */
-| IDENT LPAREN RPAREN { CALL(VARIABLE (fst $1), [VARIABLE ""]) }
-| IDENT paren_attr_list_ne { CALL(VARIABLE (fst $1), $2) }
-
-| postfix_attr ARROW id_or_typename {MEMBEROFPTR ($1, $3)}
-| postfix_attr DOT id_or_typename {MEMBEROF ($1, $3)}
-;
-
-/*(* Since in attributes we use both IDENT and NAMED_TYPE as indentifiers,
- * that leads to conflicts for SIZEOF and ALIGNOF. In those cases we require
- * that their arguments be expressions, not attributes *)*/
-unary_attr:
- postfix_attr { $1 }
-| SIZEOF unary_expression {EXPR_SIZEOF (fst $2) }
-| SIZEOF LPAREN type_name RPAREN
- {let b, d = $3 in TYPE_SIZEOF (b, d)}
-
-| ALIGNOF unary_expression {EXPR_ALIGNOF (fst $2) }
-| ALIGNOF LPAREN type_name RPAREN {let b, d = $3 in TYPE_ALIGNOF (b, d)}
-| PLUS cast_attr {UNARY (PLUS, $2)}
-| MINUS cast_attr {UNARY (MINUS, $2)}
-| STAR cast_attr {UNARY (MEMOF, $2)}
-| AND cast_attr
- {UNARY (ADDROF, $2)}
-| EXCLAM cast_attr {UNARY (NOT, $2)}
-| TILDE cast_attr {UNARY (BNOT, $2)}
-;
-
-cast_attr:
- unary_attr { $1 }
-;
-
-multiplicative_attr:
- cast_attr { $1 }
-| multiplicative_attr STAR cast_attr {BINARY(MUL ,$1 , $3)}
-| multiplicative_attr SLASH cast_attr {BINARY(DIV ,$1 , $3)}
-| multiplicative_attr PERCENT cast_attr {BINARY(MOD ,$1 , $3)}
-;
-
-
-additive_attr:
- multiplicative_attr { $1 }
-| additive_attr PLUS multiplicative_attr {BINARY(ADD ,$1 , $3)}
-| additive_attr MINUS multiplicative_attr {BINARY(SUB ,$1 , $3)}
-;
-
-shift_attr:
- additive_attr { $1 }
-| shift_attr INF_INF additive_attr {BINARY(SHL ,$1 , $3)}
-| shift_attr SUP_SUP additive_attr {BINARY(SHR ,$1 , $3)}
-;
-
-relational_attr:
- shift_attr { $1 }
-| relational_attr INF shift_attr {BINARY(LT ,$1 , $3)}
-| relational_attr SUP shift_attr {BINARY(GT ,$1 , $3)}
-| relational_attr INF_EQ shift_attr {BINARY(LE ,$1 , $3)}
-| relational_attr SUP_EQ shift_attr {BINARY(GE ,$1 , $3)}
-;
-
-equality_attr:
- relational_attr { $1 }
-| equality_attr EQ_EQ relational_attr {BINARY(EQ ,$1 , $3)}
-| equality_attr EXCLAM_EQ relational_attr {BINARY(NE ,$1 , $3)}
-;
-
-
-bitwise_and_attr:
- equality_attr { $1 }
-| bitwise_and_attr AND equality_attr {BINARY(BAND ,$1 , $3)}
-;
-
-bitwise_xor_attr:
- bitwise_and_attr { $1 }
-| bitwise_xor_attr CIRC bitwise_and_attr {BINARY(XOR ,$1 , $3)}
-;
-
-bitwise_or_attr:
- bitwise_xor_attr { $1 }
-| bitwise_or_attr PIPE bitwise_xor_attr {BINARY(BOR ,$1 , $3)}
-;
-
-logical_and_attr:
- bitwise_or_attr { $1 }
-| logical_and_attr AND_AND bitwise_or_attr {BINARY(AND ,$1 , $3)}
-;
-
-logical_or_attr:
- logical_and_attr { $1 }
-| logical_or_attr PIPE_PIPE logical_and_attr {BINARY(OR ,$1 , $3)}
-;
-
-
-attr: logical_or_attr { $1 }
-;
-
-attr_list_ne:
-| attr { [$1] }
-| attr COMMA attr_list_ne { $1 :: $3 }
-| error COMMA attr_list_ne { $3 }
-;
-paren_attr_list_ne:
- LPAREN attr_list_ne RPAREN { $2 }
-| LPAREN error RPAREN { [] }
-;
-/*** GCC ASM instructions ***/
-asmattr:
- /* empty */ { [] }
-| VOLATILE asmattr { ("volatile", []) :: $2 }
-| CONST asmattr { ("const", []) :: $2 }
-;
-asmtemplate:
- one_string_constant { [$1] }
-| one_string_constant asmtemplate { $1 :: $2 }
-;
-asmoutputs:
- /* empty */ { None }
-| COLON asmoperands asminputs
- { let (ins, clobs) = $3 in
- Some {aoutputs = $2; ainputs = ins; aclobbers = clobs} }
-;
-asmoperands:
- /* empty */ { [] }
-| asmoperandsne { List.rev $1 }
-;
-asmoperandsne:
- asmoperand { [$1] }
-| asmoperandsne COMMA asmoperand { $3 :: $1 }
-;
-asmoperand:
- string_constant LPAREN expression RPAREN { (fst $1, fst $3) }
-| string_constant LPAREN error RPAREN { (fst $1, NOTHING ) }
-;
-asminputs:
- /* empty */ { ([], []) }
-| COLON asmoperands asmclobber
- { ($2, $3) }
-;
-asmclobber:
- /* empty */ { [] }
-| COLON asmcloberlst_ne { $2 }
-;
-asmcloberlst_ne:
- one_string_constant { [$1] }
-| one_string_constant COMMA asmcloberlst_ne { $1 :: $3 }
-;
-
-%%
-
-
-
diff --git a/cil/src/frontc/cprint.ml b/cil/src/frontc/cprint.ml
deleted file mode 100644
index 570945c0979e2f80420ac07f476c567b61bd8a0c..0000000000000000000000000000000000000000
--- a/cil/src/frontc/cprint.ml
+++ /dev/null
@@ -1,1014 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2003,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * Ben Liblit <liblit@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-(* cprint -- pretty printer of C program from abstract syntax
-**
-** Project: FrontC
-** File: cprint.ml
-** Version: 2.1e
-** Date: 9.1.99
-** Author: Hugues Cassé
-**
-** 1.0 2.22.99 Hugues Cassé First version.
-** 2.0 3.18.99 Hugues Cassé Compatible with Frontc 2.1, use of CAML
-** pretty printer.
-** 2.1 3.22.99 Hugues Cassé More efficient custom pretty printer used.
-** 2.1a 4.12.99 Hugues Cassé Correctly handle:
-** char *m, *m, *p; m + (n - p)
-** 2.1b 4.15.99 Hugues Cassé x + (y + z) stays x + (y + z) for
-** keeping computation order.
-** 2.1c 7.23.99 Hugues Cassé Improvement of case and default display.
-** 2.1d 8.25.99 Hugues Cassé Rebuild escape sequences in string and
-** characters.
-** 2.1e 9.1.99 Hugues Cassé Fix, recognize and correctly display '\0'.
-*)
-
-(* George Necula: I changed this pretty dramatically since CABS changed *)
-open Cabs
-open Escape
-let version = "Cprint 2.1e 9.1.99 Hugues Cassé"
-
-type loc = { line : int; file : string }
-
-let lu = {line = -1; file = "loc unknown";}
-let cabslu = {lineno = -10;
- filename = "cabs loc unknown";
- byteno = -10;}
-
-let curLoc = ref cabslu
-
-let msvcMode = ref false
-
-let printLn = ref true
-let printLnComment = ref false
-
-let printCounters = ref false
-let printComments = ref false
-
-(*
-** FrontC Pretty printer
-*)
-let out = ref stdout
-let width = ref 80
-let tab = ref 2
-let max_indent = ref 60
-
-let line = ref ""
-let line_len = ref 0
-let current = ref ""
-let current_len = ref 0
-let spaces = ref 0
-let follow = ref 0
-let roll = ref 0
-
-let print_tab size =
- for i = 1 to size / 8 do
- output_char !out '\t'
- done;
- for i = 1 to size mod 8 do
- output_char !out ' '
- done
-
-let flush _ =
- if !line <> "" then begin
- print_tab (!spaces + !follow);
- output_string !out !line;
- line := "";
- line_len := 0
- end
-
-let commit _ =
- if !current <> "" then begin
- if !line = "" then begin
- line := !current;
- line_len := !current_len
- end else begin
- line := (!line ^ " " ^ !current);
- line_len := !line_len + 1 + !current_len
- end;
- current := "";
- current_len := 0
- end
-
-
-let addline () =
- curLoc := {lineno = !curLoc.lineno+1;
- filename = !curLoc.filename;
- byteno = -1;} (*sfg: can we do better than this?*)
-
-
-let new_line _ =
- commit ();
- if !line <> "" then begin
- flush ();
- addline();
- output_char !out '\n'
- end;
- follow := 0
-
-let force_new_line _ =
- commit ();
- flush ();
- addline();
- output_char !out '\n';
- follow := 0
-
-let indent _ =
- new_line ();
- spaces := !spaces + !tab;
- if !spaces >= !max_indent then begin
- spaces := !tab;
- roll := !roll + 1
- end
-
-let indentline _ =
- new_line ();
- if !spaces >= !max_indent then begin
- spaces := !tab;
- roll := !roll + 1
- end
-
-let unindent _ =
- new_line ();
- spaces := !spaces - !tab;
- if (!spaces <= 0) && (!roll > 0) then begin
- spaces := ((!max_indent - 1) / !tab) * !tab;
- roll := !roll - 1
- end
-
-let space _ = commit ()
-
-let print str =
- current := !current ^ str;
- current_len := !current_len + (String.length str);
- if (!spaces + !follow + !line_len + 1 + !current_len) > !width
- then begin
- if !line_len = 0 then commit ();
- flush ();
- addline();
- output_char !out '\n';
- if !follow = 0 then follow := !tab
- end
-
-(* sm: for some reason I couldn't just call print from frontc.... ? *)
-let print_unescaped_string str = print str
-
-let setLoc (l : cabsloc) =
- if !printLn then
- if (l.lineno <> !curLoc.lineno) || l.filename <> !curLoc.filename then
- begin
- let oldspaces = !spaces in
- (* sm: below, we had '//#' instead of '#', which means printLnComment was disregarded *)
- if !printLnComment then print "//" else print "#";
- if !msvcMode then print "line";
- print " ";
- print (string_of_int l.lineno);
- if (l.filename <> !curLoc.filename) then begin
- print (" \"" ^ l.filename ^ "\"")
- end;
- spaces := oldspaces;
- new_line();
- curLoc := l
- end
-
-
-
-(*
-** Useful primitives
-*)
-let print_list print_sep print_elt lst =
- let _ = List.fold_left
- (fun com elt ->
- if com then print_sep ();
- print_elt elt;
- true)
- false
- lst in
- ()
-
-let print_commas nl fct lst =
- print_list (fun () -> print ","; if nl then new_line() else space()) fct lst
-
-let print_string (s:string) =
- print ("\"" ^ escape_string s ^ "\"")
-
-let print_wstring (s: int64 list ) =
- print ("L\"" ^ escape_wstring s ^ "\"")
-
-(*
-** Base Type Printing
-*)
-
-let rec print_specifiers (specs: spec_elem list) =
- comprint "specifier(";
- let print_spec_elem = function
- SpecTypedef -> print "typedef "
- | SpecInline -> print "__inline "
- | SpecStorage sto ->
- print (match sto with
- NO_STORAGE -> (comstring "/*no storage*/")
- | AUTO -> "auto "
- | STATIC -> "static "
- | EXTERN -> "extern "
- | REGISTER -> "register ")
- | SpecCV cv ->
- print (match cv with
- | CV_CONST -> "const "
- | CV_VOLATILE -> "volatile "
- | CV_RESTRICT -> "restrict ")
- | SpecAttr al -> print_attribute al; space ()
- | SpecType bt -> print_type_spec bt
- | SpecPattern name -> print ("@specifier(" ^ name ^ ") ")
- in
- List.iter print_spec_elem specs
- ;comprint ")"
-
-
-and print_type_spec = function
- Tvoid -> print "void "
- | Tchar -> print "char "
- | Tshort -> print "short "
- | Tint -> print "int "
- | Tlong -> print "long "
- | Tint64 -> print "__int64 "
- | Tfloat -> print "float "
- | Tdouble -> print "double "
- | Tsigned -> print "signed "
- | Tunsigned -> print "unsigned "
- | Tnamed s -> comprint "tnamed"; print s; space ();
- | Tstruct (n, None, _) -> print ("struct " ^ n ^ " ")
- | Tstruct (n, Some flds, extraAttrs) ->
- (print_struct_name_attr "struct" n extraAttrs);
- (print_fields flds)
- | Tunion (n, None, _) -> print ("union " ^ n ^ " ")
- | Tunion (n, Some flds, extraAttrs) ->
- (print_struct_name_attr "union" n extraAttrs);
- (print_fields flds)
- | Tenum (n, None, _) -> print ("enum " ^ n ^ " ")
- | Tenum (n, Some enum_items, extraAttrs) ->
- (print_struct_name_attr "enum" n extraAttrs);
- (print_enum_items enum_items)
- | TtypeofE e -> print "__typeof__("; print_expression e; print ") "
- | TtypeofT (s,d) -> print "__typeof__("; print_onlytype (s, d); print ") "
-
-
-(* print "struct foo", but with specified keyword and a list of
- * attributes to put between keyword and name *)
-and print_struct_name_attr (keyword: string) (name: string) (extraAttrs: attribute list) =
-begin
- if extraAttrs = [] then
- print (keyword ^ " " ^ name)
- else begin
- (print (keyword ^ " "));
- (print_attributes extraAttrs); (* prints a final space *)
- (print name);
- end
-end
-
-
-(* This is the main printer for declarations. It is easy bacause the
- * declarations are laid out as they need to be printed. *)
-and print_decl (n: string) = function
- JUSTBASE -> if n <> "___missing_field_name" then
- print n
- else
- comprint "missing field name"
- | PARENTYPE (al1, d, al2) ->
- print "(";
- print_attributes al1; space ();
- print_decl n d; space ();
- print_attributes al2; print ")"
- | PTR (al, d) ->
- print "* ";
- print_attributes al; space ();
- print_decl n d
- | ARRAY (d, al, e) ->
- print_decl n d;
- print "[";
- print_attributes al;
- if e <> NOTHING then print_expression e;
- print "]"
- | PROTO(d, args, isva) ->
- comprint "proto(";
- print_decl n d;
- print "(";
- print_params args isva;
- print ")";
- comprint ")"
-
-
-and print_fields (flds : field_group list) =
- if flds = [] then print " { } "
- else begin
- print " {";
- indent ();
- List.iter
- (fun fld -> print_field_group fld; print ";"; new_line ())
- flds;
- unindent ();
- print "} "
- end
-
-and print_enum_items items =
- if items = [] then print " { } "
- else begin
- print " {";
- indent ();
- print_commas
- true
- (fun (id, exp, loc) -> print id;
- if exp = NOTHING then ()
- else begin
- space ();
- print "= ";
- print_expression exp
- end)
- items;
- unindent ();
- print "} ";
- end
-
-
-and print_onlytype (specs, dt) =
- print_specifiers specs;
- print_decl "" dt
-
-and print_name ((n, decl, attrs, _) : name) =
- print_decl n decl;
- space ();
- print_attributes attrs
-
-and print_init_name ((n, i) : init_name) =
- print_name n;
- if i <> NO_INIT then begin
- space ();
- print "= ";
- print_init_expression i
- end
-
-and print_name_group (specs, names) =
- print_specifiers specs;
- print_commas false print_name names
-
-and print_field_group (specs, fields) =
- print_specifiers specs;
- print_commas false print_field fields
-
-
-and print_field (name, widtho) =
- print_name name;
- (match widtho with
- None -> ()
- | Some w -> print " : "; print_expression w)
-
-and print_init_name_group (specs, names) =
- print_specifiers specs;
- print_commas false print_init_name names
-
-and print_single_name (specs, name) =
- print_specifiers specs;
- print_name name
-
-and print_params (pars : single_name list) (ell : bool) =
- print_commas false print_single_name pars;
- if ell then print (if pars = [] then "..." else ", ...") else ()
-
-and print_old_params pars ell =
- print_commas false (fun id -> print id) pars;
- if ell then print (if pars = [] then "..." else ", ...") else ()
-
-
-(*
-** Expression printing
-** Priorities
-** 16 variables
-** 15 . -> [] call()
-** 14 ++, -- (post)
-** 13 ++ -- (pre) ~ ! - + & *(cast)
-** 12 * / %
-** 11 + -
-** 10 << >>
-** 9 < <= > >=
-** 8 == !=
-** 7 &
-** 6 ^
-** 5 |
-** 4 &&
-** 3 ||
-** 2 ? :
-** 1 = ?=
-** 0 ,
-*)
-and get_operator exp =
- match exp with
- NOTHING -> ("", 16)
- | UNARY (op, _) ->
- (match op with
- MINUS -> ("-", 13)
- | PLUS -> ("+", 13)
- | NOT -> ("!", 13)
- | BNOT -> ("~", 13)
- | MEMOF -> ("*", 13)
- | ADDROF -> ("&", 13)
- | PREINCR -> ("++", 13)
- | PREDECR -> ("--", 13)
- | POSINCR -> ("++", 14)
- | POSDECR -> ("--", 14))
- | LABELADDR s -> ("", 16) (* Like a constant *)
- | BINARY (op, _, _) ->
- (match op with
- MUL -> ("*", 12)
- | DIV -> ("/", 12)
- | MOD -> ("%", 12)
- | ADD -> ("+", 11)
- | SUB -> ("-", 11)
- | SHL -> ("<<", 10)
- | SHR -> (">>", 10)
- | LT -> ("<", 9)
- | LE -> ("<=", 9)
- | GT -> (">", 9)
- | GE -> (">=", 9)
- | EQ -> ("==", 8)
- | NE -> ("!=", 8)
- | BAND -> ("&", 7)
- | XOR -> ("^", 6)
- | BOR -> ("|", 5)
- | AND -> ("&&", 4)
- | OR -> ("||", 3)
- | ASSIGN -> ("=", 1)
- | ADD_ASSIGN -> ("+=", 1)
- | SUB_ASSIGN -> ("-=", 1)
- | MUL_ASSIGN -> ("*=", 1)
- | DIV_ASSIGN -> ("/=", 1)
- | MOD_ASSIGN -> ("%=", 1)
- | BAND_ASSIGN -> ("&=", 1)
- | BOR_ASSIGN -> ("|=", 1)
- | XOR_ASSIGN -> ("^=", 1)
- | SHL_ASSIGN -> ("<<=", 1)
- | SHR_ASSIGN -> (">>=", 1))
- | QUESTION _ -> ("", 2)
- | CAST _ -> ("", 13)
- | CALL _ -> ("", 15)
- | COMMA _ -> ("", 0)
- | CONSTANT _ -> ("", 16)
- | VARIABLE name -> ("", 16)
- | EXPR_SIZEOF exp -> ("", 16)
- | TYPE_SIZEOF _ -> ("", 16)
- | EXPR_ALIGNOF exp -> ("", 16)
- | TYPE_ALIGNOF _ -> ("", 16)
- | INDEX (exp, idx) -> ("", 15)
- | MEMBEROF (exp, fld) -> ("", 15)
- | MEMBEROFPTR (exp, fld) -> ("", 15)
- | GNU_BODY _ -> ("", 17)
- | EXPR_PATTERN _ -> ("", 16) (* sm: not sure about this *)
-
-and print_comma_exps exps =
- print_commas false print_expression exps
-
-and print_init_expression (iexp: init_expression) : unit =
- match iexp with
- NO_INIT -> ()
- | SINGLE_INIT e -> print_expression e
- | COMPOUND_INIT initexps ->
- let doinitexp = function
- NEXT_INIT, e -> print_init_expression e
- | i, e ->
- let rec doinit = function
- NEXT_INIT -> ()
- | INFIELD_INIT (fn, i) -> print ("." ^ fn); doinit i
- | ATINDEX_INIT (e, i) ->
- print "[";
- print_expression e;
- print "]";
- doinit i
- | ATINDEXRANGE_INIT (s, e) ->
- print "[";
- print_expression s;
- print " ... ";
- print_expression e;
- print "]"
- in
- doinit i; print " = ";
- print_init_expression e
- in
- print "{";
- print_commas false doinitexp initexps;
- print "}"
-
-and print_expression (exp: expression) = print_expression_level 1 exp
-
-and print_expression_level (lvl: int) (exp : expression) =
- let (txt, lvl') = get_operator exp in
- let _ = if lvl > lvl' then print "(" else () in
- let _ = match exp with
- NOTHING -> ()
- | UNARY (op, exp') ->
- (match op with
- POSINCR | POSDECR ->
- print_expression_level lvl' exp';
- print txt
- | _ ->
- print txt; space (); (* Print the space to avoid --5 *)
- print_expression_level lvl' exp')
- | LABELADDR l -> print ("&& " ^ l)
- | BINARY (op, exp1, exp2) ->
- (*if (op = SUB) && (lvl <= lvl') then print "(";*)
- print_expression_level lvl' exp1;
- space ();
- print txt;
- space ();
- (*print_expression exp2 (if op = SUB then (lvl' + 1) else lvl');*)
- print_expression_level (lvl' + 1) exp2
- (*if (op = SUB) && (lvl <= lvl') then print ")"*)
- | QUESTION (exp1, exp2, exp3) ->
- print_expression_level 2 exp1;
- space ();
- print "? ";
- print_expression_level 2 exp2;
- space ();
- print ": ";
- print_expression_level 2 exp3;
- | CAST (typ, iexp) ->
- print "(";
- print_onlytype typ;
- print ")";
- (* Always print parentheses. In a small number of cases when we print
- * constants we don't need them *)
- (match iexp with
- SINGLE_INIT e -> print_expression_level 15 e
- | COMPOUND_INIT _ -> (* print "("; *)
- print_init_expression iexp
- (* ; print ")" *)
- | NO_INIT -> print "<NO_INIT in cast. Should never arise>")
-
- | CALL (VARIABLE "__builtin_va_arg", [arg; TYPE_SIZEOF (bt, dt)]) ->
- comprint "variable";
- print "__builtin_va_arg";
- print "(";
- print_expression_level 1 arg;
- print ",";
- print_onlytype (bt, dt);
- print ")"
- | CALL (exp, args) ->
- print_expression_level 16 exp;
- print "(";
- print_comma_exps args;
- print ")"
- | COMMA exps ->
- print_comma_exps exps
- | CONSTANT cst ->
- (match cst with
- CONST_INT i -> print i
- | CONST_FLOAT r -> print r
- | CONST_CHAR c -> print ("'" ^ escape_wstring c ^ "'")
- | CONST_WCHAR c -> print ("L'" ^ escape_wstring c ^ "'")
- | CONST_STRING s -> print_string s
- | CONST_WSTRING ws -> print_wstring ws)
- | VARIABLE name ->
- comprint "variable";
- print name
- | EXPR_SIZEOF exp ->
- print "sizeof(";
- print_expression_level 0 exp;
- print ")"
- | TYPE_SIZEOF (bt,dt) ->
- print "sizeof(";
- print_onlytype (bt, dt);
- print ")"
- | EXPR_ALIGNOF exp ->
- print "__alignof__(";
- print_expression_level 0 exp;
- print ")"
- | TYPE_ALIGNOF (bt,dt) ->
- print "__alignof__(";
- print_onlytype (bt, dt);
- print ")"
- | INDEX (exp, idx) ->
- print_expression_level 16 exp;
- print "[";
- print_expression_level 0 idx;
- print "]"
- | MEMBEROF (exp, fld) ->
- print_expression_level 16 exp;
- print ("." ^ fld)
- | MEMBEROFPTR (exp, fld) ->
- print_expression_level 16 exp;
- print ("->" ^ fld)
- | GNU_BODY (blk) ->
- print "(";
- print_block blk;
- print ")"
- | EXPR_PATTERN (name) ->
- print ("@expr(" ^ name ^ ") ")
- in
- if lvl > lvl' then print ")" else ()
-
-
-(*
-** Statement printing
-*)
-and print_statement stat =
- match stat with
- NOP (loc) ->
- setLoc(loc);
- print ";";
- new_line ()
- | COMPUTATION (exp, loc) ->
- setLoc(loc);
- print_expression exp;
- print ";";
- new_line ()
- | BLOCK (blk, loc) -> print_block blk
-
- | SEQUENCE (s1, s2, loc) ->
- setLoc(loc);
- print_statement s1;
- print_statement s2;
- | IF (exp, s1, s2, loc) ->
- setLoc(loc);
- print "if(";
- print_expression_level 0 exp;
- print ")";
- print_substatement s1;
- (match s2 with
- | NOP(_) -> ()
- | _ -> begin
- print "else";
- print_substatement s2;
- end)
- | WHILE (exp, stat, loc) ->
- setLoc(loc);
- print "while(";
- print_expression_level 0 exp;
- print ")";
- print_substatement stat
- | DOWHILE (exp, stat, loc) ->
- setLoc(loc);
- print "do";
- print_substatement stat;
- print "while(";
- print_expression_level 0 exp;
- print ");";
- new_line ();
- | FOR (fc1, exp2, exp3, stat, loc) ->
- setLoc(loc);
- print "for(";
- (match fc1 with
- FC_EXP exp1 -> print_expression_level 0 exp1; print ";"
- | FC_DECL dec1 -> print_def dec1);
- space ();
- print_expression_level 0 exp2;
- print ";";
- space ();
- print_expression_level 0 exp3;
- print ")";
- print_substatement stat
- | BREAK (loc)->
- setLoc(loc);
- print "break;"; new_line ()
- | CONTINUE (loc) ->
- setLoc(loc);
- print "continue;"; new_line ()
- | RETURN (exp, loc) ->
- setLoc(loc);
- print "return";
- if exp = NOTHING
- then ()
- else begin
- print " ";
- print_expression_level 1 exp
- end;
- print ";";
- new_line ()
- | SWITCH (exp, stat, loc) ->
- setLoc(loc);
- print "switch(";
- print_expression_level 0 exp;
- print ")";
- print_substatement stat
- | CASE (exp, stat, loc) ->
- setLoc(loc);
- unindent ();
- print "case ";
- print_expression_level 1 exp;
- print ":";
- indent ();
- print_substatement stat
- | CASERANGE (expl, exph, stat, loc) ->
- setLoc(loc);
- unindent ();
- print "case ";
- print_expression expl;
- print " ... ";
- print_expression exph;
- print ":";
- indent ();
- print_substatement stat
- | DEFAULT (stat, loc) ->
- setLoc(loc);
- unindent ();
- print "default :";
- indent ();
- print_substatement stat
- | LABEL (name, stat, loc) ->
- setLoc(loc);
- print (name ^ ":");
- space ();
- print_substatement stat
- | GOTO (name, loc) ->
- setLoc(loc);
- print ("goto " ^ name ^ ";");
- new_line ()
- | COMPGOTO (exp, loc) ->
- setLoc(loc);
- print ("goto *"); print_expression exp; print ";"; new_line ()
- | DEFINITION d ->
- print_def d
- | ASM (attrs, tlist, details, loc) ->
- setLoc(loc);
- let print_asm_operand (cnstr, e) =
- print_string cnstr; space (); print_expression_level 100 e
- in
- if !msvcMode then begin
- print "__asm {";
- print_list (fun () -> new_line()) print tlist; (* templates *)
- print "};"
- end else begin
- print "__asm__ ";
- print_attributes attrs;
- print "(";
- print_list (fun () -> new_line()) print_string tlist; (* templates *)
- begin
- match details with
- | None -> ()
- | Some { aoutputs = outs; ainputs = ins; aclobbers = clobs } ->
- print ":"; space ();
- print_commas false print_asm_operand outs;
- if ins <> [] || clobs <> [] then begin
- print ":"; space ();
- print_commas false print_asm_operand ins;
- if clobs <> [] then begin
- print ":"; space ();
- print_commas false print_string clobs
- end;
- end
- end;
- print ");"
- end;
- new_line ()
- | TRY_FINALLY (b, h, loc) ->
- setLoc loc;
- print "__try ";
- print_block b;
- print "__finally ";
- print_block h
-
- | TRY_EXCEPT (b, e, h, loc) ->
- setLoc loc;
- print "__try ";
- print_block b;
- print "__except("; print_expression e; print ")";
- print_block h
-
-and print_block blk =
- new_line();
- print "{";
- indent ();
- if blk.blabels <> [] then begin
- print "__label__ ";
- print_commas false print blk.blabels;
- print ";";
- new_line ();
- end;
- if blk.battrs <> [] then begin
- List.iter print_attribute blk.battrs;
- new_line ();
- end;
- List.iter print_statement blk.bstmts;
- unindent ();
- print "}";
- new_line ()
-
-and print_substatement stat =
- match stat with
- IF _
- | SEQUENCE _
- | DOWHILE _ ->
- new_line ();
- print "{";
- indent ();
- print_statement stat;
- unindent ();
- print "}";
- new_line ();
- | BLOCK _ ->
- print_statement stat
- | _ ->
- indent ();
- print_statement stat;
- unindent ()
-
-
-(*
-** GCC Attributes
-*)
-and print_attribute (name,args) =
- if args = [] then print (
- match name with
- "restrict" -> "__restrict"
- (* weimer: Fri Dec 7 17:12:35 2001
- * must not print 'restrict' and the code below does allows some
- * plain 'restrict's to slip though! *)
- | x -> x)
- else begin
- print name;
- print "("; if name = "__attribute__" then print "(";
- (match args with
- [VARIABLE "aconst"] -> print "const"
- | [VARIABLE "restrict"] -> print "__restrict"
- | _ -> print_commas false (fun e -> print_expression e) args);
- print ")"; if name = "__attribute__" then print ")"
- end
-
-(* Print attributes. *)
-and print_attributes attrs =
- List.iter (fun a -> print_attribute a; space ()) attrs
-
-(*
-** Declaration printing
-*)
-and print_defs defs =
- let prev = ref false in
- List.iter
- (fun def ->
- (match def with
- DECDEF _ -> prev := false
- | _ ->
- if not !prev then force_new_line ();
- prev := true);
- print_def def)
- defs
-
-and print_def def =
- match def with
- FUNDEF (proto, body, loc, _) ->
- comprint "fundef";
- if !printCounters then begin
- try
- let fname =
- match proto with
- (_, (n, _, _, _)) -> n
- in
- print_def (DECDEF (([SpecType Tint],
- [(fname ^ "__counter", JUSTBASE, [], cabslu),
- NO_INIT]), loc));
- with Not_found -> print "/* can't print the counter */"
- end;
- setLoc(loc);
- print_single_name proto;
- print_block body;
- force_new_line ();
-
- | DECDEF (names, loc) ->
- comprint "decdef";
- setLoc(loc);
- print_init_name_group names;
- print ";";
- new_line ()
-
- | TYPEDEF (names, loc) ->
- comprint "typedef";
- setLoc(loc);
- print_name_group names;
- print ";";
- new_line ();
- force_new_line ()
-
- | ONLYTYPEDEF (specs, loc) ->
- comprint "onlytypedef";
- setLoc(loc);
- print_specifiers specs;
- print ";";
- new_line ();
- force_new_line ()
-
- | GLOBASM (asm, loc) ->
- setLoc(loc);
- print "__asm__ ("; print_string asm; print ");";
- new_line ();
- force_new_line ()
-
- | PRAGMA (a,loc) ->
- setLoc(loc);
- force_new_line ();
- print "#pragma ";
- let oldwidth = !width in
- width := 1000000; (* Do not wrap pragmas *)
- print_expression a;
- width := oldwidth;
- force_new_line ()
-
- | LINKAGE (n, loc, dl) ->
- setLoc (loc);
- force_new_line ();
- print "extern "; print_string n; print_string " {";
- List.iter print_def dl;
- print_string "}";
- force_new_line ()
-
- | TRANSFORMER(srcdef, destdeflist, loc) ->
- setLoc(loc);
- print "@transform {";
- force_new_line();
- print "{";
- force_new_line();
- indent ();
- print_def srcdef;
- unindent();
- print "}";
- force_new_line();
- print "to {";
- force_new_line();
- indent();
- List.iter print_def destdeflist;
- unindent();
- print "}";
- force_new_line()
-
- | EXPRTRANSFORMER(srcexpr, destexpr, loc) ->
- setLoc(loc);
- print "@transformExpr { ";
- print_expression srcexpr;
- print " } to { ";
- print_expression destexpr;
- print " }";
- force_new_line()
-
-
-(* sm: print a comment if the printComments flag is set *)
-and comprint (str : string) : unit =
-begin
- if (!printComments) then (
- print "/*";
- print str;
- print "*/ "
- )
- else
- ()
-end
-
-(* sm: yield either the given string, or "", depending on printComments *)
-and comstring (str : string) : string =
-begin
- if (!printComments) then
- str
- else
- ""
-end
-
-
-(* print abstrac_syntax -> ()
-** Pretty printing the given abstract syntax program.
-*)
-let printFile (result : out_channel) ((fname, defs) : file) =
- out := result;
- print_defs defs;
- flush () (* sm: should do this here *)
-
-let set_tab t = tab := t
-let set_width w = width := w
-
diff --git a/cil/src/frontc/frontc.ml b/cil/src/frontc/frontc.ml
deleted file mode 100644
index 459ae2c34c32dd3493e5451c93e74a3d006a3106..0000000000000000000000000000000000000000
--- a/cil/src/frontc/frontc.ml
+++ /dev/null
@@ -1,256 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-
-module E = Errormsg
-open Trace
-open Pretty
-
-(* Output management *)
-let out : out_channel option ref = ref None
-let close_me = ref false
-
-let close_output _ =
- match !out with
- None -> ()
- | Some o -> begin
- flush o;
- if !close_me then close_out o else ();
- close_me := false
- end
-
-let set_output filename =
- close_output ();
- (try out := Some (open_out filename)
- with (Sys_error msg) ->
- output_string stderr ("Error while opening output: " ^ msg); exit 1);
- close_me := true
-
- (* Signal that we are in MS VC mode *)
-let setMSVCMode () =
- Cprint.msvcMode := true
-
-(* filename for patching *)
-let patchFileName : string ref = ref "" (* by default do no patching *)
-
-(* patching file contents *)
-let patchFile : Cabs.file option ref = ref None
-
-(* whether to print the patched CABS files *)
-let printPatchedFiles : bool ref = ref false
-
-(* whether to print a file of prototypes after parsing *)
-let doPrintProtos : bool ref = ref false
-
-(* this seems like something that should be built-in.. *)
-let isNone (o : 'a option) : bool =
-begin
- match o with
- | Some _ -> false
- | None -> true
-end
-
-(*
-** Argument definition
-*)
-let args : (string * Arg.spec * string) list =
-[
- "--cabsonly", Arg.String set_output, "<fname>: CABS output file name";
- "--printComments", Arg.Unit (fun _ -> Cprint.printComments := true),
- ": print cabs tree structure in comments in cabs output";
- "--patchFile", Arg.String (fun pf -> patchFileName := pf),
- "<fname>: name the file containing patching transformations";
- "--printPatched", Arg.Unit (fun _ -> printPatchedFiles := true),
- ": print patched CABS files after patching, to *.patched";
- "--printProtos", Arg.Unit (fun _ -> doPrintProtos := true),
- ": print prototypes to safec.proto.h after parsing";
-]
-
-exception ParseError of string
-exception CabsOnly
-
-(* parse, and apply patching *)
-let rec parse_to_cabs fname =
-begin
- (* parse the patch file if it isn't parsed already *)
- if ((!patchFileName <> "") && (isNone !patchFile)) then (
- (* parse the patch file *)
- patchFile := Some(parse_to_cabs_inner !patchFileName);
- if !E.hadErrors then
- (failwith "There were parsing errors in the patch file")
- );
-
- (* now parse the file we came here to parse *)
- let cabs = parse_to_cabs_inner fname in
- if !E.hadErrors then
- E.s (E.error "There were parsing errors in %s\n" fname);
-
- (* and apply the patch file, return transformed file *)
- let patched = match !patchFile with
-
- | Some(pf) -> (
- (* save old value of out so I can use it for debugging during patching *)
- let oldOut = !out in
-
- (* reset out so we don't try to print the patch file to it *)
- out := None;
-
- (trace "patch" (dprintf "newpatching %s\n" fname));
- let result = (Stats.time "newpatch" (Patch.applyPatch pf) cabs) in
-
- if (!printPatchedFiles) then begin
- let outFname:string = fname ^ ".patched" in
- (trace "patch" (dprintf "printing patched version of %s to %s\n"
- fname outFname));
- let o = (open_out outFname) in
- (Cprint.printFile o result);
- (close_out o)
- end;
-
- (* restore out *)
- Cprint.flush ();
- out := oldOut;
-
- result
- )
- | None -> cabs
- in
-
- (* print it ... *)
- (match !out with
- Some o -> begin
- (trace "sm" (dprintf "writing the cabs output\n"));
- output_string o ("/* Generated by Frontc */\n");
- Stats.time "printCABS" (Cprint.printFile o) patched;
- close_output ();
- raise CabsOnly
- end
- | None -> ());
- if !E.hadErrors then
- raise Parsing.Parse_error;
-
- (* and return the patched source *)
- patched
-end
-
-
-(* just parse *)
-and parse_to_cabs_inner (fname : string) =
- try
- if !E.verboseFlag then ignore (E.log "Frontc is parsing %s\n" fname);
- flush !E.logChannel;
- E.hadErrors := false;
- let lexbuf = Clexer.init fname in
- let cabs = Stats.time "parse" (Cparser.file Clexer.initial) lexbuf in
- Clexer.finish ();
- (fname, cabs)
- with (Sys_error msg) -> begin
- ignore (E.log "Cannot open %s : %s\n" fname msg);
- Clexer.finish ();
- close_output ();
- raise (ParseError("Cannot open " ^ fname ^ ": " ^ msg ^ "\n"))
- end
- | Parsing.Parse_error -> begin
- ignore (E.log "Parsing error\n");
- Clexer.finish ();
- close_output ();
- raise (ParseError("Parse error"))
- end
- | e -> begin
- ignore (E.log "Caught %s while parsing\n" (Printexc.to_string e));
- Clexer.finish ();
- raise e
- end
-
-
-(* print to safec.proto.h the prototypes of all functions that are defined *)
-let printPrototypes ((fname, file) : Cabs.file) : unit =
-begin
- (*ignore (E.log "file has %d defns\n" (List.length file));*)
-
- let chan = open_out "safec.proto.h" in
- ignore (fprintf chan "/* generated prototypes file, %d defs */\n" (List.length file));
- Cprint.out := chan;
-
- let counter : int ref = ref 0 in
-
- let rec loop (d : Cabs.definition) = begin
- match d with
- | Cabs.FUNDEF(name, _, loc, _) -> (
- match name with
- | (_, (funcname, Cabs.PROTO(_,_,_), _, _)) -> (
- incr counter;
- ignore (fprintf chan "\n/* %s from %s:%d */\n"
- funcname loc.Cabs.filename loc.Cabs.lineno);
- flush chan;
- Cprint.print_single_name name;
- Cprint.print_unescaped_string ";";
- Cprint.force_new_line ();
- Cprint.flush ()
- )
- | _ -> ()
- )
-
- | _ -> ()
- end in
- (List.iter loop file);
-
- ignore (fprintf chan "\n/* wrote %d prototypes */\n" !counter);
- close_out chan;
- ignore (E.log "printed %d prototypes from %d defns to safec.proto.h\n"
- !counter (List.length file))
-end
-
-
-
-let parse fname =
- (trace "sm" (dprintf "parsing %s to Cabs\n" fname));
- let cabs = parse_to_cabs fname in
- (* Now (return a function that will) convert to CIL *)
- fun _ ->
- (trace "sm" (dprintf "converting %s from Cabs to CIL\n" fname));
- let cil = Stats.time "conv" Cabs2cil.convFile cabs in
- if !doPrintProtos then (printPrototypes cabs);
- cil
-
-
-
-
-
-
-
-
diff --git a/cil/src/frontc/frontc.mli b/cil/src/frontc/frontc.mli
deleted file mode 100644
index 50ad799c43cb62df66fa4d41c5ffceffdf02054b..0000000000000000000000000000000000000000
--- a/cil/src/frontc/frontc.mli
+++ /dev/null
@@ -1,55 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-
- (* Signal that we are in MS VC mode *)
-val setMSVCMode: unit -> unit
-
-
- (* Parse a file in *)
-exception ParseError of string
-
- (* Raised when the front-end is requested to print the CABS and return *)
-exception CabsOnly
-
- (* additional command line arguments *)
-val args: (string * Arg.spec * string) list
-
- (* the main command to parse a file. Return a thunk that can be used to
- * convert the AST to CIL. *)
-val parse: string -> (unit -> Cil.file)
-
diff --git a/cil/src/frontc/lexerhack.ml b/cil/src/frontc/lexerhack.ml
deleted file mode 100755
index ecae28ef0ac8d2b5baae1b5b7fb31bc262da0f27..0000000000000000000000000000000000000000
--- a/cil/src/frontc/lexerhack.ml
+++ /dev/null
@@ -1,22 +0,0 @@
-
-module E = Errormsg
-
-(* We provide here a pointer to a function. It will be set by the lexer and
- * used by the parser. In Ocaml lexers depend on parsers, so we we have put
- * such functions in a separate module. *)
-let add_identifier: (string -> unit) ref =
- ref (fun _ -> E.s (E.bug "You called an uninitialized add_identifier"))
-
-let add_type: (string -> unit) ref =
- ref (fun _ -> E.s (E.bug "You called an uninitialized add_type"))
-
-let push_context: (unit -> unit) ref =
- ref (fun _ -> E.s (E.bug "You called an uninitialized push_context"))
-
-let pop_context: (unit -> unit) ref =
- ref (fun _ -> E.s (E.bug "You called an uninitialized pop_context"))
-
-
-(* Keep here the current pattern for formatparse *)
-let currentPattern = ref ""
-
diff --git a/cil/src/frontc/patch.ml b/cil/src/frontc/patch.ml
deleted file mode 100644
index fcb4ba6239fa3ff101ccffe466f8c4dd72d953a1..0000000000000000000000000000000000000000
--- a/cil/src/frontc/patch.ml
+++ /dev/null
@@ -1,837 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-
-(* patch.ml *)
-(* CABS file patching *)
-
-open Cabs
-open Trace
-open Pretty
-open Cabsvisit
-
-(* binding of a unification variable to a syntactic construct *)
-type binding =
- | BSpecifier of string * spec_elem list
- | BName of string * string
- | BExpr of string * expression
-
-(* thrown when unification fails *)
-exception NoMatch
-
-(* thrown when an attempt to find the associated binding fails *)
-exception BadBind of string
-
-(* trying to isolate performance problems; will hide all the *)
-(* potentially expensive debugging output behind "if verbose .." *)
-let verbose : bool = true
-
-
-(* raise NoMatch if x and y are not equal *)
-let mustEq (x : 'a) (y : 'a) : unit =
-begin
- if (x <> y) then (
- if verbose then
- (trace "patchDebug" (dprintf "mismatch by structural disequality\n"));
- raise NoMatch
- )
-end
-
-(* why isn't this in the core Ocaml library? *)
-let identity x = x
-
-
-let isPatternVar (s : string) : bool =
-begin
- ((String.length s) >= 1) && ((String.get s 0) = '@')
-end
-
-(* 's' is actually "@name(blah)"; extract the 'blah' *)
-let extractPatternVar (s : string) : string =
- (*(trace "patch" (dprintf "extractPatternVar %s\n" s));*)
- (String.sub s 6 ((String.length s) - 7))
-
-
-(* a few debugging printers.. *)
-let printExpr (e : expression) =
-begin
- if (verbose && traceActive "patchDebug") then (
- Cprint.print_expression e; Cprint.force_new_line ();
- Cprint.flush ()
- )
-end
-
-let printSpec (spec: spec_elem list) =
-begin
- if (verbose && traceActive "patchDebug") then (
- Cprint.print_specifiers spec; Cprint.force_new_line ();
- Cprint.flush ()
- )
-end
-
-let printSpecs (pat : spec_elem list) (tgt : spec_elem list) =
-begin
- (printSpec pat);
- (printSpec tgt)
-end
-
-let printDecl (pat : name) (tgt : name) =
-begin
- if (verbose && traceActive "patchDebug") then (
- Cprint.print_name pat; Cprint.force_new_line ();
- Cprint.print_name tgt; Cprint.force_new_line ();
- Cprint.flush ()
- )
-end
-
-let printDeclType (pat : decl_type) (tgt : decl_type) =
-begin
- if (verbose && traceActive "patchDebug") then (
- Cprint.print_decl "__missing_field_name" pat; Cprint.force_new_line ();
- Cprint.print_decl "__missing_field_name" tgt; Cprint.force_new_line ();
- Cprint.flush ()
- )
-end
-
-let printDefn (d : definition) =
-begin
- if (verbose && traceActive "patchDebug") then (
- Cprint.print_def d;
- Cprint.flush ()
- )
-end
-
-
-(* class to describe how to modify the tree for subtitution *)
-class substitutor (bindings : binding list) = object(self)
- inherit nopCabsVisitor as super
-
- (* look in the binding list for a given name *)
- method findBinding (name : string) : binding =
- begin
- try
- (List.find
- (fun b ->
- match b with
- | BSpecifier(n, _) -> n=name
- | BName(n, _) -> n=name
- | BExpr(n, _) -> n=name)
- bindings)
- with
- Not_found -> raise (BadBind ("name not found: " ^ name))
- end
-
- method vexpr (e:expression) : expression visitAction =
- begin
- match e with
- | EXPR_PATTERN(name) -> (
- match (self#findBinding name) with
- | BExpr(_, expr) -> ChangeTo(expr) (* substitute bound expression *)
- | _ -> raise (BadBind ("wrong type: " ^ name))
- )
- | _ -> DoChildren
- end
-
- (* use of a name *)
- method vvar (s:string) : string =
- begin
- if (isPatternVar s) then (
- let nameString = (extractPatternVar s) in
- match (self#findBinding nameString) with
- | BName(_, str) -> str (* substitute *)
- | _ -> raise (BadBind ("wrong type: " ^ nameString))
- )
- else
- s
- end
-
- (* binding introduction of a name *)
- method vname (k: nameKind) (spec: specifier) (n: name) : name visitAction =
- begin
- match n with (s (*variable name*), dtype, attrs, loc) -> (
- let replacement = (self#vvar s) in (* use replacer from above *)
- if (s <> replacement) then
- ChangeTo(replacement, dtype, attrs, loc)
- else
- DoChildren (* no replacement *)
- )
- end
-
- method vspec (specList: specifier) : specifier visitAction =
- begin
- if verbose then (trace "patchDebug" (dprintf "substitutor: vspec\n"));
- (printSpec specList);
-
- (* are any of the specifiers SpecPatterns? we have to check the entire *)
- (* list, not just the head, because e.g. "typedef @specifier(foo)" has *)
- (* "typedef" as the head of the specifier list *)
- if (List.exists (fun elt -> match elt with
- | SpecPattern(_) -> true
- | _ -> false)
- specList) then begin
- (* yes, replace the existing list with one got by *)
- (* replacing all occurrences of SpecPatterns *)
- (trace "patchDebug" (dprintf "at least one spec pattern\n"));
- ChangeTo
- (List.flatten
- (List.map
- (* for each specifier element, yield the specifier list *)
- (* to which it maps; then we'll flatten the final result *)
- (fun elt ->
- match elt with
- | SpecPattern(name) -> (
- match (self#findBinding name) with
- | BSpecifier(_, replacement) -> (
- (trace "patchDebug" (dprintf "replacing pattern %s\n" name));
- replacement
- )
- | _ -> raise (BadBind ("wrong type: " ^ name))
- )
- | _ -> [elt] (* leave this one alone *)
- )
- specList
- )
- )
- end
- else
- (* none of the specifiers in specList are patterns *)
- DoChildren
- end
-
- method vtypespec (tspec: typeSpecifier) : typeSpecifier visitAction =
- begin
- match tspec with
- | Tnamed(str) when (isPatternVar str) ->
- ChangeTo(Tnamed(self#vvar str))
- | Tstruct(str, fields, extraAttrs) when (isPatternVar str) -> (
- (trace "patchDebug" (dprintf "substituting %s\n" str));
- ChangeDoChildrenPost(Tstruct((self#vvar str), fields, extraAttrs), identity)
- )
- | Tunion(str, fields, extraAttrs) when (isPatternVar str) ->
- (trace "patchDebug" (dprintf "substituting %s\n" str));
- ChangeDoChildrenPost(Tunion((self#vvar str), fields, extraAttrs), identity)
- | _ -> DoChildren
- end
-
-end
-
-
-(* why can't I have forward declarations in the language?!! *)
-let unifyExprFwd : (expression -> expression -> binding list) ref
- = ref (fun e e -> [])
-
-
-(* substitution for expressions *)
-let substExpr (bindings : binding list) (expr : expression) : expression =
-begin
- if verbose then
- (trace "patchDebug" (dprintf "substExpr with %d bindings\n" (List.length bindings)));
- (printExpr expr);
-
- (* apply the transformation *)
- let result = (visitCabsExpression (new substitutor bindings :> cabsVisitor) expr) in
- (printExpr result);
-
- result
-end
-
-let d_loc (_:unit) (loc: cabsloc) : doc =
- text loc.filename ++ chr ':' ++ num loc.lineno
-
-
-(* class to describe how to modify the tree when looking for places *)
-(* to apply expression transformers *)
-class exprTransformer (srcpattern : expression) (destpattern : expression)
- (patchline : int) (srcloc : cabsloc) = object(self)
- inherit nopCabsVisitor as super
-
- method vexpr (e:expression) : expression visitAction =
- begin
- (* see if the source pattern matches this subexpression *)
- try (
- let bindings = (!unifyExprFwd srcpattern e) in
-
- (* match! *)
- (trace "patch" (dprintf "expr match: patch line %d, src %a\n"
- patchline d_loc srcloc));
- ChangeTo(substExpr bindings destpattern)
- )
-
- with NoMatch -> (
- (* doesn't apply *)
- DoChildren
- )
- end
-
- (* other constructs left unchanged *)
-end
-
-
-let unifyList (pat : 'a list) (tgt : 'a list)
- (unifyElement : 'a -> 'a -> binding list) : binding list =
-begin
- if verbose then
- (trace "patchDebug" (dprintf "unifyList (pat len %d, tgt len %d)\n"
- (List.length pat) (List.length tgt)));
-
- (* walk down the lists *)
- let rec loop pat tgt : binding list =
- match pat, tgt with
- | [], [] -> []
- | (pelt :: prest), (telt :: trest) ->
- (unifyElement pelt telt) @
- (loop prest trest)
- | _,_ -> (
- (* no match *)
- if verbose then (
- (trace "patchDebug" (dprintf "mismatching list length\n"));
- );
- raise NoMatch
- )
- in
- (loop pat tgt)
-end
-
-
-let gettime () : float =
- (Unix.times ()).Unix.tms_utime
-
-let rec applyPatch (patchFile : file) (srcFile : file) : file =
-begin
- let patch : definition list = (snd patchFile) in
- let srcFname : string = (fst srcFile) in
- let src : definition list = (snd srcFile) in
-
- (trace "patchTime" (dprintf "applyPatch start: %f\n" (gettime ())));
- if (traceActive "patchDebug") then
- Cprint.out := stdout (* hack *)
- else ();
-
- (* more hackery *)
- unifyExprFwd := unifyExpr;
-
- (* patch a single source definition, yield transformed *)
- let rec patchDefn (patch : definition list) (d : definition) : definition list =
- begin
- match patch with
- | TRANSFORMER(srcpattern, destpattern, loc) :: rest -> (
- if verbose then
- (trace "patchDebug"
- (dprintf "considering applying defn pattern at line %d to src at %a\n"
- loc.lineno d_loc (get_definitionloc d)));
-
- (* see if the source pattern matches the definition 'd' we have *)
- try (
- let bindings = (unifyDefn srcpattern d) in
-
- (* we have a match! apply the substitutions *)
- (trace "patch" (dprintf "defn match: patch line %d, src %a\n"
- loc.lineno d_loc (get_definitionloc d)));
-
- (List.map (fun destElt -> (substDefn bindings destElt)) destpattern)
- )
-
- with NoMatch -> (
- (* no match, continue down list *)
- (*(trace "patch" (dprintf "no match\n"));*)
- (patchDefn rest d)
- )
- )
-
- | EXPRTRANSFORMER(srcpattern, destpattern, loc) :: rest -> (
- if verbose then
- (trace "patchDebug"
- (dprintf "considering applying expr pattern at line %d to src at %a\n"
- loc.lineno d_loc (get_definitionloc d)));
-
- (* walk around in 'd' looking for expressions to modify *)
- let dList = (visitCabsDefinition
- ((new exprTransformer srcpattern destpattern
- loc.lineno (get_definitionloc d))
- :> cabsVisitor)
- d
- ) in
-
- (* recursively invoke myself to try additional patches *)
- (* since visitCabsDefinition might return a list, I'll try my *)
- (* addtional patches on every yielded definition, then collapse *)
- (* all of them into a single list *)
- (List.flatten (List.map (fun d -> (patchDefn rest d)) dList))
- )
-
- | _ :: rest -> (
- (* not a transformer; just keep going *)
- (patchDefn rest d)
- )
- | [] -> (
- (* reached the end of the patch file with no match *)
- [d] (* have to wrap it in a list ... *)
- )
- end in
-
- (* transform all the definitions *)
- let result : definition list =
- (List.flatten (List.map (fun d -> (patchDefn patch d)) src)) in
-
- (*Cprint.print_defs result;*)
-
- if (traceActive "patchDebug") then (
- (* avoid flush bug? yes *)
- Cprint.force_new_line ();
- Cprint.flush ()
- );
-
- (trace "patchTime" (dprintf "applyPatch finish: %f\n" (gettime ())));
- (srcFname, result)
-end
-
-
-(* given a definition pattern 'pat', and a target concrete defintion 'tgt', *)
-(* determine if they can be unified; if so, return the list of bindings of *)
-(* unification variables in pat; otherwise raise NoMatch *)
-and unifyDefn (pat : definition) (tgt : definition) : binding list =
-begin
- match pat, tgt with
- | DECDEF((pspecifiers, pdeclarators), _),
- DECDEF((tspecifiers, tdeclarators), _) -> (
- if verbose then
- (trace "patchDebug" (dprintf "unifyDefn of DECDEFs\n"));
- (unifySpecifiers pspecifiers tspecifiers) @
- (unifyInitDeclarators pdeclarators tdeclarators)
- )
-
- | TYPEDEF((pspec, pdecl), _),
- TYPEDEF((tspec, tdecl), _) -> (
- if verbose then
- (trace "patchDebug" (dprintf "unifyDefn of TYPEDEFs\n"));
- (unifySpecifiers pspec tspec) @
- (unifyDeclarators pdecl tdecl)
- )
-
- | ONLYTYPEDEF(pspec, _),
- ONLYTYPEDEF(tspec, _) -> (
- if verbose then
- (trace "patchDebug" (dprintf "unifyDefn of ONLYTYPEDEFs\n"));
- (unifySpecifiers pspec tspec)
- )
-
- | _, _ -> (
- if verbose then
- (trace "patchDebug" (dprintf "mismatching definitions\n"));
- raise NoMatch
- )
-end
-
-and unifySpecifier (pat : spec_elem) (tgt : spec_elem) : binding list =
-begin
- if verbose then
- (trace "patchDebug" (dprintf "unifySpecifier\n"));
- (printSpecs [pat] [tgt]);
-
- if (pat = tgt) then [] else
-
- match pat, tgt with
- | SpecType(tspec1), SpecType(tspec2) ->
- (unifyTypeSpecifier tspec1 tspec2)
- | SpecPattern(name), _ ->
- (* record that future occurrances of @specifier(name) will yield this specifier *)
- if verbose then
- (trace "patchDebug" (dprintf "found specifier match for %s\n" name));
- [BSpecifier(name, [tgt])]
- | _,_ -> (
- (* no match *)
- if verbose then (
- (trace "patchDebug" (dprintf "mismatching specifiers\n"));
- );
- raise NoMatch
- )
-end
-
-and unifySpecifiers (pat : spec_elem list) (tgt : spec_elem list) : binding list =
-begin
- if verbose then
- (trace "patchDebug" (dprintf "unifySpecifiers\n"));
- (printSpecs pat tgt);
-
- (* canonicalize the specifiers by sorting them *)
- let pat' = (List.stable_sort compare pat) in
- let tgt' = (List.stable_sort compare tgt) in
-
- (* if they are equal, they match with no further checking *)
- if (pat' = tgt') then [] else
-
- (* walk down the lists; don't walk the sorted lists because the *)
- (* pattern must always be last, if it occurs *)
- let rec loop pat tgt : binding list =
- match pat, tgt with
- | [], [] -> []
- | [SpecPattern(name)], _ ->
- (* final SpecPattern matches anything which comes after *)
- (* record that future occurrences of @specifier(name) will yield this specifier *)
- if verbose then
- (trace "patchDebug" (dprintf "found specifier match for %s\n" name));
- [BSpecifier(name, tgt)]
- | (pspec :: prest), (tspec :: trest) ->
- (unifySpecifier pspec tspec) @
- (loop prest trest)
- | _,_ -> (
- (* no match *)
- if verbose then (
- (trace "patchDebug" (dprintf "mismatching specifier list length\n"));
- );
- raise NoMatch
- )
- in
- (loop pat tgt)
-end
-
-and unifyTypeSpecifier (pat: typeSpecifier) (tgt: typeSpecifier) : binding list =
-begin
- if verbose then
- (trace "patchDebug" (dprintf "unifyTypeSpecifier\n"));
-
- if (pat = tgt) then [] else
-
- match pat, tgt with
- | Tnamed(s1), Tnamed(s2) -> (unifyString s1 s2)
- | Tstruct(name1, None, _), Tstruct(name2, None, _) ->
- (unifyString name1 name2)
- | Tstruct(name1, Some(fields1), _), Tstruct(name2, Some(fields2), _) ->
- (* ignoring extraAttrs b/c we're just trying to come up with a list
- * of substitutions, and there's no unify_attributes function, and
- * I don't care at this time about checking that they are equal .. *)
- (unifyString name1 name2) @
- (unifyList fields1 fields2 unifyField)
- | Tunion(name1, None, _), Tstruct(name2, None, _) ->
- (unifyString name1 name2)
- | Tunion(name1, Some(fields1), _), Tunion(name2, Some(fields2), _) ->
- (unifyString name1 name2) @
- (unifyList fields1 fields2 unifyField)
- | Tenum(name1, None, _), Tenum(name2, None, _) ->
- (unifyString name1 name2)
- | Tenum(name1, Some(items1), _), Tenum(name2, Some(items2), _) ->
- (mustEq items1 items2); (* enum items *)
- (unifyString name1 name2)
- | TtypeofE(exp1), TtypeofE(exp2) ->
- (unifyExpr exp1 exp2)
- | TtypeofT(spec1, dtype1), TtypeofT(spec2, dtype2) ->
- (unifySpecifiers spec1 spec2) @
- (unifyDeclType dtype1 dtype2)
- | _ -> (
- if verbose then (trace "patchDebug" (dprintf "mismatching typeSpecifiers\n"));
- raise NoMatch
- )
-end
-
-and unifyField (pat : field_group) (tgt : field_group) : binding list =
-begin
- match pat,tgt with (spec1, list1), (spec2, list2) -> (
- (unifySpecifiers spec1 spec2) @
- (unifyList list1 list2 unifyNameExprOpt)
- )
-end
-
-and unifyNameExprOpt (pat : name * expression option)
- (tgt : name * expression option) : binding list =
-begin
- match pat,tgt with
- | (name1, None), (name2, None) -> (unifyName name1 name2)
- | (name1, Some(exp1)), (name2, Some(exp2)) ->
- (unifyName name1 name2) @
- (unifyExpr exp1 exp2)
- | _,_ -> []
-end
-
-and unifyName (pat : name) (tgt : name) : binding list =
-begin
- match pat,tgt with (pstr, pdtype, pattrs, ploc), (tstr, tdtype, tattrs, tloc) ->
- (mustEq pattrs tattrs);
- (unifyString pstr tstr) @
- (unifyDeclType pdtype tdtype)
-end
-
-and unifyInitDeclarators (pat : init_name list) (tgt : init_name list) : binding list =
-begin
- (*
- if verbose then
- (trace "patchDebug" (dprintf "unifyInitDeclarators, pat %d, tgt %d\n"
- (List.length pat) (List.length tgt)));
- *)
-
- match pat, tgt with
- | ((pdecl, piexpr) :: prest),
- ((tdecl, tiexpr) :: trest) ->
- (unifyDeclarator pdecl tdecl) @
- (unifyInitExpr piexpr tiexpr) @
- (unifyInitDeclarators prest trest)
- | [], [] -> []
- | _, _ -> (
- if verbose then
- (trace "patchDebug" (dprintf "mismatching init declarators\n"));
- raise NoMatch
- )
-end
-
-and unifyDeclarators (pat : name list) (tgt : name list) : binding list =
- (unifyList pat tgt unifyDeclarator)
-
-and unifyDeclarator (pat : name) (tgt : name) : binding list =
-begin
- if verbose then
- (trace "patchDebug" (dprintf "unifyDeclarator\n"));
- (printDecl pat tgt);
-
- match pat, tgt with
- | (pname, pdtype, pattr, ploc),
- (tname, tdtype, tattr, tloc) ->
- (mustEq pattr tattr);
- (unifyDeclType pdtype tdtype) @
- (unifyString pname tname)
-end
-
-and unifyDeclType (pat : decl_type) (tgt : decl_type) : binding list =
-begin
- if verbose then
- (trace "patchDebug" (dprintf "unifyDeclType\n"));
- (printDeclType pat tgt);
-
- match pat, tgt with
- | JUSTBASE, JUSTBASE -> []
- | PARENTYPE(pattr1, ptype, pattr2),
- PARENTYPE(tattr1, ttype, tattr2) ->
- (mustEq pattr1 tattr1);
- (mustEq pattr2 tattr2);
- (unifyDeclType ptype ttype)
- | ARRAY(ptype, pattr, psz),
- ARRAY(ttype, tattr, tsz) ->
- (mustEq pattr tattr);
- (unifyDeclType ptype ttype) @
- (unifyExpr psz tsz)
- | PTR(pattr, ptype),
- PTR(tattr, ttype) ->
- (mustEq pattr tattr);
- (unifyDeclType ptype ttype)
- | PROTO(ptype, pformals, pva),
- PROTO(ttype, tformals, tva) ->
- (mustEq pva tva);
- (unifyDeclType ptype ttype) @
- (unifySingleNames pformals tformals)
- | _ -> (
- if verbose then
- (trace "patchDebug" (dprintf "mismatching decl_types\n"));
- raise NoMatch
- )
-end
-
-and unifySingleNames (pat : single_name list) (tgt : single_name list) : binding list =
-begin
- if verbose then
- (trace "patchDebug" (dprintf "unifySingleNames, pat %d, tgt %d\n"
- (List.length pat) (List.length tgt)));
-
- match pat, tgt with
- | [], [] -> []
- | (pspec, pdecl) :: prest,
- (tspec, tdecl) :: trest ->
- (unifySpecifiers pspec tspec) @
- (unifyDeclarator pdecl tdecl) @
- (unifySingleNames prest trest)
- | _, _ -> (
- if verbose then
- (trace "patchDebug" (dprintf "mismatching single_name lists\n"));
- raise NoMatch
- )
-end
-
-and unifyString (pat : string) (tgt : string) : binding list =
-begin
- (* equal? match with no further ado *)
- if (pat = tgt) then [] else
-
- (* is the pattern a variable? *)
- if (isPatternVar pat) then
- (* pat is actually "@name(blah)"; extract the 'blah' *)
- let varname = (extractPatternVar pat) in
-
- (* when substituted, this name becomes 'tgt' *)
- if verbose then
- (trace "patchDebug" (dprintf "found name match for %s\n" varname));
- [BName(varname, tgt)]
-
- else (
- if verbose then
- (trace "patchDebug" (dprintf "mismatching names: %s and %s\n" pat tgt));
- raise NoMatch
- )
-end
-
-and unifyExpr (pat : expression) (tgt : expression) : binding list =
-begin
- (* if they're equal, that's good enough *)
- if (pat = tgt) then [] else
-
- (* shorter name *)
- let ue = unifyExpr in
-
- (* because of the equality check above, I can omit some cases *)
- match pat, tgt with
- | UNARY(pop, pexpr),
- UNARY(top, texpr) ->
- (mustEq pop top);
- (ue pexpr texpr)
- | BINARY(pop, pexp1, pexp2),
- BINARY(top, texp1, texp2) ->
- (mustEq pop top);
- (ue pexp1 texp1) @
- (ue pexp2 texp2)
- | QUESTION(p1, p2, p3),
- QUESTION(t1, t2, t3) ->
- (ue p1 t1) @
- (ue p2 t2) @
- (ue p3 t3)
- | CAST((pspec, ptype), piexpr),
- CAST((tspec, ttype), tiexpr) ->
- (mustEq ptype ttype);
- (unifySpecifiers pspec tspec) @
- (unifyInitExpr piexpr tiexpr)
- | CALL(pfunc, pargs),
- CALL(tfunc, targs) ->
- (ue pfunc tfunc) @
- (unifyExprs pargs targs)
- | COMMA(pexprs),
- COMMA(texprs) ->
- (unifyExprs pexprs texprs)
- | EXPR_SIZEOF(pexpr),
- EXPR_SIZEOF(texpr) ->
- (ue pexpr texpr)
- | TYPE_SIZEOF(pspec, ptype),
- TYPE_SIZEOF(tspec, ttype) ->
- (mustEq ptype ttype);
- (unifySpecifiers pspec tspec)
- | EXPR_ALIGNOF(pexpr),
- EXPR_ALIGNOF(texpr) ->
- (ue pexpr texpr)
- | TYPE_ALIGNOF(pspec, ptype),
- TYPE_ALIGNOF(tspec, ttype) ->
- (mustEq ptype ttype);
- (unifySpecifiers pspec tspec)
- | INDEX(parr, pindex),
- INDEX(tarr, tindex) ->
- (ue parr tarr) @
- (ue pindex tindex)
- | MEMBEROF(pexpr, pfield),
- MEMBEROF(texpr, tfield) ->
- (mustEq pfield tfield);
- (ue pexpr texpr)
- | MEMBEROFPTR(pexpr, pfield),
- MEMBEROFPTR(texpr, tfield) ->
- (mustEq pfield tfield);
- (ue pexpr texpr)
- | GNU_BODY(pblock),
- GNU_BODY(tblock) ->
- (mustEq pblock tblock);
- []
- | EXPR_PATTERN(name), _ ->
- (* match, and contribute binding *)
- if verbose then
- (trace "patchDebug" (dprintf "found expr match for %s\n" name));
- [BExpr(name, tgt)]
- | a, b ->
- if (verbose && traceActive "patchDebug") then (
- (trace "patchDebug" (dprintf "mismatching expression\n"));
- (printExpr a);
- (printExpr b)
- );
- raise NoMatch
-end
-
-and unifyInitExpr (pat : init_expression) (tgt : init_expression) : binding list =
-begin
- (*
- Cprint.print_init_expression pat; Cprint.force_new_line ();
- Cprint.print_init_expression tgt; Cprint.force_new_line ();
- Cprint.flush ();
- *)
-
- match pat, tgt with
- | NO_INIT, NO_INIT -> []
- | SINGLE_INIT(pe), SINGLE_INIT(te) ->
- (unifyExpr pe te)
- | COMPOUND_INIT(plist),
- COMPOUND_INIT(tlist) -> (
- let rec loop plist tlist =
- match plist, tlist with
- | ((pwhat, piexpr) :: prest),
- ((twhat, tiexpr) :: trest) ->
- (mustEq pwhat twhat);
- (unifyInitExpr piexpr tiexpr) @
- (loop prest trest)
- | [], [] -> []
- | _, _ -> (
- if verbose then
- (trace "patchDebug" (dprintf "mismatching compound init exprs\n"));
- raise NoMatch
- )
- in
- (loop plist tlist)
- )
- | _,_ -> (
- if verbose then
- (trace "patchDebug" (dprintf "mismatching init exprs\n"));
- raise NoMatch
- )
-end
-
-and unifyExprs (pat : expression list) (tgt : expression list) : binding list =
- (unifyList pat tgt unifyExpr)
-
-
-(* given the list of bindings 'b', substitute them into 'd' to yield a new definition *)
-and substDefn (bindings : binding list) (defn : definition) : definition =
-begin
- if verbose then
- (trace "patchDebug" (dprintf "substDefn with %d bindings\n" (List.length bindings)));
- (printDefn defn);
-
- (* apply the transformation *)
- match (visitCabsDefinition (new substitutor bindings :> cabsVisitor) defn) with
- | [d] -> d (* expect a singleton list *)
- | _ -> (failwith "didn't get a singleton list where I expected one")
-end
-
-
-(* end of file *)
diff --git a/cil/src/frontc/patch.mli b/cil/src/frontc/patch.mli
deleted file mode 100644
index 4f32870e7a7afe3e184c4575e91f595f017bdbb6..0000000000000000000000000000000000000000
--- a/cil/src/frontc/patch.mli
+++ /dev/null
@@ -1,42 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-
-(* patch.mli *)
-(* interface for patch.ml *)
-
-val applyPatch : Cabs.file -> Cabs.file -> Cabs.file
diff --git a/cil/src/libmaincil.ml b/cil/src/libmaincil.ml
deleted file mode 100644
index 952c0132513ed57a5c75ae06a6fd250690643981..0000000000000000000000000000000000000000
--- a/cil/src/libmaincil.ml
+++ /dev/null
@@ -1,108 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* libmaincil *)
-(* this is a replacement for maincil.ml, for the case when we're
- * creating a C-callable library (libcil.a); all it does is register
- * a couple of functions and initialize CIL *)
-
-
-module E = Errormsg
-
-open Cil
-
-
-(* print a Cil 'file' to stdout *)
-let unparseToStdout (cil : file) : unit =
-begin
- dumpFile defaultCilPrinter stdout cil
-end;;
-
-(* a visitor to unroll all types - may need to do some magic to keep attributes *)
-class unrollVisitorClass = object (self)
- inherit nopCilVisitor
-
- (* variable declaration *)
- method vvdec (vi : varinfo) : varinfo visitAction =
- begin
- vi.vtype <- unrollTypeDeep vi.vtype;
- (*ignore (E.log "varinfo for %s in file '%s' line %d byte %d\n" vi.vname vi.vdecl.file vi.vdecl.line vi.vdecl.byte);*)
- SkipChildren
- end
-
- (* global: need to unroll fields of compinfo *)
- method vglob (g : global) : global list visitAction =
- begin
- match g with
- GCompTag(ci, loc) as g ->
- let doFieldinfo (fi : fieldinfo) : unit =
- fi.ftype <- unrollTypeDeep fi.ftype
- in begin
- ignore(List.map doFieldinfo ci.cfields);
- (*ChangeTo [g]*)
- SkipChildren
- end
- | _ -> DoChildren
- end
-end;;
-
-
-let unrollVisitor = new unrollVisitorClass;;
-
-(* open and parse a C file into a Cil 'file', unroll all typedefs *)
-let parseOneFile (fname: string) : file =
- let ast : file = Frontc.parse fname () in
- begin
- visitCilFile unrollVisitor ast;
- ast
- end
-;;
-
-let getDummyTypes () : typ * typ =
- ( TPtr(TVoid [], []), TInt(IInt, []) )
-;;
-
-(* register some functions - these may be called from C code *)
-Callback.register "cil_parse" parseOneFile;
-Callback.register "cil_unparse" unparseToStdout;
-(* Callback.register "unroll_type_deep" unrollTypeDeep; *)
-Callback.register "get_dummy_types" getDummyTypes;
-
-(* initalize CIL *)
-initCIL ();
-
-
diff --git a/cil/src/machdep.c b/cil/src/machdep.c
deleted file mode 100644
index 1134865386b7718e2eeceb19cdac0251512e1660..0000000000000000000000000000000000000000
--- a/cil/src/machdep.c
+++ /dev/null
@@ -1,220 +0,0 @@
-/*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- */
-
-#include "../config.h"
-
-#include <stdio.h>
-
-#ifdef HAVE_STDLIB_H
-#include <stdlib.h>
-#endif
-
-#ifdef HAVE_WCHAR_H
-#include <wchar.h>
-#endif
-
-#ifdef _GNUCC
-#define LONGLONG long long
-#define CONST_STRING_LITERALS "true"
-#define VERSION __VERSION__
-#define VERSION_MAJOR __GNUC__
-#define VERSION_MINOR __GNUC_MINOR__
-#endif
-
-#ifdef _MSVC
-#define LONGLONG __int64
-#define CONST_STRING_LITERALS "false"
-#define VERSION "0"
-#define VERSION_MAJOR 0
-#define VERSION_MINOR 0
-#endif
-
-/* The type for the machine dependency structure is generated from the
- Makefile */
-int main() {
- fprintf(stderr, "Generating machine dependency information for CIL\n");
-
- printf("(* Generated by code in %s *)\n", __FILE__);
- printf("\t version_major = %d;\n", VERSION_MAJOR);
- printf("\t version_minor = %d;\n", VERSION_MINOR);
- printf("\t version = \"%s\";\n", VERSION);
- // Size of certain types
- printf("\t sizeof_short = %d;\n", sizeof(short));
- printf("\t sizeof_int = %d;\n", sizeof(int));
- printf("\t sizeof_long = %d;\n", sizeof(long));
- printf("\t sizeof_longlong = %d;\n", sizeof(LONGLONG));
- printf("\t sizeof_ptr = %d;\n", sizeof(int *));
- printf("\t sizeof_enum = %d;\n", sizeof(enum e { ONE, TWO }));
- printf("\t sizeof_float = %d;\n", sizeof(float));
- printf("\t sizeof_double = %d;\n", sizeof(double));
- printf("\t sizeof_longdouble = %d;\n", sizeof(long double));
- printf("\t sizeof_sizeof = %d;\n", sizeof(sizeof(int)));
- printf("\t sizeof_wchar = %d;\n", sizeof(wchar_t));
- printf("\t sizeof_void = %d;\n", sizeof(void));
- printf("\t sizeof_fun = %d;\n",
-#ifdef __GNUC__
- sizeof(main)
-#else
- 0
-#endif
- );
-
- // The alignment of a short
- {
- struct shortstruct {
- char c;
- short s;
- };
- printf("\t alignof_short = %d;\n",
- (int)(&((struct shortstruct*)0)->s));
- }
-
- // The alignment of an int
- {
- struct intstruct {
- char c;
- int i;
- };
- printf("\t alignof_int = %d;\n",
- (int)(&((struct intstruct*)0)->i));
- }
-
- // The alignment of a long
- {
- struct longstruct {
- char c;
- long l;
- };
- printf("\t alignof_long = %d;\n",
- (int)(&((struct longstruct*)0)->l));
- }
-
- // The alignment of long long
- {
- struct longlong {
- char c;
- LONGLONG ll;
- };
- printf("\t alignof_longlong = %d;\n",
- (int)(&((struct longlong*)0)->ll));
- }
-
- // The alignment of a ptr
- {
- struct ptrstruct {
- char c;
- int * p;
- };
- printf("\t alignof_ptr = %d;\n",
- (int)(&((struct ptrstruct*)0)->p));
- }
-
- // The alignment of an enum
- {
- struct enumstruct {
- char c;
- enum e2 { THREE, FOUR, FIVE } e;
- };
- printf("\t alignof_enum = %d;\n",
- (int)(&((struct enumstruct*)0)->e));
- }
-
- // The alignment of a float
- {
- struct floatstruct {
- char c;
- float f;
- };
- printf("\t alignof_float = %d;\n",
- (int)(&((struct floatstruct*)0)->f));
- }
-
- // The alignment of double
- {
- struct s1 {
- char c;
- double d;
- };
- printf("\t alignof_double = %d;\n",
- (int)(&((struct s1*)0)->d));
- }
-
- // The alignment of long double
- {
- struct s1 {
- char c;
- long double ld;
- };
- printf("\t alignof_longdouble = %d;\n",
- (int)(&((struct s1*)0)->ld));
- }
-
- printf("\t alignof_str = %d;\n",
-#ifdef __GNUC__
- __alignof("a string")
-#else
- 0
-#endif
- );
-
- printf("\t alignof_fun = %d;\n",
-#ifdef __GNUC__
- __alignof(main)
-#else
- 0
-#endif
- );
-
- // Whether char is unsigned
- printf("\t char_is_unsigned = %s;\n",
- ((char)0xff) > 0 ? "true" : "false");
-
-
- // Whether string literals contain constant characters
- puts("\t const_string_literals = " CONST_STRING_LITERALS ";");
-
-
- // endianity
- {
- int e = 0x11223344;
- printf("\t little_endian = %s;\n",
- (0x44 == *(char*)&e) ? "true" :
- ((0x11 == *(char*)&e) ? "false" : (exit(1), "false")));
- }
-
- exit(0);
-}
diff --git a/cil/src/main.ml b/cil/src/main.ml
deleted file mode 100644
index bbdb7309cf8e1969c0ae4516b432aada9270534e..0000000000000000000000000000000000000000
--- a/cil/src/main.ml
+++ /dev/null
@@ -1,288 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* maincil *)
-(* this module is the program entry point for the 'cilly' program, *)
-(* which reads a C program file, parses it, translates it to the CIL *)
-(* intermediate language, and then renders that back into C *)
-
-
-module F = Frontc
-module C = Cil
-module CK = Check
-module E = Errormsg
-open Pretty
-open Trace
-
-type outfile =
- { fname: string;
- fchan: out_channel }
-let outChannel : outfile option ref = ref None
-let mergedChannel : outfile option ref = ref None
-
-
-let parseOneFile (fname: string) : C.file =
- (* PARSE and convert to CIL *)
- if !Cilutil.printStages then ignore (E.log "Parsing %s\n" fname);
- let cil = F.parse fname () in
-
- if (not !Epicenter.doEpicenter) then (
- (* sm: remove unused temps to cut down on gcc warnings *)
- (* (Stats.time "usedVar" Rmtmps.removeUnusedTemps cil); *)
- (trace "sm" (dprintf "removing unused temporaries\n"));
- (Rmtmps.removeUnusedTemps cil)
- );
- cil
-
-(** These are the statically-configured features. To these we append the
- * features defined in Feature_config.ml (from Makefile) *)
-
-let makeCFGFeature : C.featureDescr =
- { C.fd_name = "makeCFG";
- C.fd_enabled = Cilutil.makeCFG;
- C.fd_description = "make the program look more like a CFG" ;
- C.fd_extraopt = [];
- C.fd_doit = (fun f ->
- ignore (Partial.calls_end_basic_blocks f) ;
- ignore (Partial.globally_unique_vids f) ;
- Cil.iterGlobals f (fun glob -> match glob with
- Cil.GFun(fd,_) -> Cil.prepareCFG fd ;
- (* jc: blockinggraph depends on this "true" arg *)
- ignore (Cil.computeCFGInfo fd true)
- | _ -> ())
- );
- C.fd_post_check = true;
- }
-
-let features : C.featureDescr list =
- [ Epicenter.feature;
- Simplify.feature;
- Canonicalize.feature;
- Callgraph.feature;
- Logwrites.feature;
- Heapify.feature1;
- Heapify.feature2;
- Oneret.feature;
- makeCFGFeature; (* ww: make CFG *must* come before Partial *)
- Partial.feature;
- Simplemem.feature;
- Sfi.feature;
- Dataslicing.feature;
- Logcalls.feature;
- Ptranal.feature;
- Liveness.feature;
- ]
- @ Feature_config.features
-
-let rec processOneFile (cil: C.file) =
- begin
-
- if !Cilutil.doCheck then begin
- ignore (E.log "First CIL check\n");
- ignore (CK.checkFile [] cil);
- end;
-
- (* Scan all the features configured from the Makefile and, if they are
- * enabled then run them on the current file *)
- List.iter
- (fun fdesc ->
- if ! (fdesc.C.fd_enabled) then begin
- if !E.verboseFlag then
- ignore (E.log "Running CIL feature %s (%s)\n"
- fdesc.C.fd_name fdesc.C.fd_description);
- (* Run the feature, and see how long it takes. *)
- Stats.time fdesc.C.fd_name
- fdesc.C.fd_doit cil;
- (* See if we need to do some checking *)
- if !Cilutil.doCheck && fdesc.C.fd_post_check then begin
- ignore (E.log "CIL check after %s\n" fdesc.C.fd_name);
- ignore (CK.checkFile [] cil);
- end
- end)
- features;
-
-
- (match !outChannel with
- None -> ()
- | Some c -> Stats.time "printCIL"
- (C.dumpFile (!C.printerForMaincil) c.fchan c.fname) cil);
-
- if !E.hadErrors then
- E.s (E.error "Error while processing file; see above for details.");
-
- end
-
-(***** MAIN *****)
-let rec theMain () =
- let usageMsg = "Usage: cilly [options] source-files" in
- (* Processign of output file arguments *)
- let openFile (what: string) (takeit: outfile -> unit) (fl: string) =
- if !E.verboseFlag then
- ignore (Printf.printf "Setting %s to %s\n" what fl);
- (try takeit { fname = fl;
- fchan = open_out fl }
- with _ ->
- raise (Arg.Bad ("Cannot open " ^ what ^ " file " ^ fl)))
- in
- let outName = ref "" in
- (* sm: enabling this by default, since I think usually we
- * want 'cilly' transformations to preserve annotations; I
- * can easily add a command-line flag if someone sometimes
- * wants these suppressed *)
- C.print_CIL_Input := true;
-
- (*********** COMMAND LINE ARGUMENTS *****************)
- (* Construct the arguments for the features configured from the Makefile *)
- let blankLine = ("", Arg.Unit (fun _ -> ()), "") in
- let featureArgs =
- List.fold_right
- (fun fdesc acc ->
- if !(fdesc.C.fd_enabled) then
- (* The feature is enabled by default *)
- blankLine ::
- ("--dont" ^ fdesc.C.fd_name, Arg.Clear(fdesc.C.fd_enabled),
- " Disable " ^ fdesc.C.fd_description) ::
- fdesc.C.fd_extraopt @ acc
- else
- (* Disabled by default *)
- blankLine ::
- ("--do" ^ fdesc.C.fd_name, Arg.Set(fdesc.C.fd_enabled),
- " Enable " ^ fdesc.C.fd_description) ::
- fdesc.C.fd_extraopt @ acc
- )
- features
- [blankLine]
- in
- let featureArgs =
- ("", Arg.Unit (fun () -> ()), "\n\t\tCIL Features") :: featureArgs
- in
-
- let argDescr = Ciloptions.options @
- [
- "--out", Arg.String (openFile "output"
- (fun oc -> outChannel := Some oc)),
- "the name of the output CIL file. The cilly script sets this for you.";
- "--mergedout", Arg.String (openFile "merged output"
- (fun oc -> mergedChannel := Some oc)),
- "specify the name of the merged file";
- ]
- @ F.args @ featureArgs in
- begin
- (* this point in the code is the program entry point *)
-
- Stats.reset (Stats.has_performance_counters ());
-
- (* parse the command-line arguments *)
- Arg.parse argDescr Ciloptions.recordFile usageMsg;
- Cil.initCIL ();
-
- Ciloptions.fileNames := List.rev !Ciloptions.fileNames;
-
- if !Cilutil.testcil <> "" then begin
- Testcil.doit !Cilutil.testcil
- end else
- (* parse each of the files named on the command line, to CIL *)
- let files = List.map parseOneFile !Ciloptions.fileNames in
-
- (* if there's more than one source file, merge them together; *)
- (* now we have just one CIL "file" to deal with *)
- let one =
- match files with
- [one] -> one
- | [] -> E.s (E.error "No arguments for CIL\n")
- | _ ->
- let merged =
- Stats.time "merge" (Mergecil.merge files)
- (if !outName = "" then "stdout" else !outName) in
- if !E.hadErrors then
- E.s (E.error "There were errors during merging\n");
- (* See if we must save the merged file *)
- (match !mergedChannel with
- None -> ()
- | Some mc -> begin
- let oldpci = !C.print_CIL_Input in
- C.print_CIL_Input := true;
- Stats.time "printMerged"
- (C.dumpFile !C.printerForMaincil mc.fchan mc.fname) merged;
- C.print_CIL_Input := oldpci
- end);
- merged
- in
-
- if !E.hadErrors then
- E.s (E.error "Cabs2cil had some errors");
-
- (* process the CIL file (merged if necessary) *)
- processOneFile one
- end
-;;
- (* Define a wrapper for main to
- * intercept the exit *)
-let failed = ref false
-
-let cleanup () =
- if !E.verboseFlag || !Cilutil.printStats then
- Stats.print stderr "Timings:\n";
- if !E.logChannel != stderr then
- close_out (! E.logChannel);
- (match ! outChannel with Some c -> close_out c.fchan | _ -> ())
-
-
-(* Without this handler, cilly.asm.exe will quit silently with return code 0
- when a segfault happens. *)
-let handleSEGV code =
- if !Cil.currentLoc == Cil.locUnknown then
- E.log "**** Segmentation fault (possibly a stack overflow)\n"
- else begin
- E.log ("**** Segmentation fault (possibly a stack overflow) "^^
- "while processing %a\n")
- Cil.d_loc !Cil.currentLoc
- end;
- exit code
-
-let _ = Sys.set_signal Sys.sigsegv (Sys.Signal_handle handleSEGV);
-
-;;
-
-begin
- try
- theMain ();
- with F.CabsOnly -> (* this is OK *) ()
-end;
-cleanup ();
-exit (if !failed then 1 else 0)
-
diff --git a/cil/src/mergecil.ml b/cil/src/mergecil.ml
deleted file mode 100644
index dee519edc2571eca1251c0c2862623a99208a0c5..0000000000000000000000000000000000000000
--- a/cil/src/mergecil.ml
+++ /dev/null
@@ -1,1770 +0,0 @@
-(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* mergecil.ml *)
-(* This module is responsible for merging multiple CIL source trees into
- * a single, coherent CIL tree which contains the union of all the
- * definitions in the source files. It effectively acts like a linker,
- * but at the source code level instead of the object code level. *)
-
-
-module P = Pretty
-open Cil
-module E = Errormsg
-module H = Hashtbl
-module A = Alpha
-open Trace
-
-let debugMerge = false
-let debugInlines = false
-
-let ignore_merge_conflicts = ref false
-
-(* Try to merge structure with the same name. However, do not complain if
- * they are not the same *)
-let mergeSynonyms = true
-
-
-(** Whether to use path compression *)
-let usePathCompression = false
-
-(* Try to merge definitions of inline functions. They can appear in multiple
- * files and we would like them all to be the same. This can slow down the
- * merger an order of magnitude !!! *)
-let mergeInlines = true
-
-let mergeInlinesRepeat = mergeInlines && true
-
-let mergeInlinesWithAlphaConvert = mergeInlines && true
-
-(* when true, merge duplicate definitions of externally-visible functions;
- * this uses a mechanism which is faster than the one for inline functions,
- * but only probabilistically accurate *)
-let mergeGlobals = true
-
-
-(* Return true if 's' starts with the prefix 'p' *)
-let prefix p s =
- let lp = String.length p in
- let ls = String.length s in
- lp <= ls && String.sub s 0 lp = p
-
-
-
-(* A name is identified by the index of the file in which it occurs (starting
- * at 0 with the first file) and by the actual name. We'll keep name spaces
- * separate *)
-
-(* We define a data structure for the equivalence classes *)
-type 'a node =
- { nname: string; (* The actual name *)
- nfidx: int; (* The file index *)
- ndata: 'a; (* Data associated with the node *)
- mutable nloc: (location * int) option;
- (* location where defined and index within the file of the definition.
- * If None then it means that this node actually DOES NOT appear in the
- * given file. In rare occasions we need to talk in a given file about
- * types that are not defined in that file. This happens with undefined
- * structures but also due to cross-contamination of types in a few of
- * the cases of combineType (see the definition of combineTypes). We
- * try never to choose as representatives nodes without a definition.
- * We also choose as representative the one that appears earliest *)
- mutable nrep: 'a node; (* A pointer to another node in its class (one
- * closer to the representative). The nrep node
- * is always in an earlier file, except for the
- * case where a name is undefined in one file
- * and defined in a later file. If this pointer
- * points to the node itself then this is the
- * representative. *)
- mutable nmergedSyns: bool (* Whether we have merged the synonyms for
- * the node of this name *)
- }
-
-let d_nloc () (lo: (location * int) option) : P.doc =
- match lo with
- None -> P.text "None"
- | Some (l, idx) -> P.dprintf "Some(%d at %a)" idx d_loc l
-
-(* Make a node with a self loop. This is quite tricky. *)
-let mkSelfNode (eq: (int * string, 'a node) H.t) (* The equivalence table *)
- (syn: (string, 'a node) H.t) (* The synonyms table *)
- (fidx: int) (name: string) (data: 'a)
- (l: (location * int) option) =
- let res = { nname = name; nfidx = fidx; ndata = data; nloc = l;
- nrep = Obj.magic 1; nmergedSyns = false; } in
- res.nrep <- res; (* Make the self cycle *)
- H.add eq (fidx, name) res; (* Add it to the proper table *)
- if mergeSynonyms && not (prefix "__anon" name) then
- H.add syn name res;
- res
-
-let debugFind = false
-
-(* Find the representative with or without path compression *)
-let rec find (pathcomp: bool) (nd: 'a node) =
- if debugFind then
- ignore (E.log " find %s(%d)\n" nd.nname nd.nfidx);
- if nd.nrep == nd then begin
- if debugFind then
- ignore (E.log " = %s(%d)\n" nd.nname nd.nfidx);
- nd
- end else begin
- let res = find pathcomp nd.nrep in
- if usePathCompression && pathcomp && nd.nrep != res then
- nd.nrep <- res; (* Compress the paths *)
- res
- end
-
-
-(* Union two nodes and return the new representative. We prefer as the
- * representative a node defined earlier. We try not to use as
- * representatives nodes that are not defined in their files. We return a
- * function for undoing the union. Make sure that between the union and the
- * undo you do not do path compression *)
-let union (nd1: 'a node) (nd2: 'a node) : 'a node * (unit -> unit) =
- (* Move to the representatives *)
- let nd1 = find true nd1 in
- let nd2 = find true nd2 in
- if nd1 == nd2 then begin
- (* It can happen that we are trying to union two nodes that are already
- * equivalent. This is because between the time we check that two nodes
- * are not already equivalent and the time we invoke the union operation
- * we check type isomorphism which might change the equivalence classes *)
-(*
- ignore (warn "unioning already equivalent nodes for %s(%d)"
- nd1.nname nd1.nfidx);
-*)
- nd1, fun x -> x
- end else begin
- let rep, norep = (* Choose the representative *)
- if (nd1.nloc != None) = (nd2.nloc != None) then
- (* They have the same defined status. Choose the earliest *)
- if nd1.nfidx < nd2.nfidx then nd1, nd2
- else if nd1.nfidx > nd2.nfidx then nd2, nd1
- else (* In the same file. Choose the one with the earliest index *) begin
- match nd1.nloc, nd2.nloc with
- Some (_, didx1), Some (_, didx2) ->
- if didx1 < didx2 then nd1, nd2 else
- if didx1 > didx2 then nd2, nd1
- else begin
- ignore (warn
- "Merging two elements (%s and %s) in the same file (%d) with the same idx (%d) within the file"
- nd1.nname nd2.nname nd1.nfidx didx1);
- nd1, nd2
- end
- | _, _ -> (* both none. Does not matter which one we choose. Should
- * not happen though. *)
- (* sm: it does happen quite a bit when, e.g. merging STLport with
- * some client source; I'm disabling the warning since it supposedly
- * is harmless anyway, so is useless noise *)
- (* sm: re-enabling on claim it now will probably not happen *)
- ignore (warn "Merging two undefined elements in the same file: %s and %s\n" nd1.nname nd2.nname);
- nd1, nd2
- end
- else (* One is defined, the other is not. Choose the defined one *)
- if nd1.nloc != None then nd1, nd2 else nd2, nd1
- in
- let oldrep = norep.nrep in
- norep.nrep <- rep;
- rep, (fun () -> norep.nrep <- oldrep)
- end
-(*
-let union (nd1: 'a node) (nd2: 'a node) : 'a node * (unit -> unit) =
- if nd1 == nd2 && nd1.nname = "!!!intEnumInfo!!!" then begin
- ignore (warn "unioning two identical nodes for %s(%d)"
- nd1.nname nd1.nfidx);
- nd1, fun x -> x
- end else
- union nd1 nd2
-*)
-(* Find the representative for a node and compress the paths in the process *)
-let findReplacement
- (pathcomp: bool)
- (eq: (int * string, 'a node) H.t)
- (fidx: int)
- (name: string) : ('a * int) option =
- if debugFind then
- ignore (E.log "findReplacement for %s(%d)\n" name fidx);
- try
- let nd = H.find eq (fidx, name) in
- if nd.nrep == nd then begin
- if debugFind then
- ignore (E.log " is a representative\n");
- None (* No replacement if this is the representative of its class *)
- end else
- let rep = find pathcomp nd in
- if rep != rep.nrep then
- E.s (bug "find does not return the representative\n");
- if debugFind then
- ignore (E.log " RES = %s(%d)\n" rep.nname rep.nfidx);
- Some (rep.ndata, rep.nfidx)
- with Not_found -> begin
- if debugFind then
- ignore (E.log " not found in the map\n");
- None
- end
-
-(* Make a node if one does not already exist. Otherwise return the
- * representative *)
-let getNode (eq: (int * string, 'a node) H.t)
- (syn: (string, 'a node) H.t)
- (fidx: int) (name: string) (data: 'a)
- (l: (location * int) option) =
- let debugGetNode = false in
- if debugGetNode then
- ignore (E.log "getNode(%s(%d), %a)\n"
- name fidx d_nloc l);
- try
- let res = H.find eq (fidx, name) in
-
- (match res.nloc, l with
- (* Maybe we have a better location now *)
- None, Some _ -> res.nloc <- l
- | Some (old_l, old_idx), Some (l, idx) ->
- if old_idx != idx then
- ignore (warn "Duplicate definition of node %s(%d) at indices %d(%a) and %d(%a)"
- name fidx old_idx d_loc old_l idx d_loc l)
- else
- ()
-
- | _, _ -> ());
- if debugGetNode then
- ignore (E.log " node already found\n");
- find false res (* No path compression *)
- with Not_found -> begin
- let res = mkSelfNode eq syn fidx name data l in
- if debugGetNode then
- ignore (E.log " made a new one\n");
- res
- end
-
-
-
-(* Dump a graph *)
-let dumpGraph (what: string) (eq: (int * string, 'a node) H.t) : unit =
- ignore (E.log "Equivalence graph for %s is:\n" what);
- H.iter (fun (fidx, name) nd ->
- ignore (E.log " %s(%d) %s-> "
- name fidx (if nd.nloc = None then "(undef)" else ""));
- if nd.nrep == nd then
- ignore (E.log "*\n")
- else
- ignore (E.log " %s(%d)\n" nd.nrep.nname nd.nrep.nfidx ))
- eq
-
-
-
-
-(* For each name space we define a set of equivalence classes *)
-let vEq: (int * string, varinfo node) H.t = H.create 111 (* Vars *)
-let sEq: (int * string, compinfo node) H.t = H.create 111 (* Struct + union *)
-let eEq: (int * string, enuminfo node) H.t = H.create 111 (* Enums *)
-let tEq: (int * string, typeinfo node) H.t = H.create 111 (* Type names*)
-let iEq: (int * string, varinfo node) H.t = H.create 111 (* Inlines *)
-
-(* Sometimes we want to merge synonyms. We keep some tables indexed by names.
- * Each name is mapped to multiple exntries *)
-let vSyn: (string, varinfo node) H.t = H.create 111 (* Not actually used *)
-let iSyn: (string, varinfo node) H.t = H.create 111 (* Inlines *)
-let sSyn: (string, compinfo node) H.t = H.create 111
-let eSyn: (string, enuminfo node) H.t = H.create 111
-let tSyn: (string, typeinfo node) H.t = H.create 111
-
-(** A global environment for variables. Put in here only the non-static
- * variables, indexed by their name. *)
-let vEnv : (string, varinfo node) H.t = H.create 111
-
-
-(* A set of inline functions indexed by their printout ! *)
-let inlineBodies : (P.doc, varinfo node) H.t = H.create 111
-
-(** A number of alpha conversion tables. We ought to keep one table for each
- * name space. Unfortunately, because of the way the C lexer works, type
- * names must be different from variable names!! We one alpha table both for
- * variables and types. *)
-let vtAlpha : (string, location A.alphaTableData ref) H.t
- = H.create 57 (* Variables and
- * types *)
-let sAlpha : (string, location A.alphaTableData ref) H.t
- = H.create 57 (* Structures and
- * unions have
- * the same name
- * space *)
-let eAlpha : (string, location A.alphaTableData ref) H.t
- = H.create 57 (* Enumerations *)
-
-
-(** Keep track, for all global function definitions, of the names of the formal
- * arguments. They might change during merging of function types if the
- * prototype occurs after the function definition and uses different names.
- * We'll restore the names at the end *)
-let formalNames: (int * string, string list) H.t = H.create 111
-
-
-(* Accumulate here the globals in the merged file *)
-let theFileTypes = ref []
-let theFile = ref []
-
-(* add 'g' to the merged file *)
-let mergePushGlobal (g: global) : unit =
- pushGlobal g ~types:theFileTypes ~variables:theFile
-
-let mergePushGlobals gl = List.iter mergePushGlobal gl
-
-
-(* The index of the current file being scanned *)
-let currentFidx = ref 0
-
-let currentDeclIdx = ref 0 (* The index of the definition in a file. This is
- * maintained both in pass 1 and in pass 2. Make
- * sure you count the same things in both passes. *)
-(* Keep here the file names *)
-let fileNames : (int, string) H.t = H.create 113
-
-
-
-(* Remember the composite types that we have already declared *)
-let emittedCompDecls: (string, bool) H.t = H.create 113
-(* Remember the variables also *)
-let emittedVarDecls: (string, bool) H.t = H.create 113
-
-(* also keep track of externally-visible function definitions;
- * name maps to declaration, location, and semantic checksum *)
-let emittedFunDefn: (string, fundec * location * int) H.t = H.create 113
-(* and same for variable definitions; name maps to GVar fields *)
-let emittedVarDefn: (string, varinfo * init option * location) H.t = H.create 113
-
-(** A mapping from the new names to the original names. Used in PASS2 when we
- * rename variables. *)
-let originalVarNames: (string, string) H.t = H.create 113
-
-(* Initialize the module *)
-let init () =
- H.clear sAlpha;
- H.clear eAlpha;
- H.clear vtAlpha;
-
- H.clear vEnv;
-
- H.clear vEq;
- H.clear sEq;
- H.clear eEq;
- H.clear tEq;
- H.clear iEq;
-
- H.clear vSyn;
- H.clear sSyn;
- H.clear eSyn;
- H.clear tSyn;
- H.clear iSyn;
-
- theFile := [];
- theFileTypes := [];
-
- H.clear formalNames;
- H.clear inlineBodies;
-
- currentFidx := 0;
- currentDeclIdx := 0;
- H.clear fileNames;
-
- H.clear emittedVarDecls;
- H.clear emittedCompDecls;
-
- H.clear emittedFunDefn;
- H.clear emittedVarDefn;
-
- H.clear originalVarNames
-
-
-(* Some enumerations have to be turned into an integer. We implement this by
- * introducing a special enumeration type which we'll recognize later to be
- * an integer *)
-let intEnumInfo =
- { ename = "!!!intEnumInfo!!!"; (* This is otherwise invalid *)
- eitems = [];
- eattr = [];
- ereferenced = false;
- }
-(* And add it to the equivalence graph *)
-let intEnumInfoNode =
- getNode eEq eSyn 0 intEnumInfo.ename intEnumInfo
- (Some (locUnknown, 0))
-
- (* Combine the types. Raises the Failure exception with an error message.
- * isdef says whether the new type is for a definition *)
-type combineWhat =
- CombineFundef (* The new definition is for a function definition. The old
- * is for a prototype *)
- | CombineFunarg (* Comparing a function argument type with an old prototype
- * arg *)
- | CombineFunret (* Comparing the return of a function with that from an old
- * prototype *)
- | CombineOther
-
-
-let rec combineTypes (what: combineWhat)
- (oldfidx: int) (oldt: typ)
- (fidx: int) (t: typ) : typ =
- match oldt, t with
- | TVoid olda, TVoid a -> TVoid (addAttributes olda a)
- | TInt (oldik, olda), TInt (ik, a) ->
- let combineIK oldk k =
- if oldk == k then oldk else
- (* GCC allows a function definition to have a more precise integer
- * type than a prototype that says "int" *)
- if not !msvcMode && oldk = IInt && bitsSizeOf t <= 32
- && (what = CombineFunarg || what = CombineFunret)
- then
- k
- else (
- let msg =
- P.sprint ~width:80
- (P.dprintf
- "(different integer types %a and %a)"
- d_type oldt d_type t) in
- raise (Failure msg)
- )
- in
- TInt (combineIK oldik ik, addAttributes olda a)
-
- | TFloat (oldfk, olda), TFloat (fk, a) ->
- let combineFK oldk k =
- if oldk == k then oldk else
- (* GCC allows a function definition to have a more precise integer
- * type than a prototype that says "double" *)
- if not !msvcMode && oldk = FDouble && k = FFloat
- && (what = CombineFunarg || what = CombineFunret)
- then
- k
- else
- raise (Failure "(different floating point types)")
- in
- TFloat (combineFK oldfk fk, addAttributes olda a)
-
- | TEnum (oldei, olda), TEnum (ei, a) ->
- (* Matching enumerations always succeeds. But sometimes it maps both
- * enumerations to integers *)
- matchEnumInfo oldfidx oldei fidx ei;
- TEnum (oldei, addAttributes olda a)
-
-
- (* Strange one. But seems to be handled by GCC *)
- | TEnum (oldei, olda) , TInt(IInt, a) -> TEnum(oldei,
- addAttributes olda a)
-
- (* Strange one. But seems to be handled by GCC. Warning. Here we are
- * leaking types from new to old *)
- | TInt(IInt, olda), TEnum (ei, a) -> TEnum(ei, addAttributes olda a)
-
- | TComp (oldci, olda) , TComp (ci, a) ->
- matchCompInfo oldfidx oldci fidx ci;
- (* If we get here we were successful *)
- TComp (oldci, addAttributes olda a)
-
- | TArray (oldbt, oldsz, olda), TArray (bt, sz, a) ->
- let combbt = combineTypes CombineOther oldfidx oldbt fidx bt in
- let combinesz =
- match oldsz, sz with
- None, Some _ -> sz
- | Some _, None -> oldsz
- | None, None -> oldsz
- | Some oldsz', Some sz' ->
- let samesz =
- match constFold true oldsz', constFold true sz' with
- Const(CInt64(oldi, _, _)), Const(CInt64(i, _, _)) -> oldi = i
- | _, _ -> false
- in
- if samesz then oldsz else
- raise (Failure "(different array sizes)")
- in
- TArray (combbt, combinesz, addAttributes olda a)
-
- | TPtr (oldbt, olda), TPtr (bt, a) ->
- TPtr (combineTypes CombineOther oldfidx oldbt fidx bt,
- addAttributes olda a)
-
- (* WARNING: In this case we are leaking types from new to old !! *)
- | TFun (_, _, _, [Attr("missingproto",_)]), TFun _ -> t
-
-
- | TFun _, TFun (_, _, _, [Attr("missingproto",_)]) -> oldt
-
- | TFun (oldrt, oldargs, oldva, olda), TFun (rt, args, va, a) ->
- let newrt =
- combineTypes
- (if what = CombineFundef then CombineFunret else CombineOther)
- oldfidx oldrt fidx rt
- in
- if oldva != va then
- raise (Failure "(diferent vararg specifiers)");
- (* If one does not have arguments, believe the one with the
- * arguments *)
- let newargs =
- if oldargs = None then args else
- if args = None then oldargs else
- let oldargslist = argsToList oldargs in
- let argslist = argsToList args in
- if List.length oldargslist <> List.length argslist then
- raise (Failure "(different number of arguments)")
- else begin
- (* Go over the arguments and update the old ones with the
- * adjusted types *)
- Some
- (List.map2
- (fun (on, ot, oa) (an, at, aa) ->
- let n = if an <> "" then an else on in
- let t =
- combineTypes
- (if what = CombineFundef then
- CombineFunarg else CombineOther)
- oldfidx ot fidx at
- in
- let a = addAttributes oa aa in
- (n, t, a))
- oldargslist argslist)
- end
- in
- TFun (newrt, newargs, oldva, addAttributes olda a)
-
- | TBuiltin_va_list olda, TBuiltin_va_list a ->
- TBuiltin_va_list (addAttributes olda a)
-
- | TNamed (oldt, olda), TNamed (t, a) ->
- matchTypeInfo oldfidx oldt fidx t;
- (* If we get here we were able to match *)
- TNamed(oldt, addAttributes olda a)
-
- (* Unroll first the new type *)
- | _, TNamed (t, a) ->
- let res = combineTypes what oldfidx oldt fidx t.ttype in
- typeAddAttributes a res
-
- (* And unroll the old type as well if necessary *)
- | TNamed (oldt, a), _ ->
- let res = combineTypes what oldfidx oldt.ttype fidx t in
- typeAddAttributes a res
-
- | _ -> (
- (* raise (Failure "(different type constructors)") *)
- let msg:string = (P.sprint 1000 (P.dprintf "(different type constructors: %a vs. %a)"
- d_type oldt d_type t)) in
- raise (Failure msg)
- )
-
-
-(* Match two compinfos and throw a Failure if they do not match *)
-and matchCompInfo (oldfidx: int) (oldci: compinfo)
- (fidx: int) (ci: compinfo) : unit =
- if oldci.cstruct <> ci.cstruct then
- raise (Failure "(different struct/union types)");
- (* See if we have a mapping already *)
- (* Make the nodes if not already made. Actually return the
- * representatives *)
- let oldcinode = getNode sEq sSyn oldfidx oldci.cname oldci None in
- let cinode = getNode sEq sSyn fidx ci.cname ci None in
- if oldcinode == cinode then (* We already know they are the same *)
- ()
- else begin
- (* Replace with the representative data *)
- let oldci = oldcinode.ndata in
- let oldfidx = oldcinode.nfidx in
- let ci = cinode.ndata in
- let fidx = cinode.nfidx in
-
- let old_len = List.length oldci.cfields in
- let len = List.length ci.cfields in
- (* It is easy to catch here the case when the new structure is undefined
- * and the old one was defined. We just reuse the old *)
- (* More complicated is the case when the old one is not defined but the
- * new one is. We still reuse the old one and we'll take care of defining
- * it later with the new fields.
- * GN: 7/10/04, I could not find when is "later", so I added it below *)
- if len <> 0 && old_len <> 0 && old_len <> len then (
- let curLoc = !currentLoc in (* d_global blows this away.. *)
- (trace "merge" (P.dprintf "different # of fields\n%d: %a\n%d: %a\n"
- old_len d_global (GCompTag(oldci,locUnknown))
- len d_global (GCompTag(ci,locUnknown))
- ));
- currentLoc := curLoc;
- let msg = Printf.sprintf
- "(different number of fields in %s and %s: %d != %d.)"
- oldci.cname ci.cname old_len len in
- raise (Failure msg)
- );
- (* We check that they are defined in the same way. While doing this there
- * might be recursion and we have to watch for going into an infinite
- * loop. So we add the assumption that they are equal *)
- let newrep, undo = union oldcinode cinode in
- (* We check the fields but watch for Failure. We only do the check when
- * the lengths are the same. Due to the code above this the other
- * possibility is that one of the length is 0, in which case we reuse the
- * old compinfo. *)
- (* But what if the old one is the empty one ? *)
- if old_len = len then begin
- (try
- List.iter2
- (fun oldf f ->
- if oldf.fbitfield <> f.fbitfield then
- raise (Failure "(different bitfield info)");
- if oldf.fattr <> f.fattr then
- raise (Failure "(different field attributes)");
- (* Make sure the types are compatible *)
- let newtype =
- combineTypes CombineOther oldfidx oldf.ftype fidx f.ftype
- in
- (* Change the type in the representative *)
- oldf.ftype <- newtype;
- )
- oldci.cfields ci.cfields
- with Failure reason -> begin
- (* Our assumption was wrong. Forget the isomorphism *)
- undo ();
- let msg =
- P.sprint ~width:80
- (P.dprintf
- "\n\tFailed assumption that %s and %s are isomorphic %s@!%a@!%a"
- (compFullName oldci) (compFullName ci) reason
- dn_global (GCompTag(oldci,locUnknown))
- dn_global (GCompTag(ci,locUnknown)))
- in
- raise (Failure msg)
- end)
- end else begin
- (* We will reuse the old one. One of them is empty. If the old one is
- * empty, copy over the fields from the new one. Won't this result in
- * all sorts of undefined types??? *)
- if old_len = 0 then
- oldci.cfields <- ci.cfields;
- end;
- (* We get here when we succeeded checking that they are equal, or one of
- * them was empty *)
- newrep.ndata.cattr <- addAttributes oldci.cattr ci.cattr;
- ()
- end
-
-(* Match two enuminfos and throw a Failure if they do not match *)
-and matchEnumInfo (oldfidx: int) (oldei: enuminfo)
- (fidx: int) (ei: enuminfo) : unit =
- (* Find the node for this enum, no path compression. *)
- let oldeinode = getNode eEq eSyn oldfidx oldei.ename oldei None in
- let einode = getNode eEq eSyn fidx ei.ename ei None in
- if oldeinode == einode then (* We already know they are the same *)
- ()
- else begin
- (* Replace with the representative data *)
- let oldei = oldeinode.ndata in
- let ei = einode.ndata in
- (* Try to match them. But if you cannot just make them both integers *)
- try
- (* We do not have a mapping. They better be defined in the same way *)
- if List.length oldei.eitems <> List.length ei.eitems then
- raise (Failure "(different number of enumeration elements)");
- (* We check that they are defined in the same way. This is a fairly
- * conservative check. *)
- List.iter2
- (fun (old_iname, old_iv, _) (iname, iv, _) ->
- if old_iname <> iname then
- raise (Failure "(different names for enumeration items)");
- let samev =
- match constFold true old_iv, constFold true iv with
- Const(CInt64(oldi, _, _)), Const(CInt64(i, _, _)) -> oldi = i
- | _ -> false
- in
- if not samev then
- raise (Failure "(different values for enumeration items)"))
- oldei.eitems ei.eitems;
- (* Set the representative *)
- let newrep, _ = union oldeinode einode in
- (* We get here if the enumerations match *)
- newrep.ndata.eattr <- addAttributes oldei.eattr ei.eattr;
- ()
- with Failure msg -> begin
- (* Get here if you cannot merge two enumeration nodes *)
- if oldeinode != intEnumInfoNode then begin
- let _ = union oldeinode intEnumInfoNode in ()
- end;
- if einode != intEnumInfoNode then begin
- let _ = union einode intEnumInfoNode in ()
- end;
- end
- end
-
-
-(* Match two typeinfos and throw a Failure if they do not match *)
-and matchTypeInfo (oldfidx: int) (oldti: typeinfo)
- (fidx: int) (ti: typeinfo) : unit =
- if oldti.tname = "" || ti.tname = "" then
- E.s (bug "matchTypeInfo for anonymous type\n");
- (* Find the node for this enum, no path compression. *)
- let oldtnode = getNode tEq tSyn oldfidx oldti.tname oldti None in
- let tnode = getNode tEq tSyn fidx ti.tname ti None in
- if oldtnode == tnode then (* We already know they are the same *)
- ()
- else begin
- (* Replace with the representative data *)
- let oldti = oldtnode.ndata in
- let oldfidx = oldtnode.nfidx in
- let ti = tnode.ndata in
- let fidx = tnode.nfidx in
- (* Check that they are the same *)
- (try
- ignore (combineTypes CombineOther oldfidx oldti.ttype fidx ti.ttype);
- with Failure reason -> begin
- let msg =
- P.sprint ~width:80
- (P.dprintf
- "\n\tFailed assumption that %s and %s are isomorphic %s"
- oldti.tname ti.tname reason) in
- raise (Failure msg)
- end);
- let _ = union oldtnode tnode in
- ()
- end
-
-(* Scan all files and do two things *)
-(* 1. Initialize the alpha renaming tables with the names of the globals so
- * that when we come in the second pass to generate new names, we do not run
- * into conflicts. *)
-(* 2. For all declarations of globals unify their types. In the process
- * construct a set of equivalence classes on type names, structure and
- * enumeration tags *)
-(* 3. We clean the referenced flags *)
-
-let rec oneFilePass1 (f:file) : unit =
- H.add fileNames !currentFidx f.fileName;
- if debugMerge || !E.verboseFlag then
- ignore (E.log "Pre-merging (%d) %s\n" !currentFidx f.fileName);
- currentDeclIdx := 0;
- if f.globinitcalled || f.globinit <> None then
- E.s (E.warn "Merging file %s has global initializer" f.fileName);
-
- (* We scan each file and we look at all global varinfo. We see if globals
- * with the same name have been encountered before and we merge those types
- * *)
- let matchVarinfo (vi: varinfo) (l: location * int) =
- ignore (Alpha.registerAlphaName vtAlpha None vi.vname !currentLoc);
- (* Make a node for it and put it in vEq *)
- let vinode = mkSelfNode vEq vSyn !currentFidx vi.vname vi (Some l) in
- try
- let oldvinode = find true (H.find vEnv vi.vname) in
- let oldloc, _ =
- match oldvinode.nloc with
- None -> E.s (bug "old variable is undefined")
- | Some l -> l
- in
- let oldvi = oldvinode.ndata in
- (* There is an old definition. We must combine the types. Do this first
- * because it might fail *)
- let newtype =
- try
- combineTypes CombineOther
- oldvinode.nfidx oldvi.vtype
- !currentFidx vi.vtype;
- with (Failure reason) -> begin
- (* Go ahead *)
- let f = if !ignore_merge_conflicts then warn else error in
- ignore (f "Incompatible declaration for %s (from %s(%d)).@! Previous was at %a (from %s (%d)) %s "
- vi.vname (H.find fileNames !currentFidx) !currentFidx
- d_loc oldloc
- (H.find fileNames oldvinode.nfidx) oldvinode.nfidx
- reason);
- raise Not_found
- end
- in
- let newrep, _ = union oldvinode vinode in
- (* We do not want to turn non-"const" globals into "const" one. That
- * can happen if one file declares the variable a non-const while
- * others declare it as "const". *)
- if hasAttribute "const" (typeAttrs vi.vtype) !=
- hasAttribute "const" (typeAttrs oldvi.vtype) then begin
- newrep.ndata.vtype <- typeRemoveAttributes ["const"] newtype;
- end else begin
- newrep.ndata.vtype <- newtype;
- end;
- (* clean up the storage. *)
- let newstorage =
- if vi.vstorage = oldvi.vstorage || vi.vstorage = Extern then
- oldvi.vstorage
- else if oldvi.vstorage = Extern then vi.vstorage
- (* Sometimes we turn the NoStorage specifier into Static for inline
- * functions *)
- else if oldvi.vstorage = Static &&
- vi.vstorage = NoStorage then Static
- else begin
- ignore (warn "Inconsistent storage specification for %s. Now is %a and previous was %a at %a"
- vi.vname d_storage vi.vstorage d_storage oldvi.vstorage
- d_loc oldloc);
- vi.vstorage
- end
- in
- newrep.ndata.vstorage <- newstorage;
- newrep.ndata.vattr <- addAttributes oldvi.vattr vi.vattr;
- ()
- with Not_found -> (* Not present in the previous files. Remember it for
- * later *)
- H.add vEnv vi.vname vinode
-
- in
- List.iter
- (function
- | GVarDecl (vi, l) | GVar (vi, _, l) ->
- currentLoc := l;
- incr currentDeclIdx;
- vi.vreferenced <- false;
- if vi.vstorage <> Static then begin
- matchVarinfo vi (l, !currentDeclIdx);
- end
-
- | GFun (fdec, l) ->
- currentLoc := l;
- incr currentDeclIdx;
- (* Save the names of the formal arguments *)
- let _, args, _, _ = splitFunctionTypeVI fdec.svar in
- H.add formalNames (!currentFidx, fdec.svar.vname)
- (List.map (fun (fn, _, _) -> fn) (argsToList args));
- fdec.svar.vreferenced <- false;
- (* Force inline functions to be static. *)
- (* GN: This turns out to be wrong. inline functions are external,
- * unless specified to be static. *)
- (*
- if fdec.svar.vinline && fdec.svar.vstorage = NoStorage then
- fdec.svar.vstorage <- Static;
- *)
- if fdec.svar.vstorage <> Static then begin
- matchVarinfo fdec.svar (l, !currentDeclIdx)
- end else begin
- if fdec.svar.vinline && mergeInlines then
- (* Just create the nodes for inline functions *)
- ignore (getNode iEq iSyn !currentFidx
- fdec.svar.vname fdec.svar (Some (l, !currentDeclIdx)))
- end
- (* Make nodes for the defined type and structure tags *)
- | GType (t, l) ->
- incr currentDeclIdx;
- t.treferenced <- false;
- if t.tname <> "" then (* The empty names are just for introducing
- * undefined comp tags *)
- ignore (getNode tEq tSyn !currentFidx t.tname t
- (Some (l, !currentDeclIdx)))
- else begin (* Go inside and clean the referenced flag for the
- * declared tags *)
- match t.ttype with
- TComp (ci, _) ->
- ci.creferenced <- false;
- (* Create a node for it *)
- ignore (getNode sEq sSyn !currentFidx ci.cname ci None)
-
- | TEnum (ei, _) ->
- ei.ereferenced <- false;
- ignore (getNode eEq eSyn !currentFidx ei.ename ei None);
-
- | _ -> E.s (bug "Anonymous Gtype is not TComp")
- end
-
- | GCompTag (ci, l) ->
- incr currentDeclIdx;
- ci.creferenced <- false;
- ignore (getNode sEq sSyn !currentFidx ci.cname ci
- (Some (l, !currentDeclIdx)))
- | GEnumTag (ei, l) ->
- incr currentDeclIdx;
- ei.ereferenced <- false;
- ignore (getNode eEq eSyn !currentFidx ei.ename ei
- (Some (l, !currentDeclIdx)))
-
- | _ -> ())
- f.globals
-
-
-(* Try to merge synonyms. Do not give an error if they fail to merge *)
-let doMergeSynonyms
- (syn : (string, 'a node) H.t)
- (eq : (int * string, 'a node) H.t)
- (compare : int -> 'a -> int -> 'a -> unit) (* A comparison function that
- * throws Failure if no match *)
- : unit =
- H.iter (fun n node ->
- if not node.nmergedSyns then begin
- (* find all the nodes for the same name *)
- let all = H.find_all syn n in
- let rec tryone (classes: 'a node list) (* A number of representatives
- * for this name *)
- (nd: 'a node) : 'a node list (* Returns an expanded set
- * of classes *) =
- nd.nmergedSyns <- true;
- (* Compare in turn with all the classes we have so far *)
- let rec compareWithClasses = function
- [] -> [nd](* No more classes. Add this as a new class *)
- | c :: restc ->
- try
- compare c.nfidx c.ndata nd.nfidx nd.ndata;
- (* Success. Stop here the comparison *)
- c :: restc
- with Failure _ -> (* Failed. Try next class *)
- c :: (compareWithClasses restc)
- in
- compareWithClasses classes
- in
- (* Start with an empty set of classes for this name *)
- let _ = List.fold_left tryone [] all in
- ()
- end)
- syn
-
-
-let matchInlines (oldfidx: int) (oldi: varinfo)
- (fidx: int) (i: varinfo) =
- let oldinode = getNode iEq iSyn oldfidx oldi.vname oldi None in
- let inode = getNode iEq iSyn fidx i.vname i None in
- if oldinode == inode then
- ()
- else begin
- (* Replace with the representative data *)
- let oldi = oldinode.ndata in
- let oldfidx = oldinode.nfidx in
- let i = inode.ndata in
- let fidx = inode.nfidx in
- (* There is an old definition. We must combine the types. Do this first
- * because it might fail *)
- oldi.vtype <-
- combineTypes CombineOther
- oldfidx oldi.vtype fidx i.vtype;
- (* We get here if we have success *)
- (* Combine the attributes as well *)
- oldi.vattr <- addAttributes oldi.vattr i.vattr;
- (* Do not union them yet because we do not know that they are the same.
- * We have checked only the types so far *)
- ()
- end
-
-(************************************************************
- *
- * PASS 2
- *
- *
- ************************************************************)
-
-(** Keep track of the functions we have used already in the file. We need
- * this to avoid removing an inline function that has been used already.
- * This can only occur if the inline function is defined after it is used
- * already; a bad style anyway *)
-let varUsedAlready: (string, unit) H.t = H.create 111
-
-(** A visitor that renames uses of variables and types *)
-class renameVisitorClass = object (self)
- inherit nopCilVisitor
-
- (* This is either a global variable which we took care of, or a local
- * variable. Must do its type and attributes. *)
- method vvdec (vi: varinfo) = DoChildren
-
- (* This is a variable use. See if we must change it *)
- method vvrbl (vi: varinfo) : varinfo visitAction =
- if not vi.vglob then DoChildren else
- if vi.vreferenced then begin
- H.add varUsedAlready vi.vname ();
- DoChildren
- end else begin
- match findReplacement true vEq !currentFidx vi.vname with
- None -> DoChildren
- | Some (vi', oldfidx) ->
- if debugMerge then
- ignore (E.log "Renaming use of var %s(%d) to %s(%d)\n"
- vi.vname !currentFidx vi'.vname oldfidx);
- vi'.vreferenced <- true;
- H.add varUsedAlready vi'.vname ();
- ChangeTo vi'
- end
-
-
- (* The use of a type. Change only those types whose underlying info
- * is not a root. *)
- method vtype (t: typ) =
- match t with
- TComp (ci, a) when not ci.creferenced -> begin
- match findReplacement true sEq !currentFidx ci.cname with
- None -> DoChildren
- | Some (ci', oldfidx) ->
- if debugMerge then
- ignore (E.log "Renaming use of %s(%d) to %s(%d)\n"
- ci.cname !currentFidx ci'.cname oldfidx);
- ChangeTo (TComp (ci', visitCilAttributes (self :> cilVisitor) a))
- end
- | TEnum (ei, a) when not ei.ereferenced -> begin
- match findReplacement true eEq !currentFidx ei.ename with
- None -> DoChildren
- | Some (ei', _) ->
- if ei' == intEnumInfo then
- (* This is actually our friend intEnumInfo *)
- ChangeTo (TInt(IInt, visitCilAttributes (self :> cilVisitor) a))
- else
- ChangeTo (TEnum (ei', visitCilAttributes (self :> cilVisitor) a))
- end
-
- | TNamed (ti, a) when not ti.treferenced -> begin
- match findReplacement true tEq !currentFidx ti.tname with
- None -> DoChildren
- | Some (ti', _) ->
- ChangeTo (TNamed (ti', visitCilAttributes (self :> cilVisitor) a))
- end
-
- | _ -> DoChildren
-
- (* The Field offset might need to be changed to use new compinfo *)
- method voffs = function
- Field (f, o) -> begin
- (* See if the compinfo was changed *)
- if f.fcomp.creferenced then
- DoChildren
- else begin
- match findReplacement true sEq !currentFidx f.fcomp.cname with
- None -> DoChildren (* We did not replace it *)
- | Some (ci', oldfidx) -> begin
- (* First, find out the index of the original field *)
- let rec indexOf (i: int) = function
- [] ->
- E.s (bug "Cannot find field %s in %s(%d)\n"
- f.fname (compFullName f.fcomp) !currentFidx)
- | f' :: rest when f' == f -> i
- | _ :: rest -> indexOf (i + 1) rest
- in
- let index = indexOf 0 f.fcomp.cfields in
- if List.length ci'.cfields <= index then
- E.s (bug "Too few fields in replacement %s(%d) for %s(%d)\n"
- (compFullName ci') oldfidx
- (compFullName f.fcomp) !currentFidx);
- let f' = List.nth ci'.cfields index in
- ChangeDoChildrenPost (Field (f', o), fun x -> x)
- end
- end
- end
- | _ -> DoChildren
-
- method vinitoffs o =
- (self#voffs o) (* treat initializer offsets same as lvalue offsets *)
-
-end
-
-let renameVisitor = new renameVisitorClass
-
-
-(** A visitor that renames uses of inline functions that were discovered in
- * pass 2 to be used before they are defined. This is like the renameVisitor
- * except it only looks at the variables (thus it is a bit more efficient)
- * and it also renames forward declarations of the inlines to be removed. *)
-
-class renameInlineVisitorClass = object (self)
- inherit nopCilVisitor
-
- (* This is a variable use. See if we must change it *)
- method vvrbl (vi: varinfo) : varinfo visitAction =
- if not vi.vglob then DoChildren else
- if vi.vreferenced then begin (* Already renamed *)
- DoChildren
- end else begin
- match findReplacement true vEq !currentFidx vi.vname with
- None -> DoChildren
- | Some (vi', oldfidx) ->
- if debugMerge then
- ignore (E.log "Renaming var %s(%d) to %s(%d)\n"
- vi.vname !currentFidx vi'.vname oldfidx);
- vi'.vreferenced <- true;
- ChangeTo vi'
- end
-
- (* And rename some declarations of inlines to remove. We cannot drop this
- * declaration (see small1/combineinline6) *)
- method vglob = function
- GVarDecl(vi, l) when vi.vinline -> begin
- (* Get the original name *)
- let origname =
- try H.find originalVarNames vi.vname
- with Not_found -> vi.vname
- in
- (* Now see if this must be replaced *)
- match findReplacement true vEq !currentFidx origname with
- None -> DoChildren
- | Some (vi', _) -> ChangeTo [GVarDecl (vi', l)]
- end
- | _ -> DoChildren
-
-end
-let renameInlinesVisitor = new renameInlineVisitorClass
-
-
-(* sm: First attempt at a semantic checksum for function bodies.
- * Ideally, two function's checksums would be equal only when their
- * bodies were provably equivalent; but I'm using a much simpler and
- * less accurate heuristic here. It should be good enough for the
- * purpose I have in mind, which is doing duplicate removal of
- * multiply-instantiated template functions. *)
-let functionChecksum (dec: fundec) : int =
-begin
- (* checksum the structure of the statements (only) *)
- let rec stmtListSum (lst : stmt list) : int =
- (List.fold_left (fun acc s -> acc + (stmtSum s)) 0 lst)
- and stmtSum (s: stmt) : int =
- (* strategy is to just throw a lot of prime numbers into the
- * computation in hopes of avoiding accidental collision.. *)
- match s.skind with
- | Instr(l) -> 13 + 67*(List.length l)
- | Return(_) -> 17
- | Goto(_) -> 19
- | Break(_) -> 23
- | Continue(_) -> 29
- | If(_,b1,b2,_) -> 31 + 37*(stmtListSum b1.bstmts)
- + 41*(stmtListSum b2.bstmts)
- | Switch(_,b,_,_) -> 43 + 47*(stmtListSum b.bstmts)
- (* don't look at stmt list b/c is not part of tree *)
-(*
- | Loop(b,_,_,_) -> 49 + 53*(stmtListSum b.bstmts)
-*)
- | While(_,b,_) -> 49 + 53*(stmtListSum b.bstmts)
- | DoWhile(_,b,_) -> 49 + 53*(stmtListSum b.bstmts)
- | For(_,_,_,b,_) -> 49 + 53*(stmtListSum b.bstmts)
- | Block(b) -> 59 + 61*(stmtListSum b.bstmts)
- | TryExcept (b, (il, e), h, _) ->
- 67 + 83*(stmtListSum b.bstmts) + 97*(stmtListSum h.bstmts)
- | TryFinally (b, h, _) ->
- 103 + 113*(stmtListSum b.bstmts) + 119*(stmtListSum h.bstmts)
- in
-
- (* disabled 2nd and 3rd measure because they appear to get different
- * values, for the same code, depending on whether the code was just
- * parsed into CIL or had previously been parsed into CIL, printed
- * out, then re-parsed into CIL *)
- let a,b,c,d,e =
- (List.length dec.sformals), (* # formals *)
- 0 (*(List.length dec.slocals)*), (* # locals *)
- 0 (*dec.smaxid*), (* estimate of internal statement count *)
- (List.length dec.sbody.bstmts), (* number of statements at outer level *)
- (stmtListSum dec.sbody.bstmts) in (* checksum of statement structure *)
- (*(trace "sm" (P.dprintf "sum: %s is %d %d %d %d %d\n"*)
- (* dec.svar.vname a b c d e));*)
- 2*a + 3*b + 5*c + 7*d + 11*e
-end
-
-
-(* sm: equality for initializers, etc.; this is like '=', except
- * when we reach shared pieces (like references into the type
- * structure), we use '==', to prevent circularity *)
-(* update: that's no good; I'm using this to find things which
- * are equal but from different CIL trees, so nothing will ever
- * be '=='.. as a hack I'll just change those places to 'true',
- * so these functions are not now checking proper equality..
- * places where equality is not complete are marked "INC" *)
-let rec equalInits (x: init) (y: init) : bool =
-begin
- match x,y with
- | SingleInit(xe), SingleInit(ye) -> (equalExps xe ye)
- | CompoundInit(xt, xoil), CompoundInit(yt, yoil) ->
- (*(xt == yt) &&*) (* INC *) (* types need to be identically equal *)
- let rec equalLists xoil yoil : bool =
- match xoil,yoil with
- | ((xo,xi) :: xrest), ((yo,yi) :: yrest) ->
- (equalOffsets xo yo) &&
- (equalInits xi yi) &&
- (equalLists xrest yrest)
- | [], [] -> true
- | _, _ -> false
- in
- (equalLists xoil yoil)
- | _, _ -> false
-end
-
-and equalOffsets (x: offset) (y: offset) : bool =
-begin
- match x,y with
- | NoOffset, NoOffset -> true
- | Field(xfi,xo), Field(yfi,yo) ->
- (xfi.fname = yfi.fname) && (* INC: same fieldinfo name.. *)
- (equalOffsets xo yo)
- | Index(xe,xo), Index(ye,yo) ->
- (equalExps xe ye) &&
- (equalOffsets xo yo)
- | _,_ -> false
-end
-
-and equalExps (x: exp) (y: exp) : bool =
-begin
- match x,y with
- | Const(xc), Const(yc) -> xc = yc || (* safe to use '=' on literals *)
- (
- (* CIL changes (unsigned)0 into 0U during printing.. *)
- match xc,yc with
- | CInt64(xv,_,_),CInt64(yv,_,_) ->
- (Int64.to_int xv) = 0 && (* ok if they're both 0 *)
- (Int64.to_int yv) = 0
- | _,_ -> false
- )
- | Lval(xl), Lval(yl) -> (equalLvals xl yl)
- | SizeOf(xt), SizeOf(yt) -> true (*INC: xt == yt*) (* identical types *)
- | SizeOfE(xe), SizeOfE(ye) -> (equalExps xe ye)
- | AlignOf(xt), AlignOf(yt) -> true (*INC: xt == yt*)
- | AlignOfE(xe), AlignOfE(ye) -> (equalExps xe ye)
- | UnOp(xop,xe,xt), UnOp(yop,ye,yt) ->
- xop = yop &&
- (equalExps xe ye) &&
- true (*INC: xt == yt*)
- | BinOp(xop,xe1,xe2,xt), BinOp(yop,ye1,ye2,yt) ->
- xop = yop &&
- (equalExps xe1 ye1) &&
- (equalExps xe2 ye2) &&
- true (*INC: xt == yt*)
- | CastE(xt,xe), CastE(yt,ye) ->
- (*INC: xt == yt &&*)
- (equalExps xe ye)
- | AddrOf(xl), AddrOf(yl) -> (equalLvals xl yl)
- | StartOf(xl), StartOf(yl) -> (equalLvals xl yl)
-
- (* initializers that go through CIL multiple times sometimes lose casts they
- * had the first time; so allow a different of a cast *)
- | CastE(xt,xe), ye ->
- (equalExps xe ye)
- | xe, CastE(yt,ye) ->
- (equalExps xe ye)
-
- | _,_ -> false
-end
-
-and equalLvals (x: lval) (y: lval) : bool =
-begin
- match x,y with
- | (Var(xv),xo), (Var(yv),yo) ->
- (* I tried, I really did.. the problem is I see these names
- * before merging collapses them, so __T123 != __T456,
- * so whatever *)
- (*(xv.vname = vy.vname) && (* INC: same varinfo names.. *)*)
- (equalOffsets xo yo)
-
- | (Mem(xe),xo), (Mem(ye),yo) ->
- (equalExps xe ye) &&
- (equalOffsets xo yo)
- | _,_ -> false
-end
-
-let equalInitOpts (x: init option) (y: init option) : bool =
-begin
- match x,y with
- | None,None -> true
- | Some(xi), Some(yi) -> (equalInits xi yi)
- | _,_ -> false
-end
-
-
- (* Now we go once more through the file and we rename the globals that we
- * keep. We also scan the entire body and we replace references to the
- * representative types or variables. We set the referenced flags once we
- * have replaced the names. *)
-let oneFilePass2 (f: file) =
- if debugMerge || !E.verboseFlag then
- ignore (E.log "Final merging phase (%d): %s\n"
- !currentFidx f.fileName);
- currentDeclIdx := 0; (* Even though we don't need it anymore *)
- H.clear varUsedAlready;
- H.clear originalVarNames;
- (* If we find inline functions that are used before being defined, and thus
- * before knowing that we can throw them away, then we mark this flag so
- * that we can make another pass over the file *)
- let repeatPass2 = ref false in
- (* Keep a pointer to the contents of the file so far *)
- let savedTheFile = !theFile in
-
- let processOneGlobal (g: global) : unit =
- (* Process a varinfo. Reuse an old one, or rename it if necessary *)
- let processVarinfo (vi: varinfo) (vloc: location) : varinfo =
- if vi.vreferenced then
- vi (* Already done *)
- else begin
- (* Maybe it is static. Rename it then *)
- if vi.vstorage = Static then begin
- let newName, _ = A.newAlphaName vtAlpha None vi.vname !currentLoc in
- (* Remember the original name *)
- H.add originalVarNames newName vi.vname;
- if debugMerge then ignore (E.log "renaming %s at %a to %s\n"
- vi.vname d_loc vloc newName);
- vi.vname <- newName;
- vi.vid <- newVID ();
- vi.vreferenced <- true;
- vi
- end else begin
- (* Find the representative *)
- match findReplacement true vEq !currentFidx vi.vname with
- None -> vi (* This is the representative *)
- | Some (vi', _) -> (* Reuse some previous one *)
- vi'.vreferenced <- true; (* Mark it as done already *)
- vi'.vaddrof <- vi.vaddrof || vi'.vaddrof;
- vi'
- end
- end
- in
- try
- match g with
- | GVarDecl (vi, l) as g ->
- currentLoc := l;
- incr currentDeclIdx;
- let vi' = processVarinfo vi l in
- if vi != vi' then (* Drop this declaration *) ()
- else if H.mem emittedVarDecls vi'.vname then (* No need to keep it *)
- ()
- else begin
- H.add emittedVarDecls vi'.vname true; (* Remember that we emitted
- * it *)
- mergePushGlobals (visitCilGlobal renameVisitor g)
- end
-
- | GVar (vi, init, l) ->
- currentLoc := l;
- incr currentDeclIdx;
- let vi' = processVarinfo vi l in
- (* We must keep this definition even if we reuse this varinfo,
- * because maybe the previous one was a declaration *)
- H.add emittedVarDecls vi.vname true; (* Remember that we emitted it*)
-
- let emitIt:bool = (not mergeGlobals) ||
- try
- let prevVar, prevInitOpt, prevLoc =
- (H.find emittedVarDefn vi'.vname) in
- (* previously defined; same initializer? *)
- if (equalInitOpts prevInitOpt init.init)
- || (init.init = None) then (
- (trace "mergeGlob"
- (P.dprintf "dropping global var %s at %a in favor of the one at %a\n"
- vi'.vname d_loc l d_loc prevLoc));
- false (* do not emit *)
- )
- else if prevInitOpt = None then (
- (* We have an initializer, but the previous one didn't.
- We should really convert the previous global from GVar
- to GVarDecl, but that's not convenient to do here. *)
- true
- )
- else (
- (* Both GVars have initializers. *)
- (E.s (error "global var %s at %a has different initializer than %a\n"
- vi'.vname d_loc l d_loc prevLoc));
- )
- with Not_found -> (
- (* no previous definition *)
- (H.add emittedVarDefn vi'.vname (vi', init.init, l));
- true (* emit it *)
- )
- in
-
- if emitIt then
- mergePushGlobals (visitCilGlobal renameVisitor (GVar(vi', init, l)))
-
- | GFun (fdec, l) as g ->
- currentLoc := l;
- incr currentDeclIdx;
- (* We apply the renaming *)
- fdec.svar <- processVarinfo fdec.svar l;
- (* Get the original name. *)
- let origname =
- try H.find originalVarNames fdec.svar.vname
- with Not_found -> fdec.svar.vname
- in
- (* Go in there and rename everything as needed *)
- let fdec' =
- match visitCilGlobal renameVisitor g with
- [GFun(fdec', _)] -> fdec'
- | _ -> E.s (unimp "renameVisitor for GFun returned something else")
- in
- let g' = GFun(fdec', l) in
- (* Now restore the parameter names *)
- let _, args, _, _ = splitFunctionTypeVI fdec'.svar in
- let oldnames, foundthem =
- try H.find formalNames (!currentFidx, origname), true
- with Not_found -> begin
- ignore (warnOpt "Cannot find %s in formalNames" origname);
- [], false
- end
- in
- if foundthem then begin
- let argl = argsToList args in
- if List.length oldnames <> List.length argl then
- E.s (unimp "After merging the function has more arguments");
- List.iter2
- (fun oldn a -> if oldn <> "" then a.vname <- oldn)
- oldnames fdec.sformals;
- (* Reflect them in the type *)
- setFormals fdec fdec.sformals
- end;
- (** See if we can remove this inline function *)
- if fdec'.svar.vinline && mergeInlines then begin
- let printout =
- (* Temporarily turn of printing of lines *)
- let oldprintln = !lineDirectiveStyle in
- lineDirectiveStyle := None;
- (* Temporarily set the name to all functions in the same way *)
- let newname = fdec'.svar.vname in
- fdec'.svar.vname <- "@@alphaname@@";
- (* If we must do alpha conversion then temporarily set the
- * names of the local variables and formals in a standard way *)
- let nameId = ref 0 in
- let oldNames : string list ref = ref [] in
- let renameOne (v: varinfo) =
- oldNames := v.vname :: !oldNames;
- incr nameId;
- v.vname <- "___alpha" ^ string_of_int !nameId
- in
- let undoRenameOne (v: varinfo) =
- match !oldNames with
- n :: rest ->
- oldNames := rest;
- v.vname <- n
- | _ -> E.s (bug "undoRenameOne")
- in
- (* Remember the original type *)
- let origType = fdec'.svar.vtype in
- if mergeInlinesWithAlphaConvert then begin
- (* Rename the formals *)
- List.iter renameOne fdec'.sformals;
- (* Reflect in the type *)
- setFormals fdec' fdec'.sformals;
- (* Now do the locals *)
- List.iter renameOne fdec'.slocals
- end;
- (* Now print it *)
- let res = d_global () g' in
- lineDirectiveStyle := oldprintln;
- fdec'.svar.vname <- newname;
- if mergeInlinesWithAlphaConvert then begin
- (* Do the locals in reverse order *)
- List.iter undoRenameOne (List.rev fdec'.slocals);
- (* Do the formals in reverse order *)
- List.iter undoRenameOne (List.rev fdec'.sformals);
- (* Restore the type *)
- fdec'.svar.vtype <- origType;
- end;
- res
- in
- (* Make a node for this inline function using the original name. *)
- let inode =
- getNode vEq vSyn !currentFidx origname fdec'.svar
- (Some (l, !currentDeclIdx))
- in
- if debugInlines then begin
- ignore (E.log "getNode %s(%d) with loc=%a. declidx=%d\n"
- inode.nname inode.nfidx
- d_nloc inode.nloc
- !currentDeclIdx);
- ignore (E.log
- "Looking for previous definition of inline %s(%d)\n"
- origname !currentFidx);
- end;
- try
- let oldinode = H.find inlineBodies printout in
- if debugInlines then
- ignore (E.log " Matches %s(%d)\n"
- oldinode.nname oldinode.nfidx);
- (* There is some other inline function with the same printout.
- * We should reuse this, but watch for the case when the inline
- * was already used. *)
- if H.mem varUsedAlready fdec'.svar.vname then begin
- if mergeInlinesRepeat then begin
- repeatPass2 := true
- end else begin
- ignore (warn "Inline function %s because it is used before it is defined" fdec'.svar.vname);
- raise Not_found
- end
- end;
- let _ = union oldinode inode in
- (* Clean up the vreferenced bit in the new inline, so that we
- * can rename it. Reset the name to the original one so that
- * we can find the replacement name. *)
- fdec'.svar.vreferenced <- false;
- fdec'.svar.vname <- origname;
- () (* Drop this definition *)
- with Not_found -> begin
- if debugInlines then ignore (E.log " Not found\n");
- H.add inlineBodies printout inode;
- mergePushGlobal g'
- end
- end else begin
- (* either the function is not inline, or we're not attempting to
- * merge inlines *)
- if (mergeGlobals &&
- not fdec'.svar.vinline &&
- fdec'.svar.vstorage <> Static) then
- begin
- (* sm: this is a non-inline, non-static function. I want to
- * consider dropping it if a same-named function has already
- * been put into the merged file *)
- let curSum = (functionChecksum fdec') in
- (*(trace "mergeGlob" (P.dprintf "I see extern function %s, sum is %d\n"*)
- (* fdec'.svar.vname curSum));*)
- try
- let prevFun, prevLoc, prevSum =
- (H.find emittedFunDefn fdec'.svar.vname) in
- (* previous was found *)
- if (curSum = prevSum) then
- (trace "mergeGlob"
- (P.dprintf "dropping duplicate def'n of func %s at %a in favor of that at %a\n"
- fdec'.svar.vname d_loc l d_loc prevLoc))
- else begin
- (* the checksums differ, so print a warning but keep the
- * older one to avoid a link error later. I think this is
- * a reasonable approximation of what ld does. *)
- (ignore (warn "def'n of func %s at %a (sum %d) conflicts with the one at %a (sum %d); keeping the one at %a.\n"
- fdec'.svar.vname d_loc l curSum d_loc prevLoc
- prevSum d_loc prevLoc))
- end
- with Not_found -> begin
- (* there was no previous definition *)
- (mergePushGlobal g');
- (H.add emittedFunDefn fdec'.svar.vname (fdec', l, curSum))
- end
- end else begin
- (* not attempting to merge global functions, or it was static
- * or inline *)
- mergePushGlobal g'
- end
- end
-
- | GCompTag (ci, l) as g -> begin
- currentLoc := l;
- incr currentDeclIdx;
- if ci.creferenced then
- ()
- else begin
- match findReplacement true sEq !currentFidx ci.cname with
- None ->
- (* A new one, we must rename it and keep the definition *)
- (* Make sure this is root *)
- (try
- let nd = H.find sEq (!currentFidx, ci.cname) in
- if nd.nrep != nd then
- E.s (bug "Setting creferenced for struct %s(%d) which is not root!\n"
- ci.cname !currentFidx);
- with Not_found -> begin
- E.s (bug "Setting creferenced for struct %s(%d) which is not in the sEq!\n"
- ci.cname !currentFidx);
- end);
- let newname, _ =
- A.newAlphaName sAlpha None ci.cname !currentLoc in
- ci.cname <- newname;
- ci.creferenced <- true;
- ci.ckey <- H.hash (compFullName ci);
- (* Now we should visit the fields as well *)
- H.add emittedCompDecls ci.cname true; (* Remember that we
- * emitted it *)
- mergePushGlobals (visitCilGlobal renameVisitor g)
- | Some (oldci, oldfidx) -> begin
- (* We are not the representative. Drop this declaration
- * because we'll not be using it. *)
- ()
- end
- end
- end
- | GEnumTag (ei, l) as g -> begin
- currentLoc := l;
- incr currentDeclIdx;
- if ei.ereferenced then
- ()
- else begin
- match findReplacement true eEq !currentFidx ei.ename with
- None -> (* We must rename it *)
- let newname, _ =
- A.newAlphaName eAlpha None ei.ename !currentLoc in
- ei.ename <- newname;
- ei.ereferenced <- true;
- (* And we must rename the items to using the same name space
- * as the variables *)
- ei.eitems <-
- List.map
- (fun (n, i, loc) ->
- let newname, _ =
- A.newAlphaName vtAlpha None n !currentLoc in
- newname, i, loc)
- ei.eitems;
- mergePushGlobals (visitCilGlobal renameVisitor g);
- | Some (ei', _) -> (* Drop this since we are reusing it from
- * before *)
- ()
- end
- end
- | GCompTagDecl (ci, l) -> begin
- currentLoc := l; (* This is here just to introduce an undefined
- * structure. But maybe the structure was defined
- * already. *)
- (* Do not increment currentDeclIdx because it is not incremented in
- * pass 1*)
- if H.mem emittedCompDecls ci.cname then
- () (* It was already declared *)
- else begin
- H.add emittedCompDecls ci.cname true;
- (* Keep it as a declaration *)
- mergePushGlobal g;
- end
- end
-
- | GEnumTagDecl (ei, l) ->
- currentLoc := l;
- (* Do not increment currentDeclIdx because it is not incremented in
- * pass 1*)
- (* Keep it as a declaration *)
- mergePushGlobal g
-
-
- | GType (ti, l) as g -> begin
- currentLoc := l;
- incr currentDeclIdx;
- if ti.treferenced then
- ()
- else begin
- match findReplacement true tEq !currentFidx ti.tname with
- None -> (* We must rename it and keep it *)
- let newname, _ =
- A.newAlphaName vtAlpha None ti.tname !currentLoc in
- ti.tname <- newname;
- ti.treferenced <- true;
- mergePushGlobals (visitCilGlobal renameVisitor g);
- | Some (ti', _) ->(* Drop this since we are reusing it from
- * before *)
- ()
- end
- end
- | g -> mergePushGlobals (visitCilGlobal renameVisitor g)
- with e -> begin
- let globStr:string = (P.sprint 1000 (P.dprintf
- "error when merging global %a: %s"
- d_global g (Printexc.to_string e))) in
- ignore (E.log "%s\n" globStr);
- (*"error when merging global: %s\n" (Printexc.to_string e);*)
- mergePushGlobal (GText (P.sprint 80
- (P.dprintf "/* error at %t:" d_thisloc)));
- mergePushGlobal g;
- mergePushGlobal (GText ("*************** end of error*/"));
- raise e
- end
- in
- (* Now do the real PASS 2 *)
- List.iter processOneGlobal f.globals;
- (* See if we must re-visit the globals in this file because an inline that
- * is being removed was used before we saw the definition and we decided to
- * remove it *)
- if mergeInlinesRepeat && !repeatPass2 then begin
- if debugMerge || !E.verboseFlag then
- ignore (E.log "Repeat final merging phase (%d): %s\n"
- !currentFidx f.fileName);
- (* We are going to rescan the globals we have added while processing this
- * file. *)
- let theseGlobals : global list ref = ref [] in
- (* Scan a list of globals until we hit a given tail *)
- let rec scanUntil (tail: 'a list) (l: 'a list) =
- if tail == l then ()
- else
- match l with
- | [] -> E.s (bug "mergecil: scanUntil could not find the marker\n")
- | g :: rest ->
- theseGlobals := g :: !theseGlobals;
- scanUntil tail rest
- in
- (* Collect in theseGlobals all the globals from this file *)
- theseGlobals := [];
- scanUntil savedTheFile !theFile;
- (* Now reprocess them *)
- theFile := savedTheFile;
- List.iter (fun g ->
- theFile := (visitCilGlobal renameInlinesVisitor g) @ !theFile)
- !theseGlobals;
- (* Now check if we have inlines that we could not remove
- H.iter (fun name _ ->
- if not (H.mem inlinesRemoved name) then
- ignore (warn "Could not remove inline %s. I have no idea why!\n"
- name))
- inlinesToRemove *)
- end
-
-
-let merge (files: file list) (newname: string) : file =
- init ();
-
- (* Make the first pass over the files *)
- currentFidx := 0;
- List.iter (fun f -> oneFilePass1 f; incr currentFidx) files;
-
- (* Now maybe try to force synonyms to be equal *)
- if mergeSynonyms then begin
- doMergeSynonyms sSyn sEq matchCompInfo;
- doMergeSynonyms eSyn eEq matchEnumInfo;
- doMergeSynonyms tSyn tEq matchTypeInfo;
- if mergeInlines then begin
- (* Copy all the nodes from the iEq to vEq as well. This is needed
- * because vEq will be used for variable renaming *)
- H.iter (fun k n -> H.add vEq k n) iEq;
- doMergeSynonyms iSyn iEq matchInlines;
- end
- end;
-
- (* Now maybe dump the graph *)
- if debugMerge then begin
- dumpGraph "type" tEq;
- dumpGraph "struct and union" sEq;
- dumpGraph "enum" eEq;
- dumpGraph "variable" vEq;
- if mergeInlines then dumpGraph "inline" iEq;
- end;
- (* Make the second pass over the files. This is when we start rewriting the
- * file *)
- currentFidx := 0;
- List.iter (fun f -> oneFilePass2 f; incr currentFidx) files;
-
- (* Now reverse the result and return the resulting file *)
- let rec revonto acc = function
- [] -> acc
- | x :: t -> revonto (x :: acc) t
- in
- let res =
- { fileName = newname;
- globals = revonto (revonto [] !theFile) !theFileTypes;
- globinit = None;
- globinitcalled = false;} in
- init (); (* Make the GC happy *)
- (* We have made many renaming changes and sometimes we have just guessed a
- * name wrong. Make sure now that the local names are unique. *)
- uniqueVarNames res;
- res
-
-
-
-
-
diff --git a/cil/src/mergecil.mli b/cil/src/mergecil.mli
deleted file mode 100644
index a864c69a9b274573259686d534c1e36c777ba04f..0000000000000000000000000000000000000000
--- a/cil/src/mergecil.mli
+++ /dev/null
@@ -1,42 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(** Set this to true to ignore the merge conflicts *)
-val ignore_merge_conflicts: bool ref
-
-(** Merge a number of CIL files *)
-val merge: Cil.file list -> string -> Cil.file
diff --git a/cil/src/rmtmps.ml b/cil/src/rmtmps.ml
deleted file mode 100644
index b7dea931ca06cbf5a5e37e93088ad34f1a4cedf7..0000000000000000000000000000000000000000
--- a/cil/src/rmtmps.ml
+++ /dev/null
@@ -1,778 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * Ben Liblit <liblit@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* rmtmps.ml *)
-(* implementation for rmtmps.mli *)
-
-open Pretty
-open Cil
-module H = Hashtbl
-module E = Errormsg
-module U = Util
-
-(* Set on the command-line: *)
-let keepUnused = ref false
-let rmUnusedInlines = ref false
-
-
-let trace = Trace.trace "rmtmps"
-
-
-
-(***********************************************************************
- *
- * Clearing of "referenced" bits
- *
- *)
-
-
-let clearReferencedBits file =
- let considerGlobal global =
- match global with
- | GType (info, _) ->
- trace (dprintf "clearing mark: %a\n" d_shortglobal global);
- info.treferenced <- false
-
- | GEnumTag (info, _)
- | GEnumTagDecl (info, _) ->
- trace (dprintf "clearing mark: %a\n" d_shortglobal global);
- info.ereferenced <- false
-
- | GCompTag (info, _)
- | GCompTagDecl (info, _) ->
- trace (dprintf "clearing mark: %a\n" d_shortglobal global);
- info.creferenced <- false
-
- | GVar ({vname = name} as info, _, _)
- | GVarDecl ({vname = name} as info, _) ->
- trace (dprintf "clearing mark: %a\n" d_shortglobal global);
- info.vreferenced <- false
-
- | GFun ({svar = info} as func, _) ->
- trace (dprintf "clearing mark: %a\n" d_shortglobal global);
- info.vreferenced <- false;
- let clearMark local =
- trace (dprintf "clearing mark: local %s\n" local.vname);
- local.vreferenced <- false
- in
- List.iter clearMark func.slocals
-
- | _ ->
- ()
- in
- iterGlobals file considerGlobal
-
-
-(***********************************************************************
- *
- * Scanning and categorization of pragmas
- *
- *)
-
-
-(* collections of names of things to keep *)
-type collection = (string, unit) H.t
-type keepers = {
- typedefs : collection;
- enums : collection;
- structs : collection;
- unions : collection;
- defines : collection;
- }
-
-
-(* rapid transfer of control when we find a malformed pragma *)
-exception Bad_pragma
-
-let ccureddeepcopystring = "ccureddeepcopy"
-(* Save this length so we don't recompute it each time. *)
-let ccureddeepcopystring_length = String.length ccureddeepcopystring
-
-(* CIL and CCured define several pragmas which prevent removal of
- * various global symbols. Here we scan for those pragmas and build
- * up collections of the corresponding symbols' names.
- *)
-
-let categorizePragmas file =
-
- (* names of things which should be retained *)
- let keepers = {
- typedefs = H.create 0;
- enums = H.create 0;
- structs = H.create 0;
- unions = H.create 0;
- defines = H.create 1
- } in
-
- (* populate these name collections in light of each pragma *)
- let considerPragma =
-
- let badPragma location pragma =
- ignore (warnLoc location "Invalid argument to pragma %s" pragma)
- in
-
- function
- | GPragma (Attr ("cilnoremove" as directive, args), location) ->
- (* a very flexible pragma: can retain typedefs, enums,
- * structs, unions, or globals (functions or variables) *)
- begin
- let processArg arg =
- try
- match arg with
- | AStr specifier ->
- (* isolate and categorize one symbol name *)
- let collection, name =
- (* Two words denotes a typedef, enum, struct, or
- * union, as in "type foo" or "enum bar". A
- * single word denotes a global function or
- * variable. *)
- let whitespace = Str.regexp "[ \t]+" in
- let words = Str.split whitespace specifier in
- match words with
- | ["type"; name] ->
- keepers.typedefs, name
- | ["enum"; name] ->
- keepers.enums, name
- | ["struct"; name] ->
- keepers.structs, name
- | ["union"; name] ->
- keepers.unions, name
- | [name] ->
- keepers.defines, name
- | _ ->
- raise Bad_pragma
- in
- H.add collection name ()
- | _ ->
- raise Bad_pragma
- with Bad_pragma ->
- badPragma location directive
- in
- List.iter processArg args
- end
- | GVarDecl (v, _) -> begin
- (* Look for alias attributes, e.g. Linux modules *)
- match filterAttributes "alias" v.vattr with
- [] -> () (* ordinary prototype. *)
- | [Attr("alias", [AStr othername])] ->
- H.add keepers.defines othername ()
- | _ -> E.s (error "Bad alias attribute at %a" d_loc !currentLoc)
- end
-
- (*** Begin CCured-specific checks: ***)
- (* these pragmas indirectly require that we keep the function named in
- -- the first arguments of boxmodelof and ccuredwrapperof, and
- -- the third argument of ccureddeepcopy*. *)
- | GPragma (Attr("ccuredwrapper" as directive, attribute :: _), location) ->
- begin
- match attribute with
- | AStr name ->
- H.add keepers.defines name ()
- | _ ->
- badPragma location directive
- end
- | GPragma (Attr("ccuredvararg", funcname :: (ASizeOf t) :: _), location) ->
- begin
- match t with
- | TComp(c,_) when c.cstruct -> (* struct *)
- H.add keepers.structs c.cname ()
- | TComp(c,_) -> (* union *)
- H.add keepers.unions c.cname ()
- | TNamed(ti,_) ->
- H.add keepers.typedefs ti.tname ()
- | TEnum(ei, _) ->
- H.add keepers.enums ei.ename ()
- | _ ->
- ()
- end
- | GPragma (Attr(directive, _ :: _ :: attribute :: _), location)
- when String.length directive > ccureddeepcopystring_length
- && (Str.first_chars directive ccureddeepcopystring_length)
- = ccureddeepcopystring ->
- begin
- match attribute with
- | AStr name ->
- H.add keepers.defines name ()
- | _ ->
- badPragma location directive
- end
- (** end CCured-specific stuff **)
- | _ ->
- ()
- in
- iterGlobals file considerPragma;
- keepers
-
-
-
-(***********************************************************************
- *
- * Function body elimination from pragmas
- *
- *)
-
-
-(* When performing global slicing, any functions not explicitly marked
- * as pragma roots are reduced to mere declarations. This leaves one
- * with a reduced source file that still compiles to object code, but
- * which contains the bodies of only explicitly retained functions.
- *)
-
-let amputateFunctionBodies keptGlobals file =
- let considerGlobal = function
- | GFun ({svar = {vname = name} as info}, location)
- when not (H.mem keptGlobals name) ->
- trace (dprintf "slicing: reducing to prototype: function %s\n" name);
- GVarDecl (info, location)
- | other ->
- other
- in
- mapGlobals file considerGlobal
-
-
-
-(***********************************************************************
- *
- * Root collection from pragmas
- *
- *)
-
-
-let isPragmaRoot keepers = function
- | GType ({tname = name}, _) ->
- H.mem keepers.typedefs name
- | GEnumTag ({ename = name}, _)
- | GEnumTagDecl ({ename = name}, _) ->
- H.mem keepers.enums name
- | GCompTag ({cname = name; cstruct = structure}, _)
- | GCompTagDecl ({cname = name; cstruct = structure}, _) ->
- let collection = if structure then keepers.structs else keepers.unions in
- H.mem collection name
- | GVar ({vname = name}, _, _)
- | GVarDecl ({vname = name}, _)
- | GFun ({svar = {vname = name}}, _) ->
- H.mem keepers.defines name
- | _ ->
- false
-
-
-
-(***********************************************************************
- *
- * Common root collecting utilities
- *
- *)
-
-
-let traceRoot reason global =
- trace (dprintf "root (%s): %a@!" reason d_shortglobal global);
- true
-
-
-let traceNonRoot reason global =
- trace (dprintf "non-root (%s): %a@!" reason d_shortglobal global);
- false
-
-
-let hasExportingAttribute funvar =
- let rec isExportingAttribute = function
- | Attr ("constructor", []) -> true
- | Attr ("destructor", []) -> true
- | _ -> false
- in
- List.exists isExportingAttribute funvar.vattr
-
-
-
-(***********************************************************************
- *
- * Root collection from external linkage
- *
- *)
-
-
-(* Exported roots are those global symbols which are visible to the
- * linker and dynamic loader. For variables, this consists of
- * anything that is not "static". For functions, this consists of:
- *
- * - functions bearing a "constructor" or "destructor" attribute
- * - functions declared extern but not inline
- * - functions declared neither inline nor static
- *
- * gcc incorrectly (according to C99) makes inline functions visible to
- * the linker. So we can only remove inline functions on MSVC.
- *)
-
-let isExportedRoot global =
- let result, reason = match global with
- | GVar ({vstorage = Static}, _, _) ->
- false, "static variable"
- | GVar _ ->
- true, "non-static variable"
- | GFun ({svar = v}, _) -> begin
- if hasExportingAttribute v then
- true, "constructor or destructor function"
- else if v.vstorage = Static then
- false, "static function"
- else if v.vinline && v.vstorage != Extern
- && (!msvcMode || !rmUnusedInlines) then
- false, "inline function"
- else
- true, "other function"
- end
- | GVarDecl(v,_) when hasAttribute "alias" v.vattr ->
- true, "has GCC alias attribute"
- | _ ->
- false, "neither function nor variable"
- in
- trace (dprintf "isExportedRoot %a -> %b, %s@!"
- d_shortglobal global result reason);
- result
-
-
-
-(***********************************************************************
- *
- * Root collection for complete programs
- *
- *)
-
-
-(* Exported roots are "main()" and functions bearing a "constructor"
- * or "destructor" attribute. These are the only things which must be
- * retained in a complete program.
- *)
-
-let isCompleteProgramRoot global =
- let result = match global with
- | GFun ({svar = {vname = "main"; vstorage = vstorage}}, _) ->
- vstorage <> Static
- | GFun (fundec, _)
- when hasExportingAttribute fundec.svar ->
- true
- | _ ->
- false
- in
- trace (dprintf "complete program root -> %b for %a@!" result d_shortglobal global);
- result
-
-
-(***********************************************************************
- *
- * Transitive reachability closure from roots
- *
- *)
-
-
-(* This visitor recursively marks all reachable types and variables as used. *)
-class markReachableVisitor
- ((globalMap: (string, Cil.global) H.t),
- (currentFunc: fundec option ref)) = object (self)
- inherit nopCilVisitor
-
- method vglob = function
- | GType (typeinfo, _) ->
- typeinfo.treferenced <- true;
- DoChildren
- | GCompTag (compinfo, _)
- | GCompTagDecl (compinfo, _) ->
- compinfo.creferenced <- true;
- DoChildren
- | GEnumTag (enuminfo, _)
- | GEnumTagDecl (enuminfo, _) ->
- enuminfo.ereferenced <- true;
- DoChildren
- | GVar (varinfo, _, _)
- | GVarDecl (varinfo, _)
- | GFun ({svar = varinfo}, _) ->
- varinfo.vreferenced <- true;
- DoChildren
- | _ ->
- SkipChildren
-
- method vinst = function
- Asm (_, tmpls, _, _, _, _) when !msvcMode ->
- (* If we have inline assembly on MSVC, we cannot tell which locals
- * are referenced. Keep thsem all *)
- (match !currentFunc with
- Some fd ->
- List.iter (fun v ->
- let vre = Str.regexp_string (Str.quote v.vname) in
- if List.exists (fun tmp ->
- try ignore (Str.search_forward vre tmp 0); true
- with Not_found -> false)
- tmpls
- then
- v.vreferenced <- true) fd.slocals
- | _ -> assert false);
- DoChildren
- | _ -> DoChildren
-
- method vvrbl v =
- if not v.vreferenced then
- begin
- let name = v.vname in
- if v.vglob then
- trace (dprintf "marking transitive use: global %s\n" name)
- else
- trace (dprintf "marking transitive use: local %s\n" name);
-
- (* If this is a global, we need to keep everything used in its
- * definition and declarations. *)
- if v.vglob then
- begin
- trace (dprintf "descending: global %s\n" name);
- let descend global =
- ignore (visitCilGlobal (self :> cilVisitor) global)
- in
- let globals = Hashtbl.find_all globalMap name in
- List.iter descend globals
- end
- else
- v.vreferenced <- true;
- end;
- SkipChildren
-
- method vexpr (e: exp) =
- match e with
- Const (CEnum (_, _, ei)) -> ei.ereferenced <- true;
- DoChildren
- | _ -> DoChildren
-
- method vtype typ =
- let old : bool =
- let visitAttrs attrs =
- ignore (visitCilAttributes (self :> cilVisitor) attrs)
- in
- let visitType typ =
- ignore (visitCilType (self :> cilVisitor) typ)
- in
- match typ with
- | TEnum(e, attrs) ->
- let old = e.ereferenced in
- if not old then
- begin
- trace (dprintf "marking transitive use: enum %s\n" e.ename);
- e.ereferenced <- true;
- visitAttrs attrs;
- visitAttrs e.eattr
- end;
- old
-
- | TComp(c, attrs) ->
- let old = c.creferenced in
- if not old then
- begin
- trace (dprintf "marking transitive use: compound %s\n" c.cname);
- c.creferenced <- true;
-
- (* to recurse, we must ask explicitly *)
- let recurse f = visitType f.ftype in
- List.iter recurse c.cfields;
- visitAttrs attrs;
- visitAttrs c.cattr
- end;
- old
-
- | TNamed(ti, attrs) ->
- let old = ti.treferenced in
- if not old then
- begin
- trace (dprintf "marking transitive use: typedef %s\n" ti.tname);
- ti.treferenced <- true;
-
- (* recurse deeper into the type referred-to by the typedef *)
- (* to recurse, we must ask explicitly *)
- visitType ti.ttype;
- visitAttrs attrs
- end;
- old
-
- | _ ->
- (* for anything else, just look inside it *)
- false
- in
- if old then
- SkipChildren
- else
- DoChildren
-end
-
-
-let markReachable file isRoot =
- (* build a mapping from global names back to their definitions &
- * declarations *)
- let globalMap = Hashtbl.create 137 in
- let considerGlobal global =
- match global with
- | GFun ({svar = info}, _)
- | GVar (info, _, _)
- | GVarDecl (info, _) ->
- Hashtbl.add globalMap info.vname global
- | _ ->
- ()
- in
- iterGlobals file considerGlobal;
-
- let currentFunc = ref None in
-
- (* mark everything reachable from the global roots *)
- let visitor = new markReachableVisitor (globalMap, currentFunc) in
- let visitIfRoot global =
- if isRoot global then
- begin
- trace (dprintf "traversing root global: %a\n" d_shortglobal global);
- (match global with
- GFun(fd, _) -> currentFunc := Some fd
- | _ -> currentFunc := None);
- ignore (visitCilGlobal visitor global)
- end
- else
- trace (dprintf "skipping non-root global: %a\n" d_shortglobal global)
- in
- iterGlobals file visitIfRoot
-
-
-(**********************************************************************
- *
- * Marking and removing of unused labels
- *
- **********************************************************************)
-
-(* We keep only one label, preferably one that was not introduced by CIL.
- * Scan a list of labels and return the data for the label that should be
- * kept, and the remaining filtered list of labels *)
-let labelsToKeep (ll: label list) : (string * location * bool) * label list =
- let rec loop (sofar: string * location * bool) = function
- [] -> sofar, []
- | l :: rest ->
- let newlabel, keepl =
- match l with
- | Case _ | Default _ -> sofar, true
- | Label (ln, lloc, isorig) -> begin
- match isorig, sofar with
- | false, ("", _, _) ->
- (* keep this one only if we have no label so far *)
- (ln, lloc, isorig), false
- | false, _ -> sofar, false
- | true, (_, _, false) ->
- (* this is an original label; prefer it to temporary or
- * missing labels *)
- (ln, lloc, isorig), false
- | true, _ -> sofar, false
- end
- in
- let newlabel', rest' = loop newlabel rest in
- newlabel', (if keepl then l :: rest' else rest')
- in
- loop ("", locUnknown, false) ll
-
-class markUsedLabels (labelMap: (string, unit) H.t) = object
- inherit nopCilVisitor
-
- method vstmt (s: stmt) =
- match s.skind with
- Goto (dest, _) ->
- let (ln, _, _), _ = labelsToKeep !dest.labels in
- if ln = "" then
- E.s (E.bug "rmtmps: destination of statement does not have labels");
- (* Mark it as used *)
- H.replace labelMap ln ();
- DoChildren
-
- | _ -> DoChildren
-
- (* No need to go into expressions or instructions *)
- method vexpr _ = SkipChildren
- method vinst _ = SkipChildren
- method vtype _ = SkipChildren
-end
-
-class removeUnusedLabels (labelMap: (string, unit) H.t) = object
- inherit nopCilVisitor
-
- method vstmt (s: stmt) =
- let (ln, lloc, lorig), lrest = labelsToKeep s.labels in
- s.labels <-
- (if ln <> "" && H.mem labelMap ln then (* We had labels *)
- (Label(ln, lloc, lorig) :: lrest)
- else
- lrest);
- DoChildren
-
- (* No need to go into expressions or instructions *)
- method vexpr _ = SkipChildren
- method vinst _ = SkipChildren
- method vtype _ = SkipChildren
-end
-
-(***********************************************************************
- *
- * Removal of unused symbols
- *
- *)
-
-
-(* regular expression matching names of uninteresting locals *)
-let uninteresting =
- let names = [
- (* Cil.makeTempVar *)
- "__cil_tmp";
-
- (* sm: I don't know where it comes from but these show up all over. *)
- (* this doesn't seem to do what I wanted.. *)
- "iter";
-
- (* various macros in glibc's <bits/string2.h> *)
- "__result";
- "__s"; "__s1"; "__s2";
- "__s1_len"; "__s2_len";
- "__retval"; "__len";
-
- (* various macros in glibc's <ctype.h> *)
- "__c"; "__res";
-
- (* We remove the __malloc variables *)
- ] in
-
- (* optional alpha renaming *)
- let alpha = "\\(___[0-9]+\\)?" in
-
- let pattern = "\\(" ^ (String.concat "\\|" names) ^ "\\)" ^ alpha ^ "$" in
- Str.regexp pattern
-
-
-let removeUnmarked file =
- let removedLocals = ref [] in
-
- let filterGlobal global =
- match global with
- (* unused global types, variables, and functions are simply removed *)
- | GType ({treferenced = false}, _)
- | GCompTag ({creferenced = false}, _)
- | GCompTagDecl ({creferenced = false}, _)
- | GEnumTag ({ereferenced = false}, _)
- | GEnumTagDecl ({ereferenced = false}, _)
- | GVar ({vreferenced = false}, _, _)
- | GVarDecl ({vreferenced = false}, _)
- | GFun ({svar = {vreferenced = false}}, _) ->
- trace (dprintf "removing global: %a\n" d_shortglobal global);
- false
-
- (* retained functions may wish to discard some unused locals *)
- | GFun (func, _) ->
- let rec filterLocal local =
- if not local.vreferenced then
- begin
- (* along the way, record the interesting locals that were removed *)
- let name = local.vname in
- trace (dprintf "removing local: %s\n" name);
- if not (Str.string_match uninteresting name 0) then
- removedLocals := (func.svar.vname ^ "::" ^ name) :: !removedLocals;
- end;
- local.vreferenced
- in
- func.slocals <- List.filter filterLocal func.slocals;
- (* We also want to remove unused labels. We do it all here, including
- * marking the used labels *)
- let usedLabels:(string, unit) H.t = H.create 13 in
- ignore (visitCilBlock (new markUsedLabels usedLabels) func.sbody);
- (* And now we scan again and we remove them *)
- ignore (visitCilBlock (new removeUnusedLabels usedLabels) func.sbody);
- true
-
- (* all other globals are retained *)
- | _ ->
- trace (dprintf "keeping global: %a\n" d_shortglobal global);
- true
- in
- file.globals <- List.filter filterGlobal file.globals;
- !removedLocals
-
-
-(***********************************************************************
- *
- * Exported interface
- *
- *)
-
-
-type rootsFilter = global -> bool
-
-let isDefaultRoot = isExportedRoot
-
-let rec removeUnusedTemps ?(isRoot : rootsFilter = isDefaultRoot) file =
- if !keepUnused || Trace.traceActive "disableTmpRemoval" then
- Trace.trace "disableTmpRemoval" (dprintf "temp removal disabled\n")
- else
- begin
- if !E.verboseFlag then
- ignore (E.log "Removing unused temporaries\n" );
-
- if Trace.traceActive "printCilTree" then
- dumpFile defaultCilPrinter stdout "stdout" file;
-
- (* digest any pragmas that would create additional roots *)
- let keepers = categorizePragmas file in
-
- (* if slicing, remove the bodies of non-kept functions *)
- if !Cilutil.sliceGlobal then
- amputateFunctionBodies keepers.defines file;
-
- (* build up the root set *)
- let isRoot global =
- isPragmaRoot keepers global ||
- isRoot global
- in
-
- (* mark everything reachable from the global roots *)
- clearReferencedBits file;
- markReachable file isRoot;
-
- (* take out the trash *)
- let removedLocals = removeUnmarked file in
-
- (* print which original source variables were removed *)
- if false && removedLocals != [] then
- let count = List.length removedLocals in
- if count > 2000 then
- ignore (E.warn "%d unused local variables removed" count)
- else
- ignore (E.warn "%d unused local variables removed:@!%a"
- count (docList ~sep:(chr ',' ++ break) text) removedLocals)
- end
diff --git a/cil/src/rmtmps.mli b/cil/src/rmtmps.mli
deleted file mode 100644
index e29f0c6bdee6626ee6cc22fd10fd8a67be53a38b..0000000000000000000000000000000000000000
--- a/cil/src/rmtmps.mli
+++ /dev/null
@@ -1,82 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * Ben Liblit <liblit@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* rmtmps.mli *)
-(* remove unused things from cil files: *)
-(* - local temporaries introduced but not used *)
-(* - global declarations that are not used *)
-(* - types that are not used *)
-(* - labels that are not used (gn) *)
-
-
-(* Some clients may wish to augment or replace the standard strategy
- * for finding the initially reachable roots. The optional
- * "isRoot" argument to Rmtmps.removeUnusedTemps grants this
- * flexibility. If given, it should name a function which will return
- * true if a given global should be treated as a retained root.
- *
- * Function Rmtmps.isDefaultRoot encapsulates the default root
- * collection, which consists of those global variables and functions
- * which are visible to the linker and runtime loader. A client's
- * root filter can use this if the goal is to augment rather than
- * replace the standard logic. Function Rmtmps.isExportedRoot is an
- * alternate name for this same function.
- *
- * Function Rmtmps.isCompleteProgramRoot is an example of an alternate
- * root collection. This function assumes that it is operating on a
- * complete program rather than just one object file. It treats
- * "main()" as a root, as well as any function carrying the
- * "constructor" or "destructor" attribute. All other globals are
- * candidates for removal, regardless of their linkage.
- *
- * Note that certain CIL- and CCured-specific pragmas induce
- * additional global roots. This functionality is always present, and
- * is not subject to replacement by "filterRoots".
- *)
-
-type rootsFilter = Cil.global -> bool
-val isDefaultRoot : rootsFilter
-val isExportedRoot : rootsFilter
-val isCompleteProgramRoot : rootsFilter
-
-(* process a complete Cil file *)
-val removeUnusedTemps: ?isRoot:rootsFilter -> Cil.file -> unit
-
-
-val keepUnused: bool ref (* Set this to true to turn off this module *)
-val rmUnusedInlines: bool ref (* Delete unused inline funcs in gcc mode? *)
diff --git a/cil/src/testcil.ml b/cil/src/testcil.ml
deleted file mode 100644
index 0c0ef01846259630b8b61097626799b87bc0914d..0000000000000000000000000000000000000000
--- a/cil/src/testcil.ml
+++ /dev/null
@@ -1,440 +0,0 @@
-(*
- *
- * Copyright (c) 2001-2002,
- * George C. Necula <necula@cs.berkeley.edu>
- * Scott McPeak <smcpeak@cs.berkeley.edu>
- * Wes Weimer <weimer@cs.berkeley.edu>
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * 3. The names of the contributors may not be used to endorse or promote
- * products derived from this software without specific prior written
- * permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
- * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- *)
-
-(* A test for CIL *)
-open Pretty
-open Cil
-module E = Errormsg
-
-let lu = locUnknown
-
-(* If you have trouble try to reproduce the problem on a smaller type. Try
- * limiting the maxNesting and integerKinds *)
-let integerKinds = [ IChar; ISChar; IUChar; IInt; IUInt; IShort; IUShort;
- ILong; IULong; ILongLong; IULongLong ]
-let floatKinds = [ FFloat; FDouble ]
-
-let baseTypes =
- (List.map (fun ik -> (1, fun _ -> TInt(ik, []))) integerKinds)
- @ (List.map (fun fk -> (1, fun _ -> TFloat(fk, []))) floatKinds)
-
-
-(* Make a random struct *)
-let maxNesting = ref 3 (* Maximum number of levels for struct nesting *)
-let maxFields = ref 8 (* The maximum number of fields in a struct *)
-let useBitfields = ref false
-let useZeroBitfields = ref true
-
-
-
-(* Collect here the globals *)
-let globals: global list ref = ref []
-let addGlobal (g:global) = globals := g :: !globals
-let getGlobals () = List.rev !globals
-
-(* Collect here the statements for main *)
-let statements: stmt list ref = ref []
-let addStatement (s: stmt) = statements := s :: !statements
-let getStatements () = List.rev !statements
-
-(* Keep here the main function *)
-let main: fundec ref = ref dummyFunDec
-let mainRetVal: varinfo ref = ref dummyFunDec.svar
-
-let assertId = ref 0
-let addAssert (b: exp) (extra: stmt list) : unit =
- incr assertId;
- addStatement (mkStmt (If(UnOp(LNot, b, intType),
- mkBlock (extra @
- [mkStmt (Return (Some (integer !assertId),
- lu))]),
- mkBlock [], lu)))
-
-let addSetRetVal (b: exp) (extra: stmt list) : unit =
- addStatement
- (mkStmt (If(UnOp(LNot, b, intType),
- mkBlock (extra @
- [mkStmtOneInstr (Set(var !mainRetVal, one, lu))]),
- mkBlock [], lu)))
-
-
-let printfFun: fundec =
- let fdec = emptyFunction "printf" in
- fdec.svar.vtype <-
- TFun(intType, Some [ ("format", charPtrType, [])], true, []);
- fdec
-
-
-let memsetFun: fundec =
- let fdec = emptyFunction "memset" in
- fdec.svar.vtype <-
- TFun(voidPtrType, Some [ ("start", voidPtrType, []);
- ("v", intType, []);
- ("len", uintType, [])], false, []);
- fdec
-
-let checkOffsetFun: fundec =
- let fdec = emptyFunction "checkOffset" in
- fdec.svar.vtype <-
- TFun(voidType, Some [ ("start", voidPtrType, []);
- ("len", uintType, []);
- ("expected_start", intType, []);
- ("expected_width", intType, []);
- ("name", charPtrType, []) ], false, []);
- fdec
-
-let checkSizeOfFun: fundec =
- let fdec = emptyFunction "checkSizeOf" in
- fdec.svar.vtype <-
- TFun(voidType, Some [ ("len", uintType, []);
- ("expected", intType, []);
- ("name", charPtrType, []) ], false, []);
- fdec
-
-
-let doPrintf format args =
- mkStmtOneInstr (Call(None, Lval(var printfFun.svar),
- (Const(CStr format)) :: args, lu))
-
-
-(* Select among the choices, each with a given weight *)
-type 'a selection = int * (unit -> 'a)
-let select (choices: 'a selection list) : 'a =
- (* Find the total weight *)
- let total = List.fold_left (fun sum (w, _) -> sum + w) 0 choices in
- if total = 0 then E.s (E.bug "Total for choices = 0\n");
- (* Pick a random number *)
- let thechoice = Random.int total in
- (* Now get the choice *)
- let rec loop thechoice = function
- [] -> E.s (E.bug "Ran out of choices\n")
- | (w, c) :: rest ->
- if thechoice < w then c () else loop (thechoice - w) rest
- in
- loop thechoice choices
-
-
-(* Generate a new name *)
-let nameId = ref 0
-let newName (base: string) =
- incr nameId;
- base ^ (string_of_int !nameId)
-
-
-(********** Testing of SIZEOF ***********)
-
-(* The current selection of types *)
-let typeChoices : typ selection list ref = ref []
-
-let baseTypeChoices : typ selection list ref = ref []
-
-
-let currentNesting = ref 0
-let mkCompType (iss: bool) =
- if !currentNesting >= !maxNesting then (* Replace it with an int *)
- select !baseTypeChoices
- else begin
- incr currentNesting;
- let ci =
- mkCompInfo iss (newName "comp")
- (fun _ ->
- let nrFields = 1 + (Random.int !maxFields) in
- let rec mkFields (i: int) =
- if i = nrFields then [] else begin
- let ft = select !typeChoices in
- let fname = "f" ^ string_of_int i in
- let fname', width =
- if not !useBitfields || not (isIntegralType ft)
- || (Random.int 8 >= 6) then
- fname, None
- else begin
- let tw = bitsSizeOf ft in (* Assume this works for TInt *)
- let w = (if !useZeroBitfields then 0 else 1) +
- Random.int (3 * tw / 4) in
- (if w = 0 then "___missing_field_name" else fname), Some w
- end
- in
- (fname', ft, width, [], lu) :: mkFields (i + 1)
- end
- in
- mkFields 0)
- []
- in
- decr currentNesting;
- (* Register it with the file *)
- addGlobal (GCompTag(ci, lu));
- TComp(ci, [])
- end
-
-(* Make a pointer type. They are all equal so make one to void *)
-let mkPtrType () = TPtr(TVoid([]), [])
-
-(* Make an array type. *)
-let mkArrayType () =
- if !currentNesting >= !maxNesting then
- select !baseTypeChoices
- else begin
- incr currentNesting;
- let at = TArray(select !typeChoices, Some (integer (1 + (Random.int 32))),
- []) in
- decr currentNesting;
- at
- end
-
-
-let testSizeOf () =
- let doOne (i: int) =
-(* ignore (E.log "doOne %d\n" i); *)
- (* Make a random type *)
- let t = select !typeChoices in
- (* Create a global with that type *)
- let g = makeGlobalVar (newName "g") t in
- addGlobal (GVar(g, {init=None}, lu));
- addStatement (mkStmtOneInstr(Call(None, Lval(var memsetFun.svar),
- [ mkAddrOrStartOf (var g); zero;
- SizeOfE(Lval(var g))], lu)));
- try
-(* if i = 0 then ignore (E.log "0: %a\n" d_plaintype t); *)
- let bsz =
- try bitsSizeOf t (* This is what we are testing *)
- with e -> begin
- ignore (E.log "Exception %s caught while computing bitsSizeOf(%a)\n"
- (Printexc.to_string e) d_type t);
- raise (Failure "")
- end
- in
-(* ignore (E.log "1 "); *)
- if bsz mod 8 <> 0 then begin
- ignore (E.log "bitsSizeOf did not return a multiple of 8\n");
- raise (Failure "");
- end;
-(* ignore (E.log "2 "); *)
- (* Check the offset of all fields in there *)
- let rec checkOffsets (lv: lval) (lvt: typ) =
- match lvt with
- TComp(c, _) ->
- List.iter
- (fun f ->
- if f.fname <> "___missing_field_name" then
- checkOffsets (addOffsetLval (Field(f, NoOffset)) lv) f.ftype)
- c.cfields
- | TArray (bt, Some len, _) ->
- let leni =
- match isInteger len with
- Some i64 -> Int64.to_int i64
- | None -> E.s (E.bug "Array length is not a constant")
- in
- let i = Random.int leni in
- checkOffsets (addOffsetLval (Index(integer i, NoOffset)) lv) bt
-
- | _ -> (* Now a base type *)
- let _, off = lv in
- let start, width = bitsOffset t off in
- let setLv (v: exp) =
- match lvt with
- TFloat (FFloat, _) ->
- Set((Mem (mkCast (AddrOf lv) intPtrType), NoOffset),
- v, lu)
- | TFloat (FDouble, _) ->
- Set((Mem (mkCast (AddrOf lv)
- (TPtr(TInt(IULongLong, []), []))), NoOffset),
- mkCast v (TInt(IULongLong, [])), lu)
-
- | (TPtr _ | TInt((IULongLong|ILongLong), _)) ->
- Set(lv, mkCast v lvt, lu)
- | _ -> Set(lv, v, lu)
- in
- let ucharPtrType = TPtr(TInt(IUChar, []), []) in
- let s =
- mkStmt (Instr ([ setLv mone;
- Call(None, Lval(var checkOffsetFun.svar),
- [ mkCast (mkAddrOrStartOf (var g))
- ucharPtrType;
- SizeOfE (Lval(var g));
- integer start;
- integer width;
- (Const(CStr(sprint 80
- (d_lval () lv))))],lu);
- setLv zero])) in
- addStatement s
- in
- checkOffsets (var g) t;
-(* ignore (E.log "3 ");*)
- (* Now check the size of *)
- let s = mkStmtOneInstr (Call(None, Lval(var checkSizeOfFun.svar),
- [ SizeOfE (Lval (var g));
- integer (bitsSizeOf t);
- mkString g.vname ], lu)) in
- addStatement s;
-(* ignore (E.log "10\n"); *)
- with _ -> ()
- in
-
- (* Make the composite choices more likely *)
- typeChoices :=
- [ (1, mkPtrType);
- (5, mkArrayType);
- (5, fun _ -> mkCompType true);
- (5, fun _ -> mkCompType false); ]
- @ baseTypes;
- baseTypeChoices := baseTypes;
- useBitfields := false;
- maxFields := 4;
- for i = 0 to 100 do
- doOne i
- done;
-
- (* Now test the bitfields. *)
- typeChoices := [ (1, fun _ -> mkCompType true) ];
- baseTypeChoices := [(1, fun _ -> TInt(IInt, []))];
- useBitfields := true;
-
- for i = 0 to 100 do
- doOne i
- done;
-
- (* Now make it a bit more complicated *)
- baseTypeChoices :=
- List.map (fun ik -> (1, fun _ -> TInt(ik, [])))
- [IInt; ILong; IUInt; IULong ];
- useBitfields := true;
- for i = 0 to 100 do
- doOne i
- done;
-
- (* An really complicated now *)
- baseTypeChoices := baseTypes;
- useBitfields := true;
- for i = 0 to 100 do
- doOne i
- done;
-
- ()
-
-
-(* Now the main tester. Pass to it the name of a command "cmd" that when
- * invoked will compile "testingcil.c" and run the result *)
-let createFile () =
-
- assertId := 0;
- nameId := 0;
-
- (* Start a new file *)
- globals := [];
- statements := [];
-
- (* Now make a main function *)
- main := emptyFunction "main";
- !main.svar.vtype <- TFun(intType, None, false, []);
- mainRetVal := makeGlobalVar "retval" intType;
-
- addGlobal (GVar(!mainRetVal, {init=None}, lu));
- addGlobal (GText("#include \"testcil.h\"\n"));
- addStatement (mkStmtOneInstr(Set(var !mainRetVal, zero, lu)));
-
- (* Add prototype for printf *)
- addGlobal (GVar(printfFun.svar, {init=None}, lu));
- addGlobal (GVar(memsetFun.svar, {init=None}, lu));
-
- (* now fill in the composites and the code of main. For simplicity we add
- * the statements of main in reverse order *)
-
- testSizeOf ();
-
-
- (* Now add a return 0 at the end *)
- addStatement (mkStmt (Return(Some (Lval(var !mainRetVal)), lu)));
-
-
- (* Add main at the end *)
- addGlobal (GFun(!main, lu));
- !main.sbody.bstmts <- getStatements ();
-
- (* Now build the CIL.file *)
- let file =
- { fileName = "testingcil.c";
- globals = getGlobals ();
- globinit = None;
- globinitcalled = false;
- }
- in
- (* Print the file *)
- let oc = open_out "testingcil.c" in
- dumpFile defaultCilPrinter oc "testingcil.c" file;
- close_out oc
-
-
-
-
-
-(* initialization code for the tester *)
-let randomStateFile = "testcil.random" (* The name of a file where we store
- * the state of the random number
- * generator last time *)
-let doit (command: string) =
- while true do
- (* Initialize the random no generator *)
- begin
- try
- let randomFile = open_in randomStateFile in
- (* The file exists so restore the Random state *)
- Random.set_state (Marshal.from_channel randomFile);
- ignore (E.log "!! Restoring Random state from %s\n" randomStateFile);
- close_in randomFile;
- (* Leave the file there until we succeed *)
- with _ -> begin
- (* The file does not exist *)
- Random.self_init ();
- (* Save the state of the generator *)
- let randomFile = open_out randomStateFile in
- Marshal.to_channel randomFile (Random.get_state()) [] ;
- close_out randomFile;
- end
- end;
- createFile ();
- (* Now compile and run the file *)
- ignore (E.log "Running %s\n" command);
- let err = Sys.command command in
- if err <> 0 then
- E.s (E.bug "Failed to run the command: %s (errcode=%d)" command err)
- else begin
- ignore (E.log "Successfully ran one more round. Press CTRL-C to stop\n");
- (* Delete the file *)
- Sys.remove randomStateFile
- end
- done
-
diff --git a/cil/test/small1/func.c b/cil/test/small1/func.c
deleted file mode 100644
index a0f4e4e56aa3e654b5f1df9d2824e839552a7f35..0000000000000000000000000000000000000000
--- a/cil/test/small1/func.c
+++ /dev/null
@@ -1,24 +0,0 @@
-int (*pfun1)(int (*)(int), int);
-int (*pfun2)(int (*)(int), int);
-
-typedef int (*intfun)(int);
-intfun arrfun[5];
-
-int testf(int k) {
- return k;
-}
-
-int foo(int (*bar)(int), int n) {
-
- pfun1 = foo;
- pfun1 = & foo;
- pfun1 = * * * pfun2;
-
- pfun1 = arrfun[4];
-
- pfun2(* * testf, 5);
-
- return 1;
-}
-
-
diff --git a/cil/test/small1/hello.c b/cil/test/small1/hello.c
deleted file mode 100644
index cbe8ad07a0cfb662a2cbc9d56d5f1f4b9d02e0bc..0000000000000000000000000000000000000000
--- a/cil/test/small1/hello.c
+++ /dev/null
@@ -1,8 +0,0 @@
-#include <stdio.h>
-
-
-
-int main() {
- printf("Hello world\n");
- return 0;
-}
diff --git a/cil/test/small1/init.c b/cil/test/small1/init.c
deleted file mode 100644
index 4578b5be847e52ff906c750ff129b9741b14c97c..0000000000000000000000000000000000000000
--- a/cil/test/small1/init.c
+++ /dev/null
@@ -1,177 +0,0 @@
-#ifndef __NULLTERM
-#define __NULLTERM
-#define __SIZED
-#endif
-#include "testharness.h"
-
-extern int strcmp(const char*, const char*);
-
-/* run this with COMPATMODE=1 if compiling directly, since neither GCC nor
- * MSVCC fully support the C standard */
-static char *usageplocal = "Usage";
-static char usageescape = 'C';
-
-char *usagep = "Usage non-local";
-char *usagep1 = { "Usage in a brace" };
-int g = { 6 } ;
-
-char usages[] = "Usage string";
-char strange[] = { "several" };
-
-char *null = (void*)0;
-
-
-typedef struct s {
- char *name;
- int data;
-} STR;
-
-extern int afunc(int x);
-int (*fptr)(int) = afunc;
-
-STR a[] = {
- {"first", 0},
- {"second", 1},
- {& usages[2], 2},
- { & usageescape, 3},
- { usages, 4},
-};
-
-
-typedef struct {
- struct {
- char * a1[10];
- char * a2;
- char strbuff[20] __NULLTERM;
- } f1;
- struct {
- int * i1;
- } f2[5] __SIZED;
-} NESTED;
-
-NESTED glob1;
-
-int glob3;
-int * glob2 = & glob3;
-
-int afunc(int a) {
- NESTED loc1;
- char locbuff[30] __NULLTERM;
- char indexbuff[10] __SIZED;
-
- loc1.f1.a2 = glob1.f1.a2;
-
- return * loc1.f2[3].i1 + (locbuff[0] - indexbuff[0]);
-}
-
-
-
-// now initialization for union
-union {
- struct {
- int a;
- int *b;
- } u1;
- int c;
-} uarray[] = { 1, 0, 2, 0, 3, 0 };
-
-
-// now some examples from the standard
-int z[4][3] =
-{ { 1 }, { 2 }, { 3 }, { 4 } };
-
-struct str1 { int a[3]; int b;};
-
-struct str1 w[] =
-{ { 1 }, { 2 } };
-
-
-short q[4][3][2] = {
- { 1 } ,
- { 2, 3 },
- { 4, 5, 6}
-};
-
-short q1[4][3][2] = {
- 1, 0, 0, 0, 0, 0,
- 2, 3, 0, 0, 0, 0,
- 4, 5, 6, 0, 0, 0,
-};
-
-
-
-#ifdef _GNUCC
-int a1[10] = {
- 1, 3, 5, 7, 9, [6] = 8, 6, 4, 2};
-
-
-enum { member_one, member_two, member_three };
-char *nm[] = {
- [member_two] = "member_two",
- [member_three] = "member_three",
-};
-
-
-#endif
-
-
-
-#define ERROR(n) { printf("Incorrect init: %d\n", n); exit(1); }
-// Test the initialization
-int main() {
- int i;
-
- struct str1 astr = w[0];
-
- if(strcmp(a[0].name, "first")) {
- ERROR(0);
- }
- if(sizeof(uarray) / sizeof(uarray[0]) != 3) {
- ERROR(1);
- }
- if(uarray[2].u1.a != 3) {
- ERROR(2);
- }
-
- if(z[2][0] != 3 ||
- z[2][1] != 0) {
- ERROR(4);
- }
-
- if(sizeof(w) / sizeof(w[0]) != 2 ||
- w[1].a[0] != 2) {
- ERROR(5);
- }
- {
- short * ps = (short*)q, * ps1 = (short*)q1;
- for(i=0;i<sizeof(q) / sizeof(short); i++, ps ++, ps1 ++) {
- if(*ps != *ps1) {
- ERROR(6);
- }
- }
- }
-
-#ifdef _GNUCC
- if(a1[1] != 3 ||
- a1[5] != 0 ||
- a1[6] != 8 ||
- a1[7] != 6) {
- ERROR(7);
- }
-
-
- if(strcmp(nm[1], "member_two") ||
- strcmp(nm[2], "member_three") ||
- sizeof(nm) != 3 * sizeof(nm[0])) {
- ERROR(8);
- }
-
-#endif
-
-
- printf("Initialization test succeeded\n");
- return 0;
-}
-
-
-
diff --git a/cil/test/small1/init1.c b/cil/test/small1/init1.c
deleted file mode 100644
index e6334df9d67eab2cf58250c40528768cf28d2b39..0000000000000000000000000000000000000000
--- a/cil/test/small1/init1.c
+++ /dev/null
@@ -1,17 +0,0 @@
-extern void exit(int);
-
-struct {
- struct {
- int *f1;
- int *f2;
- } s1;
- struct {
- int *f3;
- } s2;
-} memory[10] = { 1 };
-
-int main() {
- if(memory[0].s1.f1 != (int*)1)
- exit(1);
- exit(0);
-}
diff --git a/cil/test/small1/testharness.h b/cil/test/small1/testharness.h
deleted file mode 100644
index a1057e343e2cc478531705c25bcb592a266dbebc..0000000000000000000000000000000000000000
--- a/cil/test/small1/testharness.h
+++ /dev/null
@@ -1,17 +0,0 @@
-#ifndef printf
- /* sm: this works with gcc-2.95 */
- extern int printf(const char * format, ...);
-# ifdef CCURED
- #pragma ccuredvararg("printf", printf(1))
-# endif
-#else
- /* but in gcc-3 headers it's a macro.. */
- #include <stdio.h> /* printf */
-#endif
-
-extern void exit(int);
-
-/* Always call E with a non-zero number */
-#define E(n) { printf("Error %d\n", n); exit(n); }
-#define SUCCESS { printf("Success\n"); exit(0); }
-
diff --git a/cil/test/small1/vararg1.c b/cil/test/small1/vararg1.c
deleted file mode 100644
index cc710a7b7106d20ac507c067ef9d8c56c4fe00dd..0000000000000000000000000000000000000000
--- a/cil/test/small1/vararg1.c
+++ /dev/null
@@ -1,47 +0,0 @@
-
-/* VA.C: The program below illustrates passing a variable
- * number of arguments using the following macros:
- * va_start va_arg va_end
- * va_list va_dcl (UNIX only)
- */
-
-#include <stdio.h>
-#include <stdarg.h>
-int average( int first, ... );
-union vararg_average {
- int ints; /* We only pass ints to this one */
-};
-
-#include "testharness.h"
-
-int main( void )
-{
- /* Call with 3 integers (-1 is used as terminator). */
- if(average( 2, 3, 4, -1 ) != 3) E(1);
- if(average( 5, 7, 9, 11, 13, -1 ) != 9) E(2);
- if(average( -1 ) != 0) E(3);
-
- SUCCESS;
-}
-
-
-
-/* Returns the average of a variable list of integers. */
-int average( int first, ... )
-{
- int count = 0, sum = 0, i = first;
- va_list marker;
-
- va_start( marker, first ); /* Initialize variable arguments. */
- while( i != -1 )
- {
- sum += i;
- count++;
- i = va_arg( marker, int);
- }
- va_end( marker ); /* Reset variable arguments. */
- return( sum ? (sum / count) : 0 );
-}
-
-// Put this intentionally at the end
-#pragma ccuredvararg("average", sizeof(union vararg_average))
diff --git a/cil/test/small1/wchar1.c b/cil/test/small1/wchar1.c
deleted file mode 100644
index 3306e571b698fca3801e457b3f1a52fa419445b1..0000000000000000000000000000000000000000
--- a/cil/test/small1/wchar1.c
+++ /dev/null
@@ -1,24 +0,0 @@
-#include "testharness.h"
-#include <stddef.h>
-
-int main() {
- wchar_t *wbase = L"Hello" L", world";
- char * w = (char *)wbase;
- char * s = "Hello" ", world";
- int i;
-
- // See if this is little or big endian
- short foo = 0x0011;
- char little_endian = (int) * (char*)&foo;
-
- for (i=0; i < 10; i++) {
- if (w[i * sizeof(wchar_t)] != (little_endian ? s[i] : 0)) {
- E(1);
- }
- if (w[i * sizeof(wchar_t) + (sizeof(wchar_t)-1)]
- != (little_endian ? 0 : s[i])) {
- E(2);
- }
- }
- SUCCESS;
-}
diff --git a/configure b/configure
index 2b53b44092ea49b1acfca77c653fe3b3e948316a..d8c63fe8ed9160f221969eb53415baa50ec53dbd 100755
--- a/configure
+++ b/configure
@@ -163,14 +163,6 @@ LIBMATH=-lm
EOF
fi
-# Extract and configure Cil
-
-(cd cil && ./configure)
-
-# Extract 'ARCHOS' info from Cil configuration
-
-grep '^ARCHOS=' cil/config.log >> Makefile.config
-
# Summarize configuration
if test "$target" = "manual"; then