package cil

  1. Overview
  2. Docs
Legend:
Library
Module
Module type
Parameter
Class
Class type
val initCIL : unit -> unit
val cilVersion : string
val cilVersionMajor : int
val cilVersionMinor : int
val cilVersionRevision : int
type file = {
  1. mutable fileName : string;
  2. mutable globals : global list;
  3. mutable globinit : fundec option;
  4. mutable globinitcalled : bool;
}
and comment = location * string
and global =
  1. | GType of typeinfo * location
  2. | GCompTag of compinfo * location
  3. | GCompTagDecl of compinfo * location
  4. | GEnumTag of enuminfo * location
  5. | GEnumTagDecl of enuminfo * location
  6. | GVarDecl of varinfo * location
  7. | GVar of varinfo * initinfo * location
  8. | GFun of fundec * location
  9. | GAsm of string * location
  10. | GPragma of attribute * location
  11. | GText of string
and typ =
  1. | TVoid of attributes
  2. | TInt of ikind * attributes
  3. | TFloat of fkind * attributes
  4. | TPtr of typ * attributes
  5. | TArray of typ * exp option * attributes
  6. | TFun of typ * (string * typ * attributes) list option * bool * attributes
  7. | TNamed of typeinfo * attributes
  8. | TComp of compinfo * attributes
  9. | TEnum of enuminfo * attributes
  10. | TBuiltin_va_list of attributes
and ikind =
  1. | IChar
  2. | ISChar
  3. | IUChar
  4. | IBool
  5. | IInt
  6. | IUInt
  7. | IShort
  8. | IUShort
  9. | ILong
  10. | IULong
  11. | ILongLong
  12. | IULongLong
and fkind =
  1. | FFloat
  2. | FDouble
  3. | FLongDouble
and attribute =
  1. | Attr of string * attrparam list
and attributes = attribute list
and attrparam =
  1. | AInt of int
  2. | AStr of string
  3. | ACons of string * attrparam list
  4. | ASizeOf of typ
  5. | ASizeOfE of attrparam
  6. | ASizeOfS of typsig
  7. | AAlignOf of typ
  8. | AAlignOfE of attrparam
  9. | AAlignOfS of typsig
  10. | AUnOp of unop * attrparam
  11. | ABinOp of binop * attrparam * attrparam
  12. | ADot of attrparam * string
  13. | AStar of attrparam
  14. | AAddrOf of attrparam
  15. | AIndex of attrparam * attrparam
  16. | AQuestion of attrparam * attrparam * attrparam
and compinfo = {
  1. mutable cstruct : bool;
  2. mutable cname : string;
  3. mutable ckey : int;
  4. mutable cfields : fieldinfo list;
  5. mutable cattr : attributes;
  6. mutable cdefined : bool;
  7. mutable creferenced : bool;
}
and fieldinfo = {
  1. mutable fcomp : compinfo;
  2. mutable fname : string;
  3. mutable ftype : typ;
  4. mutable fbitfield : int option;
  5. mutable fattr : attributes;
  6. mutable floc : location;
}
and enuminfo = {
  1. mutable ename : string;
  2. mutable eitems : (string * exp * location) list;
  3. mutable eattr : attributes;
  4. mutable ereferenced : bool;
  5. mutable ekind : ikind;
}
and typeinfo = {
  1. mutable tname : string;
  2. mutable ttype : typ;
  3. mutable treferenced : bool;
}
and varinfo = {
  1. mutable vname : string;
  2. mutable vtype : typ;
  3. mutable vattr : attributes;
  4. mutable vstorage : storage;
  5. mutable vglob : bool;
  6. mutable vinline : bool;
  7. mutable vdecl : location;
  8. vinit : initinfo;
  9. mutable vid : int;
  10. mutable vaddrof : bool;
  11. mutable vreferenced : bool;
  12. mutable vdescr : Pretty.doc;
  13. mutable vdescrpure : bool;
}
and storage =
  1. | NoStorage
  2. | Static
  3. | Register
  4. | Extern
