@ -738,7 +738,7 @@ let nondet pre = function Some reg -> kill pre reg | None -> pre
let abort _ = None
let abort _ = None
let intrinsic ~ skip_throw :
let intrinsic ~ skip_throw :
Sh . t -> Var . t option -> string -> Term . t list -> Sh . t option option =
Sh . t -> Var . t option -> string -> Term . t iarray -> Sh . t option option =
fun pre areturn intrinsic actuals ->
fun pre areturn intrinsic actuals ->
let name =
let name =
match String . index intrinsic '.' with
match String . index intrinsic '.' with
@ -746,60 +746,60 @@ let intrinsic ~skip_throw :
| Some i -> String . take i intrinsic
| Some i -> String . take i intrinsic
in
in
let skip pre = Some ( Some pre ) in
let skip pre = Some ( Some pre ) in
( match ( areturn , name , actuals ) with
( match ( areturn , name , IArray . to_array actuals ) with
(*
(*
* cstdlib - memory management
* cstdlib - memory management
* )
* )
(* void * malloc ( size_t size ) *)
(* void * malloc ( size_t size ) *)
| Some reg , " malloc " , [ size ]
| Some reg , " malloc " , [ | size | ]
(* void * aligned_alloc ( size_t alignment, size_t size ) *)
(* void * aligned_alloc ( size_t alignment, size_t size ) *)
| Some reg , " aligned_alloc " , [ size ; _ ] ->
| Some reg , " aligned_alloc " , [ |_ ; size | ] ->
Some ( exec_spec pre ( malloc_spec reg size ) )
Some ( exec_spec pre ( malloc_spec reg size ) )
(* void * calloc ( size_t number, size_t size ) *)
(* void * calloc ( size_t number, size_t size ) *)
| Some reg , " calloc " , [ size ; number ] ->
| Some reg , " calloc " , [ |number ; size | ] ->
Some ( exec_spec pre ( calloc_spec reg number size ) )
Some ( exec_spec pre ( calloc_spec reg number size ) )
(* int posix_memalign ( void * * ptr, size_t alignment, size_t size ) *)
(* int posix_memalign ( void * * ptr, size_t alignment, size_t size ) *)
| Some reg , " posix_memalign " , [ size ; _ ; ptr ] ->
| Some reg , " posix_memalign " , [ |ptr ; _ ; size | ] ->
Some ( exec_spec pre ( posix_memalign_spec reg ptr size ) )
Some ( exec_spec pre ( posix_memalign_spec reg ptr size ) )
(* void * realloc ( void * ptr, size_t size ) *)
(* void * realloc ( void * ptr, size_t size ) *)
| Some reg , " realloc " , [ size ; ptr ] ->
| Some reg , " realloc " , [ |ptr ; size | ] ->
Some ( exec_spec pre ( realloc_spec reg ptr size ) )
Some ( exec_spec pre ( realloc_spec reg ptr size ) )
(*
(*
* jemalloc - non - standard API
* jemalloc - non - standard API
* )
* )
(* void * mallocx ( size_t size, int flags ) *)
(* void * mallocx ( size_t size, int flags ) *)
| Some reg , " mallocx " , [ _ ; size ] ->
| Some reg , " mallocx " , [ |size ; _ | ] ->
Some ( exec_spec pre ( mallocx_spec reg size ) )
Some ( exec_spec pre ( mallocx_spec reg size ) )
(* void * rallocx ( void * ptr, size_t size, int flags ) *)
(* void * rallocx ( void * ptr, size_t size, int flags ) *)
| Some reg , " rallocx " , [ _ ; size ; ptr ] ->
| Some reg , " rallocx " , [ |ptr ; size ; _ | ] ->
Some ( exec_spec pre ( rallocx_spec reg ptr size ) )
Some ( exec_spec pre ( rallocx_spec reg ptr size ) )
(* size_t xallocx ( void * ptr, size_t size, size_t extra, int flags ) *)
(* size_t xallocx ( void * ptr, size_t size, size_t extra, int flags ) *)
| Some reg , " xallocx " , [ _ ; extra ; size ; ptr ] ->
| Some reg , " xallocx " , [ |ptr ; size ; extra ; _ | ] ->
Some ( exec_spec pre ( xallocx_spec reg ptr size extra ) )
Some ( exec_spec pre ( xallocx_spec reg ptr size extra ) )
(* size_t sallocx ( void * ptr, int flags ) *)
(* size_t sallocx ( void * ptr, int flags ) *)
| Some reg , " sallocx " , [ _ ; ptr ] ->
| Some reg , " sallocx " , [ |ptr ; _ | ] ->
Some ( exec_spec pre ( sallocx_spec reg ptr ) )
Some ( exec_spec pre ( sallocx_spec reg ptr ) )
(* void dallocx ( void * ptr, int flags ) *)
(* void dallocx ( void * ptr, int flags ) *)
| None , " dallocx " , [ _ ; ptr ]
| None , " dallocx " , [ |ptr ; _ | ]
(* void sdallocx ( void * ptr, size_t size, int flags ) *)
(* void sdallocx ( void * ptr, size_t size, int flags ) *)
| None , " sdallocx " , [ _ ; _ ; ptr ] ->
| None , " sdallocx " , [ |ptr ; _ ; _ | ] ->
Some ( exec_spec pre ( dallocx_spec ptr ) )
Some ( exec_spec pre ( dallocx_spec ptr ) )
(* size_t nallocx ( size_t size, int flags ) *)
(* size_t nallocx ( size_t size, int flags ) *)
| Some reg , " nallocx " , [ _ ; size ] ->
| Some reg , " nallocx " , [ |size ; _ | ] ->
Some ( exec_spec pre ( nallocx_spec reg size ) )
Some ( exec_spec pre ( nallocx_spec reg size ) )
(* size_t malloc_usable_size ( void * ptr ) *)
(* size_t malloc_usable_size ( void * ptr ) *)
| Some reg , " malloc_usable_size " , [ ptr ] ->
| Some reg , " malloc_usable_size " , [ | ptr | ] ->
Some ( exec_spec pre ( malloc_usable_size_spec reg ptr ) )
Some ( exec_spec pre ( malloc_usable_size_spec reg ptr ) )
(* int mallctl ( const char * name, void * oldp, size_t * oldlenp, void * newp,
(* int mallctl ( const char * name, void * oldp, size_t * oldlenp, void * newp,
size_t newlen ) * )
size_t newlen ) * )
| Some _ , " mallctl " , [ newlen ; newp ; oldlenp ; oldp ; _ ] ->
| Some _ , " mallctl " , [ |_ ; oldp ; oldlenp ; newp ; newlen | ] ->
Some ( exec_specs pre ( mallctl_specs oldp oldlenp newp newlen ) )
Some ( exec_specs pre ( mallctl_specs oldp oldlenp newp newlen ) )
(* int mallctlnametomib ( const char * name, size_t * mibp, size_t * miblenp ) *)
(* int mallctlnametomib ( const char * name, size_t * mibp, size_t * miblenp ) *)
| Some _ , " mallctlnametomib " , [ miblenp ; mibp ; _ ] ->
| Some _ , " mallctlnametomib " , [ |_ ; mibp ; miblenp | ] ->
Some ( exec_spec pre ( mallctlnametomib_spec mibp miblenp ) )
Some ( exec_spec pre ( mallctlnametomib_spec mibp miblenp ) )
(* int mallctlbymib ( const size_t * mib, size_t miblen, void * oldp, size_t *
(* int mallctlbymib ( const size_t * mib, size_t miblen, void * oldp, size_t *
oldlenp , void * newp , size_t newlen ) ; * )
oldlenp , void * newp , size_t newlen ) ; * )
| Some _ , " mallctlbymib " , [ newlen ; newp ; oldlenp ; oldp ; miblen ; mib ] ->
| Some _ , " mallctlbymib " , [ |mib ; miblen ; oldp ; oldlenp ; newp ; newlen | ] ->
Some
Some
( exec_specs pre
( exec_specs pre
( mallctlbymib_specs mib miblen oldp oldlenp newp newlen ) )
( mallctlbymib_specs mib miblen oldp oldlenp newp newlen ) )
@ -808,17 +808,18 @@ let intrinsic ~skip_throw :
* cstring
* cstring
* )
* )
(* size_t strlen ( const char * ptr ) *)
(* size_t strlen ( const char * ptr ) *)
| Some reg , " strlen " , [ ptr ] -> Some ( exec_spec pre ( strlen_spec reg ptr ) )
| Some reg , " strlen " , [| ptr |] ->
Some ( exec_spec pre ( strlen_spec reg ptr ) )
(*
(*
* cxxabi
* cxxabi
* )
* )
| Some _ , " __cxa_allocate_exception " , [ _ ] when skip_throw ->
| Some _ , " __cxa_allocate_exception " , [ | _ | ] when skip_throw ->
skip ( Sh . false_ pre . us )
skip ( Sh . false_ pre . us )
(*
(*
* folly
* folly
* )
* )
(* bool folly::usingJEMalloc ( ) *)
(* bool folly::usingJEMalloc ( ) *)
| Some _ , " _ZN5folly13usingJEMallocEv " , [ ] -> skip pre
| Some _ , " _ZN5folly13usingJEMallocEv " , [| | ] -> skip pre
| _ -> None )
| _ -> None )
$> function
$> function
| None -> ()
| None -> ()
@ -826,5 +827,4 @@ let intrinsic ~skip_throw :
[ % Trace . info
[ % Trace . info
" @[<2>exec intrinsic@ @[%a%s(@[%a@])@] from@ @[{ %a@ }@]@] "
" @[<2>exec intrinsic@ @[%a%s(@[%a@])@] from@ @[{ %a@ }@]@] "
( Option . pp " %a := " Var . pp )
( Option . pp " %a := " Var . pp )
areturn intrinsic ( List . pp " ,@ " Term . pp ) ( List . rev actuals ) Sh . pp
areturn intrinsic ( IArray . pp " ,@ " Term . pp ) actuals Sh . pp pre ]
pre ]