package mopsa
Install
dune-project
Dependency
Authors
Maintainers
Sources
md5=37966e98ffeebcedc09bd6e9b2b81f69
sha512=40d4d826c25f680766c07eccbabdf5e8a4fa023016e8a164e4e4f6b3781c8484dc4df437055721dfd19b9db8fb7fe3b61236c4833186d346fc7204a68d01eaaa
doc/mopsa.mopsa_analyzer/Mopsa_analyzer/Languages/C/Lang/Ast/index.html
Module Lang.Ast
AST of the C language.
Types
type c_typedef = {
c_typedef_org_name : string;
(*name as in source
*)c_typedef_unique_name : string;
(*unique name
*)mutable c_typedef_def : MopsaLib.typ;
(*declaration
*)c_typedef_range : Mopsa_utils.Core.Location.range;
(*declaration location
*)
}
Type definition.
and c_record_type = {
c_record_kind : c_record_kind;
c_record_org_name : string;
(*name as in source, may be empty
*)c_record_unique_name : string;
(*unique, non-empty name
*)c_record_defined : bool;
(*false if only declared
*)c_record_sizeof : Z.t;
(*size of record, in bytes
*)c_record_alignof : Z.t;
(*alignment, in bytes
*)mutable c_record_fields : c_record_field list;
c_record_range : Mopsa_utils.Core.Location.range;
(*declaration location
*)
}
Struct or union type.
and c_record_field = {
c_field_org_name : string;
(*may be empty for anonymous or padding fields
*)c_field_name : string;
(*non-empty name
*)c_field_offset : int;
c_field_bit_offset : int;
c_field_type : MopsaLib.typ;
c_field_range : Mopsa_utils.Core.Location.range;
(*declaration location
*)c_field_index : int;
}
Struct or union field.
and c_enum_type = {
c_enum_org_name : string;
(*name as in source, may be empty
*)c_enum_unique_name : string;
(*unique, non-empty name
*)c_enum_defined : bool;
(*false if only declared
*)c_enum_values : c_enum_value list;
c_enum_integer_type : c_integer_type;
c_enum_range : Mopsa_utils.Core.Location.range;
(*declaration location
*)
}
Enumerated type.
and c_enum_value = {
c_enum_val_org_name : string;
(*name as in source
*)c_enum_val_unique_name : string;
(*unique name
*)c_enum_val_value : Z.t;
c_enum_val_range : MopsaLib.range;
}
A possible value in an enumerated type.
and c_array_length =
| C_array_no_length
| C_array_length_cst of Z.t
| C_array_length_expr of MopsaLib.expr
(*Cases of arrays length.
*)
Type qualifiers.
and c_function_type = {
c_ftype_return : MopsaLib.typ;
c_ftype_params : MopsaLib.typ list;
c_ftype_variadic : bool;
}
Function type.
type MopsaLib.typ +=
| T_c_void
(*Void type.
*)| T_c_bool
| T_c_integer of c_integer_type
| T_c_float of c_float_type
| T_c_pointer of MopsaLib.typ
(*Scalar types.
*)| T_c_array of MopsaLib.typ * c_array_length
(*Arrays.
*)| T_c_bitfield of MopsaLib.typ * int
(*Bitfields, with bit-width, only used in struct.
*)| T_c_function of c_function_type option
(*Function, with or without a prototype
*)| T_c_builtin_fn
(*Built-in functions
*)| T_c_typedef of c_typedef
(*Typedefs
*)| T_c_record of c_record_type
(*struct and union
*)| T_c_enum of c_enum_type
(*enums
*)| T_c_qualified of c_qual * MopsaLib.typ
(*Qualified type.
*)| T_c_block_object of MopsaLib.typ
(*Type of block objects.
*)| T_c_unknown_builtin of string
(*Unknown builtin type.
*)
Function descriptor
***********************
type c_fundec = {
mutable c_func_uid : int;
(*unique identifier
*)mutable c_func_org_name : string;
(*original name
*)mutable c_func_unique_name : string;
(*unique name for globals and statics
*)c_func_is_static : bool;
mutable c_func_return : MopsaLib.typ;
(*type of returned value
*)mutable c_func_parameters : MopsaLib.var list;
(*function parameters
*)mutable c_func_body : MopsaLib.stmt option;
(*function body
*)mutable c_func_static_vars : MopsaLib.var list;
(*static variables declared in the function
*)mutable c_func_local_vars : MopsaLib.var list;
(*local variables declared in the function (excluding parameters)
*)mutable c_func_variadic : bool;
(*whether the has a variable number of arguments
*)mutable c_func_range : MopsaLib.range;
(*location range of the declaration
*)mutable c_func_name_range : MopsaLib.range;
(*location range of the name in the declaration
*)mutable c_func_stub : Stubs.Ast.stub_func option;
(*stub comment
*)
}
Function descriptor.
C variables
type c_var_scope =
| Variable_global
(*global shared among translation units
*)| Variable_extern
(*declared but not defined
*)| Variable_local of c_fundec
(*local to a function
*)| Variable_parameter of c_fundec
(*formal argument
*)| Variable_file_static of string
(*restricted to a translation unit
*)| Variable_func_static of c_fundec
(*restricted to a function
*)
val pp_scope : Format.formatter -> c_var_scope -> unit
type c_var_init =
| C_init_expr of MopsaLib.expr
| C_init_list of c_var_init list * c_var_init option
(*filler
*)| C_init_implicit of MopsaLib.typ
Variable initialization.
type cvar = {
cvar_scope : c_var_scope;
(*life-time scope of the variable
*)cvar_range : MopsaLib.range;
(*declaration range
*)cvar_uid : int;
cvar_orig_name : string;
cvar_uniq_name : string;
cvar_before_stmts : MopsaLib.stmt list;
(*list of statements to execute before the declaration of a variable
*)cvar_after_stmts : MopsaLib.stmt list;
(*list of statements to execute after the declaration of a variable
*)
}
C expressions
type MopsaLib.constant +=
| C_c_character of Z.t * c_character_kind
(*Constant character
*)| C_c_string of string * c_character_kind
(*Constant string literal
*)| C_c_invalid
(*Invalid pointer value
*)
type MopsaLib.expr_kind +=
| E_c_conditional of MopsaLib.expr * MopsaLib.expr * MopsaLib.expr
(*else
*)| E_c_array_subscript of MopsaLib.expr * MopsaLib.expr
(*index
*)| E_c_member_access of MopsaLib.expr * int * string
(*field
*)| E_c_function of c_fundec
| E_c_builtin_function of string
| E_c_builtin_call of string * MopsaLib.expr list
| E_c_arrow_access of MopsaLib.expr * int * string
(*field
*)| E_c_assign of MopsaLib.expr * MopsaLib.expr
(*rvalue
*)| E_c_compound_assign of MopsaLib.expr * MopsaLib.typ * MopsaLib.operator * MopsaLib.expr * MopsaLib.typ
(*type of the result, before converting back to lvalue type
*)| E_c_comma of MopsaLib.expr * MopsaLib.expr
(*, operator
*)| E_c_increment of c_inc_direction * c_inc_location * MopsaLib.expr
| E_c_address_of of MopsaLib.expr
(*& operator (address of lvalue)
*)| E_c_deref of MopsaLib.expr
(** operator (pointer dereference)
*)| E_c_cast of MopsaLib.expr * bool
(*explicitness
*)| E_c_statement of MopsaLib.stmt
| E_c_predefined of string
(*predefined identifier
*)| E_c_var_args of MopsaLib.expr
(*__builtin_va_arg
*)| E_c_atomic of int * MopsaLib.expr * MopsaLib.expr
| E_c_block_object of MopsaLib.expr
(*Block objects are useful to distinguish between operations on the block itself and its content. For, expanding the contents of a block will duplicate every cell in the block, while expanding the block object will update the pointers that point to the block.
*)
Scope update
type c_scope_update = {
c_scope_var_added : MopsaLib.var list;
c_scope_var_removed : MopsaLib.var list;
}
Scope update information for jump statements
Statements
type MopsaLib.stmt_kind +=
| S_c_goto_stab of MopsaLib.stmt
(*stabilization point for goto statement
*)| S_c_declaration of MopsaLib.var * c_var_init option * c_var_scope
(*declaration of a variable
*)| S_c_do_while of MopsaLib.stmt * MopsaLib.expr
(*condition
*)| S_c_for of MopsaLib.stmt * MopsaLib.expr option * MopsaLib.expr option * MopsaLib.stmt
(*body
*)| S_c_return of MopsaLib.expr option * c_scope_update
(*return statement
*)| S_c_break of c_scope_update
(*break statement
*)| S_c_continue of c_scope_update
(*continue statement
*)| S_c_goto of string * c_scope_update
(*goto statements.
*)| S_c_switch of MopsaLib.expr * MopsaLib.stmt
(*switch statement.
*)| S_c_label of string
(*statement label.
*)| S_c_switch_case of MopsaLib.expr list * c_scope_update
(*case of a switch statement.
case a: case b: stmt;
is represented through S_c_switch_case
a; b
to factor in some casesFor integer cases, we use the interval
*)a, b
to simplify expressions, similar to the GCC C extension for ranges| S_c_switch_default of c_scope_update
(*default case of switch statements.
*)| S_c_asm of string
(*inline assembly for now, we keep only a string representation to display warnings; see C_AST.asm_kind for a more usable representation when support is added
*)
type c_program = {
c_globals : (MopsaLib.var * c_var_init option) list;
(*global variables of the program
*)c_functions : c_fundec list;
(*functions of the program
*)c_stub_directives : Stubs.Ast.stub_directive list;
(*list of stub directives
*)
}
module CProgramKey : sig ... end
val c_program_ctx :
('a, c_program) Mopsa_analyzer__Framework__Core__Context.ctx_key
Flow-insensitive context to keep the analyzed C program
val set_c_program :
c_program ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Mopsa_analyzer.MopsaLib.Flow.flow
Set the C program in the flow
val get_c_program : 'a Mopsa_analyzer.MopsaLib.Flow.flow -> c_program
Get the C program from the flow
Conversion to/from Clang parser types
val to_clang_int_type : c_integer_type -> Mopsa_c_parser.C_AST.integer_type
val to_clang_float_type : c_float_type -> Mopsa_c_parser.C_AST.float_type
val from_clang_int_type : Mopsa_c_parser.C_AST.integer_type -> c_integer_type
val from_clang_float_type : Mopsa_c_parser.C_AST.float_type -> c_float_type
Target information
module TargetCtx : sig ... end
val get_c_target_info :
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
Mopsa_c_parser.Clang_AST.target_info
val set_c_target_info :
Mopsa_c_parser.Clang_AST.target_info ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Mopsa_analyzer.MopsaLib.Flow.flow
val remove_c_target_info :
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Mopsa_analyzer.MopsaLib.Flow.flow
Sizes and alignments
val sizeof_type_in_target :
MopsaLib.typ ->
Mopsa_c_parser.C_utils.C.target_info ->
Z.t
sizeof t
computes the size (in bytes) of a C type t
val sizeof_type : MopsaLib.typ -> 'a Mopsa_analyzer.MopsaLib.Flow.flow -> Z.t
val host_target_info : Mopsa_c_parser.Clang_AST.target_info
val sizeof_type_in_host : MopsaLib.typ -> Z.t
val sizeof_expr :
MopsaLib.typ ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
Mopsa_utils.Core.Location.range ->
MopsaLib.expr
Size (in bytes) of a type, as an expression. Handles variable-length ararys.
val remove_typedef : MopsaLib.typ -> MopsaLib.typ
val remove_qual : MopsaLib.typ -> MopsaLib.typ
val remove_typedef_qual : MopsaLib.typ -> MopsaLib.typ
val is_signed : MopsaLib.typ -> bool
is_signed t
whether t
is signed
val rangeof : MopsaLib.typ -> 'a Mopsa_analyzer.MopsaLib.Flow.flow -> Z.t * Z.t
range t
computes the interval range of type t
val int_rangeof :
MopsaLib.typ ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
int * int
range t
computes the interval range of type t
as integers
val wrap_expr :
MopsaLib.expr ->
(Z.t * Z.t) ->
Mopsa_utils.Core.Location.range ->
MopsaLib.expr
wrap_expr e (l,h)
expression needed to bring back e
in range (l
,h
)
val is_c_char_type : MopsaLib.typ -> bool
val is_c_string_type : MopsaLib.typ -> bool
val is_c_int_type : MopsaLib.typ -> bool
is_c_int_type t
tests whether t
is an integer type
val is_c_int_array_type : MopsaLib.typ -> bool
val is_c_signed_int_type : MopsaLib.typ -> bool
val is_c_bool_type : MopsaLib.typ -> bool
val is_c_float_type : MopsaLib.typ -> bool
is_c_int_type t
tests whether t
is a floating point type
val get_c_float_type : MopsaLib.typ -> c_float_type
val get_c_float_precision : MopsaLib.typ -> Universal.Lang.Ast.float_prec
Get the float precision from a C type
val is_c_bitfield : MopsaLib.typ -> bool
val is_c_num_type : MopsaLib.typ -> bool
is_c_int_type t
tests whether t
is a numeric type
val is_c_scalar_type : MopsaLib.typ -> bool
is_c_scalar_type t
tests whether t
is a scalar type
val is_c_pointer_type : MopsaLib.typ -> bool
is_c_pointer t
tests whether t
is a pointer
val is_c_void_type : MopsaLib.typ -> bool
val is_c_record_type : MopsaLib.typ -> bool
val is_c_struct_type : MopsaLib.typ -> bool
val is_c_union_type : MopsaLib.typ -> bool
val is_c_array_type : MopsaLib.typ -> bool
val is_c_function_type : MopsaLib.typ -> bool
val pointer_type : MopsaLib.typ -> MopsaLib.typ
is_scalartype t
lifts t
to a pointer to t
val under_pointer_type : MopsaLib.typ -> MopsaLib.typ
val under_array_type : MopsaLib.typ -> MopsaLib.typ
val under_type : MopsaLib.typ -> MopsaLib.typ
val void_to_char : MopsaLib.typ -> MopsaLib.typ
val get_array_constant_length : MopsaLib.typ -> Z.t
val align_byte : MopsaLib.typ -> int -> int
val is_c_type : MopsaLib.typ -> bool
val is_c_function_parameter : MopsaLib.var -> bool
val mk_c_address_of :
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
MopsaLib.expr
val mk_c_deref :
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
MopsaLib.expr
val mk_c_member_access :
MopsaLib.expr ->
c_record_field ->
Mopsa_utils.Core.Location.range ->
MopsaLib.expr
val mk_c_arrow_access :
MopsaLib.expr ->
c_record_field ->
Mopsa_utils.Core.Location.range ->
MopsaLib.expr
val mk_c_member_access_by_name :
MopsaLib.expr ->
string ->
Mopsa_utils.Core.Location.range ->
MopsaLib.expr
val mk_c_arrow_access_by_name :
MopsaLib.expr ->
string ->
Mopsa_utils.Core.Location.range ->
MopsaLib.expr
val mk_c_subscript_access :
MopsaLib.expr ->
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
MopsaLib.expr
val mk_c_character :
char ->
Mopsa_utils.Core.Location.range ->
MopsaLib.typ ->
MopsaLib.expr
val extract_multibyte_integer :
string ->
int ->
MopsaLib.typ ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
Z.t
val mk_c_multibyte_integer :
string ->
int ->
MopsaLib.typ ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
Mopsa_utils.Core.Location.range ->
MopsaLib.expr
val mk_c_invalid_pointer : Mopsa_utils.Core.Location.range -> MopsaLib.expr
val void : MopsaLib.typ
val u8 : MopsaLib.typ
val s8 : MopsaLib.typ
val s16 : MopsaLib.typ
val u16 : MopsaLib.typ
val s32 : MopsaLib.typ
val u32 : MopsaLib.typ
val s64 : MopsaLib.typ
val u64 : MopsaLib.typ
val ul : MopsaLib.typ
val sl : MopsaLib.typ
val ull : MopsaLib.typ
val sll : MopsaLib.typ
val array_type : MopsaLib.typ -> Z.t -> MopsaLib.typ
val size_type : 'a Mopsa_analyzer.MopsaLib.Flow.flow -> MopsaLib.typ
val type_of_string : string -> MopsaLib.typ
val is_c_block_object_type : MopsaLib.typ -> bool
val to_c_block_object : MopsaLib.expr -> MopsaLib.expr
val of_c_block_object : MopsaLib.expr -> MopsaLib.expr
val mk_c_string :
?kind:c_character_kind ->
string ->
Mopsa_utils.Core.Location.range ->
MopsaLib.expr
val mk_c_fun_typ : c_fundec -> MopsaLib.typ
val mk_c_call :
c_fundec ->
MopsaLib.expr list ->
Mopsa_utils.Core.Location.range ->
MopsaLib.expr
val mk_c_builtin_call :
string ->
MopsaLib.expr list ->
Framework.Core.Ast.Typ.typ ->
Mopsa_utils.Core.Location.range ->
MopsaLib.expr
val mk_c_call_stmt :
c_fundec ->
MopsaLib.expr list ->
Mopsa_utils.Core.Location.range ->
MopsaLib.stmt
val mk_c_cast :
?esynthetic:bool ->
MopsaLib.expr ->
Framework.Core.Ast.Typ.typ ->
Mopsa_utils.Core.Location.range ->
MopsaLib.expr
val mk_c_null :
?esynthetic:bool ->
Mopsa_utils.Core.Location.range ->
MopsaLib.expr
val mk_c_declaration :
MopsaLib.var ->
c_var_init option ->
c_var_scope ->
Mopsa_utils.Core.Location.range ->
MopsaLib.stmt
val is_c_global_scope : c_var_scope -> bool
val find_c_record_field : int -> MopsaLib.typ -> c_record_field
Statement comparison *
val compare_c_var_init : c_var_init -> c_var_init -> int
val compare_c_var_scope : c_var_scope -> c_var_scope -> int
val compare_c_var_scope_update : c_scope_update -> c_scope_update -> int
val range_cond :
MopsaLib.expr ->
Z.t ->
Z.t ->
Mopsa_utils.Core.Location.range ->
MopsaLib.expr
val remove_casts : MopsaLib.expr -> MopsaLib.expr
val c_expr_to_z :
MopsaLib.expr ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
Z.t option
Simplify C constant expressions to constants
val is_c_expr_equals_z :
MopsaLib.expr ->
Z.t ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
bool
val is_c_constant :
MopsaLib.expr ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
bool
val is_c_lval : MopsaLib.expr -> bool
val is_c_deref : MopsaLib.expr -> bool
val get_c_deref_type : MopsaLib.expr -> MopsaLib.typ
val is_c_variable_length_array_type : MopsaLib.typ -> bool
Check if v is declared as a variable length array
val is_c_no_length_array_type : MopsaLib.typ -> bool
Check if v is declared as an array without length (as for many auxiliary variables)
val find_c_fundec_by_name :
string ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
c_fundec
Find the definition of a C function
val find_c_fundec_by_uid :
int ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
c_fundec
val assert_valid_string :
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
('a, 'b) MopsaLib.man ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Core.Post.post
Check if a pointer points to a nul-terminated array
val assert_valid_wide_string :
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
('a, 'b) MopsaLib.man ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Core.Post.post
Check if a pointer points to a nul-terminated wide char array
val assert_valid_stream :
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
('a, 'b) MopsaLib.man ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Core.Post.post
Check if a pointer points to a valid stream
val assert_valid_file_descriptor :
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
('a, 'b) MopsaLib.man ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Core.Post.post
Check if a pointer points to a valid file descriptor
val assert_valid_ptr :
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
('a, 'b) MopsaLib.man ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Core.Post.post
Check if a pointer is valid
val memrand :
MopsaLib.expr ->
MopsaLib.expr ->
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
('a, 'b) MopsaLib.man ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Core.Post.post
Randomize an entire array
val strrand :
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
('a, 'b) MopsaLib.man ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Core.Post.post
Randomize a string
val strnrand :
MopsaLib.expr ->
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
('a, 'b) MopsaLib.man ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Core.Post.post
Randomize a substring
val wcsnrand :
MopsaLib.expr ->
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
('a, 'b) MopsaLib.man ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Core.Post.post
Randomize a wide substring
val memset :
MopsaLib.expr ->
MopsaLib.expr ->
MopsaLib.expr ->
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
('a, 'b) MopsaLib.man ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Core.Post.post
Set elements of an array with the same value c
val memcpy :
MopsaLib.expr ->
MopsaLib.expr ->
MopsaLib.expr ->
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
('a, 'b) MopsaLib.man ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Core.Post.post
Copy elements of an array
val error_error :
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
('a, 'b) MopsaLib.man ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Core.Post.post
Exit if status is non-zero
val error_error_at_line :
MopsaLib.expr ->
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
('a, 'b) MopsaLib.man ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Core.Post.post
Exit if status is non-zero
val asprintf_stub :
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
('a, 'b) MopsaLib.man ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Framework.Core.Eval.eval
val vasprintf_stub :
bool ->
MopsaLib.expr ->
MopsaLib.expr ->
Mopsa_utils.Core.Location.range ->
('a, 'b) MopsaLib.man ->
'a Mopsa_analyzer.MopsaLib.Flow.flow ->
'a Framework.Core.Eval.eval
val var_scope : MopsaLib.var -> c_var_scope