and exp =
  1. | Const of constant
  2. | Lval of lval
  3. | SizeOf of typ
  4. | SizeOfE of exp
  5. | SizeOfStr of string
  6. | AlignOf of typ
  7. | AlignOfE of exp
  8. | UnOp of unop * exp * typ
  9. | BinOp of binop * exp * exp * typ
  10. | Question of exp * exp * exp * typ
  11. | CastE of typ * exp
  12. | AddrOf of lval
  13. | AddrOfLabel of stmt Pervasives.ref
  14. | StartOf of lval
and constant =
  1. | CInt64 of int64 * ikind * string option
  2. | CStr of string
  3. | CWStr of int64 list
  4. | CChr of char
  5. | CReal of float * fkind * string option
  6. | CEnum of exp * string * enuminfo
and unop =
  1. | Neg
  2. | BNot
  3. | LNot
and binop =
  1. | PlusA
  2. | PlusPI
  3. | IndexPI
  4. | MinusA
  5. | MinusPI
  6. | MinusPP
  7. | Mult
  8. | Div
  9. | Mod
  10. | Shiftlt
  11. | Shiftrt
  12. | Lt
  13. | Gt
  14. | Le
  15. | Ge
  16. | Eq
  17. | Ne
  18. | BAnd
  19. | BXor
  20. | BOr
  21. | LAnd
  22. | LOr
and lval = lhost * offset
and lhost =
  1. | Var of varinfo
  2. | Mem of exp
and offset =
  1. | NoOffset
  2. | Field of fieldinfo * offset
  3. | Index of exp * offset
and init =
  1. | SingleInit of exp
  2. | CompoundInit of typ * (offset * init) list
and initinfo = {
  1. mutable init : init option;
}
and fundec = {
  1. mutable svar : varinfo;
  2. mutable sformals : varinfo list;
  3. mutable slocals : varinfo list;
  4. mutable smaxid : int;
  5. mutable sbody : block;
  6. mutable smaxstmtid : int option;
  7. mutable sallstmts : stmt list;
}
and block = {
  1. mutable battrs : attributes;
  2. mutable bstmts : stmt list;
}
and stmt = {
  1. mutable labels : label list;
  2. mutable skind : stmtkind;
  3. mutable sid : int;
  4. mutable succs : stmt list;
  5. mutable preds : stmt list;
}
and label =
  1. | Label of string * location * bool
  2. | Case of exp * location
  3. | CaseRange of exp * exp * location
  4. | Default of location
and stmtkind =
  1. | Instr of instr list
  2. | Return of exp option * location
  3. | Goto of stmt Pervasives.ref * location
  4. | ComputedGoto of exp * location
  5. | Break of location
  6. | Continue of location
  7. | If of exp * block * block * location
  8. | Switch of exp * block * stmt list * location
  9. | Loop of block * location * stmt option * stmt option
  10. | Block of block
  11. | TryFinally of block * block * location
  12. | TryExcept of block * instr list * exp * block * location
and instr =
  1. | Set of lval * exp * location
  2. | Call of lval option * exp * exp list * location
  3. | Asm of attributes * string list * (string option * string * lval) list * (string option * string * exp) list * string list * location
and location = {
  1. line : int;
  2. file : string;
  3. byte : int;
}
and typsig =
  1. | TSArray of typsig * int64 option * attribute list
  2. | TSPtr of typsig * attribute list
  3. | TSComp of bool * string * attribute list
  4. | TSFun of typsig * typsig list * bool * attribute list
  5. | TSEnum of string * attribute list
  6. | TSBase of typ
val lowerConstants : bool Pervasives.ref
val insertImplicitCasts : bool Pervasives.ref
type featureDescr = {
  1. fd_enabled : bool Pervasives.ref;
  2. fd_name : string;
  3. fd_description : string;
  4. fd_extraopt : (string * Arg.spec * string) list;
  5. fd_doit : file -> unit;
  6. fd_post_check : bool;
}
val compareLoc : location -> location -> int
val emptyFunction : string -> fundec
val setFormals : fundec -> varinfo list -> unit
val setFunctionType : fundec -> typ -> unit
val setFunctionTypeMakeFormals : fundec -> typ -> unit
val setMaxId : fundec -> unit
val dummyFunDec : fundec
val dummyFile : file
val saveBinaryFile : file -> string -> unit
val saveBinaryFileChannel : file -> Pervasives.out_channel -> unit
val loadBinaryFile : string -> file
val getGlobInit : ?main_name:string -> file -> fundec
val iterGlobals : file -> (global -> unit) -> unit
val foldGlobals : file -> ('a -> global -> 'a) -> 'a -> 'a
val mapGlobals : file -> (global -> global) -> unit
val findOrCreateFunc : file -> string -> typ -> varinfo
val new_sid : unit -> int
val prepareCFG : fundec -> unit
val computeCFGInfo : fundec -> bool -> unit
val copyFunction : fundec -> string -> fundec
val pushGlobal : global -> types:global list Pervasives.ref -> variables:global list Pervasives.ref -> unit
val invalidStmt : stmt
val builtinFunctions : (string, typ * typ list * bool) Hashtbl.t
val builtinLoc : location
val makeZeroInit : typ -> init
val foldLeftCompound : implicit:bool -> doinit:(offset -> init -> typ -> 'a -> 'a) -> ct:typ -> initl:(offset * init) list -> acc:'a -> 'a
val voidType : typ
val isVoidType : typ -> bool
val isVoidPtrType : typ -> bool
val intType : typ
val uintType : typ
val longType : typ
val ulongType : typ
val charType : typ
val charPtrType : typ
val wcharKind : ikind Pervasives.ref
val wcharType : typ Pervasives.ref
val charConstPtrType : typ
val voidPtrType : typ
val intPtrType : typ
val uintPtrType : typ
val doubleType : typ
val upointType : typ Pervasives.ref
val ptrdiffType : typ Pervasives.ref
val typeOfSizeOf : typ Pervasives.ref
val kindOfSizeOf : ikind Pervasives.ref
val isSigned : ikind -> bool
val mkCompInfo : bool -> string -> (compinfo -> (string * typ * int option * attributes * location) list) -> attributes -> compinfo
val copyCompInfo : compinfo -> string -> compinfo
val missingFieldName : string
val compFullName : compinfo -> string
val isCompleteType : typ -> bool
val unrollType : typ -> typ
val unrollTypeDeep : typ -> typ
val separateStorageModifiers : attribute list -> attribute list * attribute list
val isIntegralType : typ -> bool
val isArithmeticType : typ -> bool
val isPointerType : typ -> bool
val isScalarType : typ -> bool
val isFunctionType : typ -> bool
val argsToList : (string * typ * attributes) list option -> (string * typ * attributes) list
val isArrayType : typ -> bool
exception LenOfArray
val lenOfArray : exp option -> int
val getCompField : compinfo -> string -> fieldinfo
type existsAction =
  1. | ExistsTrue
  2. | ExistsFalse
  3. | ExistsMaybe
val existsType : (typ -> existsAction) -> typ -> bool
val splitFunctionType : typ -> typ * (string * typ * attributes) list option * bool * attributes
val splitFunctionTypeVI : varinfo -> typ * (string * typ * attributes) list option * bool * attributes
val d_typsig : unit -> typsig -> Pretty.doc
val typeSig : typ -> typsig
val typeSigWithAttrs : ?ignoreSign:bool -> (attributes -> attributes) -> typ -> typsig
val setTypeSigAttrs : attributes -> typsig -> typsig
val typeSigAttrs : typsig -> attributes
val makeVarinfo : bool -> string -> ?init:init -> typ -> varinfo
val makeFormalVar : fundec -> ?where:string -> string -> typ -> varinfo
val makeLocalVar : fundec -> ?insert:bool -> string -> ?init:init -> typ -> varinfo
val makeTempVar : fundec -> ?insert:bool -> ?name:string -> ?descr:Pretty.doc -> ?descrpure:bool -> typ -> varinfo
val makeGlobalVar : string -> typ -> varinfo
val copyVarinfo : varinfo -> string -> varinfo
val newVID : unit -> int
val addOffsetLval : offset -> lval -> lval
val addOffset : offset -> offset -> offset
val removeOffsetLval : lval -> lval * offset
val removeOffset : offset -> offset * offset
val typeOfLval : lval -> typ
val typeOffset : typ -> offset -> typ
val zero : exp
val one : exp
val mone : exp
val kintegerCilint : ikind -> Cilint.cilint -> exp
val kinteger64 : ikind -> int64 -> exp
val kinteger : ikind -> int -> exp
val integer : int -> exp
val getInteger : exp -> Cilint.cilint option
val i64_to_int : int64 -> int
val cilint_to_int : Cilint.cilint -> int
val isConstant : exp -> bool
val isConstantOffset : offset -> bool
val isZero : exp -> bool
val charConstToInt : char -> constant
val constFold : bool -> exp -> exp
val constFoldBinOp : bool -> binop -> exp -> exp -> typ -> exp
val increm : exp -> int -> exp
val var : varinfo -> lval
val mkAddrOf : lval -> exp
val mkAddrOrStartOf : lval -> exp
val mkMem : addr:exp -> off:offset -> lval
val mkString : string -> exp
val mkCastT : e:exp -> oldt:typ -> newt:typ -> exp
val mkCast : e:exp -> newt:typ -> exp
val stripCasts : exp -> exp
val typeOf : exp -> typ
val parseInt : string -> exp
val mkStmt : stmtkind -> stmt
val mkBlock : stmt list -> block
val mkStmtOneInstr : instr -> stmt
val compactStmts : stmt list -> stmt list
val mkEmptyStmt : unit -> stmt
val dummyInstr : instr
val dummyStmt : stmt
val mkWhile : guard:exp -> body:stmt list -> stmt list
val mkForIncr : iter:varinfo -> first:exp -> stopat:exp -> incr:exp -> body:stmt list -> stmt list
val mkFor : start:stmt list -> guard:exp -> next:stmt list -> body:stmt list -> stmt list
type attributeClass =
  1. | AttrName of bool
  2. | AttrFunType of bool
  3. | AttrType
val attributeHash : (string, attributeClass) Hashtbl.t
val partitionAttributes : default:attributeClass -> attributes -> attribute list * attribute list * attribute list
val addAttribute : attribute -> attributes -> attributes
val addAttributes : attribute list -> attributes -> attributes
val dropAttribute : string -> attributes -> attributes
val dropAttributes : string list -> attributes -> attributes
val filterAttributes : string -> attributes -> attributes
val hasAttribute : string -> attributes -> bool
val typeAttrs : typ -> attribute list
val setTypeAttrs : typ -> attributes -> typ
val typeAddAttributes : attribute list -> typ -> typ
val typeRemoveAttributes : string list -> typ -> typ
val expToAttrParam : exp -> attrparam
exception NotAnAttrParam of exp
type !'a visitAction =
  1. | SkipChildren
  2. | DoChildren
  3. | ChangeTo of 'a
  4. | ChangeDoChildrenPost of 'a * 'a -> 'a
class type cilVisitor = object ... end
val visitCilFile : cilVisitor -> file -> unit
val visitCilFileSameGlobals : cilVisitor -> file -> unit
val visitCilGlobal : cilVisitor -> global -> global list
val visitCilFunction : cilVisitor -> fundec -> fundec
val visitCilExpr : cilVisitor -> exp -> exp
val visitCilLval : cilVisitor -> lval -> lval
val visitCilOffset : cilVisitor -> offset -> offset
val visitCilInitOffset : cilVisitor -> offset -> offset
val visitCilInstr : cilVisitor -> instr -> instr list
val visitCilStmt : cilVisitor -> stmt -> stmt
val visitCilBlock : cilVisitor -> block -> block
val visitCilType : cilVisitor -> typ -> typ
val visitCilVarDecl : cilVisitor -> varinfo -> varinfo
val visitCilInit : cilVisitor -> varinfo -> offset -> init -> init
val visitCilAttributes : cilVisitor -> attribute list -> attribute list
val msvcMode : bool Pervasives.ref
val makeStaticGlobal : bool Pervasives.ref
val useLogicalOperators : bool Pervasives.ref
val useComputedGoto : bool Pervasives.ref
val useCaseRange : bool Pervasives.ref
val caseRangeFold : label list -> label list
val oldstyleExternInline : bool Pervasives.ref
val constFoldVisitor : bool -> cilVisitor
type lineDirectiveStyle =
  1. | LineComment
  2. | LineCommentSparse
  3. | LinePreprocessorInput
  4. | LinePreprocessorOutput
val lineDirectiveStyle : lineDirectiveStyle option Pervasives.ref
val print_CIL_Input : bool Pervasives.ref
val printCilAsIs : bool Pervasives.ref
val lineLength : int Pervasives.ref
val forgcc : string -> string
val currentLoc : location Pervasives.ref
val currentGlobal : global Pervasives.ref
val d_loc : unit -> location -> Pretty.doc
val d_thisloc : unit -> Pretty.doc
val d_ikind : unit -> ikind -> Pretty.doc
val d_fkind : unit -> fkind -> Pretty.doc
val d_storage : unit -> storage -> Pretty.doc
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
val getParenthLevel : exp -> int
class type cilPrinter = object ... end
val defaultCilPrinter : cilPrinter
val plainCilPrinter : cilPrinter
class type descriptiveCilPrinter = object ... end
val descriptiveCilPrinter : descriptiveCilPrinter
val printerForMaincil : cilPrinter Pervasives.ref
val printType : cilPrinter -> unit -> typ -> Pretty.doc
val printExp : cilPrinter -> unit -> exp -> Pretty.doc
val printLval : cilPrinter -> unit -> lval -> Pretty.doc
val printGlobal : cilPrinter -> unit -> global -> Pretty.doc
val printAttr : cilPrinter -> unit -> attribute -> Pretty.doc
val printAttrs : cilPrinter -> unit -> attributes -> Pretty.doc
val printInstr : cilPrinter -> unit -> instr -> Pretty.doc
val printStmt : cilPrinter -> unit -> stmt -> Pretty.doc
val printBlock : cilPrinter -> unit -> block -> Pretty.doc
val dumpStmt : cilPrinter -> Pervasives.out_channel -> int -> stmt -> unit
val dumpBlock : cilPrinter -> Pervasives.out_channel -> int -> block -> unit
val printInit : cilPrinter -> unit -> init -> Pretty.doc
val dumpInit : cilPrinter -> Pervasives.out_channel -> int -> init -> unit
val d_type : unit -> typ -> Pretty.doc
val d_exp : unit -> exp -> Pretty.doc
val d_lval : unit -> lval -> Pretty.doc
val d_offset : Pretty.doc -> unit -> offset -> Pretty.doc
val d_init : unit -> init -> Pretty.doc
val d_binop : unit -> binop -> Pretty.doc
val d_unop : unit -> unop -> Pretty.doc
val d_attr : unit -> attribute -> Pretty.doc
val d_attrparam : unit -> attrparam -> Pretty.doc
val d_attrlist : unit -> attributes -> Pretty.doc
val d_instr : unit -> instr -> Pretty.doc
val d_label : unit -> label -> Pretty.doc
val d_stmt : unit -> stmt -> Pretty.doc
val d_block : unit -> block -> Pretty.doc
val d_global : unit -> global -> Pretty.doc
val dn_exp : unit -> exp -> Pretty.doc
val dn_lval : unit -> lval -> Pretty.doc
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
val d_shortglobal : unit -> global -> Pretty.doc
val dumpGlobal : cilPrinter -> Pervasives.out_channel -> global -> unit
val dumpFile : cilPrinter -> Pervasives.out_channel -> string -> file -> unit
val bug : ('a, unit, Pretty.doc) Pervasives.format -> 'a
val unimp : ('a, unit, Pretty.doc) Pervasives.format -> 'a
val error : ('a, unit, Pretty.doc) Pervasives.format -> 'a
val errorLoc : location -> ('a, unit, Pretty.doc) Pervasives.format -> 'a
val warn : ('a, unit, Pretty.doc) Pervasives.format -> 'a
val warnOpt : ('a, unit, Pretty.doc) Pervasives.format -> 'a
val warnContext : ('a, unit, Pretty.doc) Pervasives.format -> 'a
val warnContextOpt : ('a, unit, Pretty.doc) Pervasives.format -> 'a
val warnLoc : location -> ('a, unit, Pretty.doc) Pervasives.format -> 'a
val d_plainexp : unit -> exp -> Pretty.doc
val d_plaininit : unit -> init -> Pretty.doc
val d_plainlval : unit -> lval -> Pretty.doc
val d_plaintype : unit -> typ -> Pretty.doc
val dd_exp : unit -> exp -> Pretty.doc
val dd_lval : unit -> lval -> Pretty.doc
val uniqueVarNames : file -> unit
val peepHole2 : ((instr * instr) -> instr list option) -> stmt list -> unit
val peepHole1 : (instr -> instr list option) -> stmt list -> unit
exception SizeOfError of string * typ
val unsignedVersionOf : ikind -> ikind
val signedVersionOf : ikind -> ikind
val intRank : ikind -> int
val commonIntKind : ikind -> ikind -> ikind
val intKindForSize : int -> bool -> ikind
val floatKindForSize : int -> fkind
val bytesSizeOfInt : ikind -> int
val bitsSizeOf : typ -> int
val truncateCilint : ikind -> Cilint.cilint -> Cilint.cilint * Cilint.truncation
val fitsInInt : ikind -> Cilint.cilint -> bool
val intKindForValue : Cilint.cilint -> bool -> ikind
val mkCilint : ikind -> int64 -> Cilint.cilint
val sizeOf : typ -> exp
val alignOf_int : typ -> int
val bitsOffset : typ -> offset -> int * int
val char_is_unsigned : bool Pervasives.ref
val little_endian : bool Pervasives.ref
val underscore_name : bool Pervasives.ref
val locUnknown : location
val get_instrLoc : instr -> location
val get_globalLoc : global -> location
val get_stmtLoc : stmtkind -> location
val dExp : Pretty.doc -> exp
val dInstr : Pretty.doc -> location -> instr
val dGlobal : Pretty.doc -> location -> global
val mapNoCopy : ('a -> 'a) -> 'a list -> 'a list
val mapNoCopyList : ('a -> 'a list) -> 'a list -> 'a list
val startsWith : string -> string -> bool
val endsWith : string -> string -> bool
val stripUnderscores : string -> string
type formatArg =
  1. | Fe of exp
  2. | Feo of exp option
  3. | Fu of unop
  4. | Fb of binop
  5. | Fk of ikind
  6. | FE of exp list
  7. | Ff of string * typ * attributes
  8. | FF of (string * typ * attributes) list
  9. | Fva of bool
  10. | Fv of varinfo
  11. | Fl of lval
  12. | Flo of lval option
  13. | Fo of offset
  14. | Fc of compinfo
  15. | Fi of instr
  16. | FI of instr list
  17. | Ft of typ
  18. | Fd of int
  19. | Fg of string
  20. | Fs of stmt
  21. | FS of stmt list
  22. | FA of attributes
  23. | Fp of attrparam
  24. | FP of attrparam list
  25. | FX of string
val d_formatarg : unit -> formatArg -> Pretty.doc
val warnTruncate : bool Pervasives.ref
val envMachine : Machdep.mach option Pervasives.ref
val convertInts : int64 -> ikind -> int64 -> ikind -> int64 * int64 * ikind
val isInteger : exp -> int64 option
val truncateInteger64 : ikind -> int64 -> int64 * bool
val gccBuiltins : (string, typ * typ list * bool) Hashtbl.t
val msvcBuiltins : (string, typ * typ list * bool) Hashtbl.t