3
0
Fork 0
mirror of https://github.com/Z3Prover/z3 synced 2025-08-16 16:27:11 +00:00

Merge pull request #2 from martin-neuhaeusser/ml_api_patch2

Correct reference counting and handling of NULL pointers in new OCaml bindings.
This commit is contained in:
Christoph M. Wintersteiger 2016-04-05 13:01:04 +01:00
commit 991eae8767
4 changed files with 514 additions and 521 deletions

View file

@ -78,7 +78,7 @@ Type2Dotnet = { VOID : 'void', VOID_PTR : 'IntPtr', INT : 'int', UINT : 'uint',
# Mapping to Java types # Mapping to Java types
Type2Java = { VOID : 'void', VOID_PTR : 'long', INT : 'int', UINT : 'int', INT64 : 'long', UINT64 : 'long', DOUBLE : 'double', Type2Java = { VOID : 'void', VOID_PTR : 'long', INT : 'int', UINT : 'int', INT64 : 'long', UINT64 : 'long', DOUBLE : 'double',
FLOAT : 'float', STRING : 'String', STRING_PTR : 'StringPtr', FLOAT : 'float', STRING : 'String', STRING_PTR : 'StringPtr',
BOOL : 'boolean', SYMBOL : 'long', PRINT_MODE : 'int', ERROR_CODE : 'int'} BOOL : 'boolean', SYMBOL : 'long', PRINT_MODE : 'int', ERROR_CODE : 'int'}
Type2JavaW = { VOID : 'void', VOID_PTR : 'jlong', INT : 'jint', UINT : 'jint', INT64 : 'jlong', UINT64 : 'jlong', DOUBLE : 'jdouble', Type2JavaW = { VOID : 'void', VOID_PTR : 'jlong', INT : 'jint', UINT : 'jint', INT64 : 'jlong', UINT64 : 'jlong', DOUBLE : 'jdouble',
@ -87,7 +87,7 @@ Type2JavaW = { VOID : 'void', VOID_PTR : 'jlong', INT : 'jint', UINT : 'jint', I
# Mapping to ML types # Mapping to ML types
Type2ML = { VOID : 'unit', VOID_PTR : 'VOIDP', INT : 'int', UINT : 'int', INT64 : 'int', UINT64 : 'int', DOUBLE : 'float', Type2ML = { VOID : 'unit', VOID_PTR : 'VOIDP', INT : 'int', UINT : 'int', INT64 : 'int', UINT64 : 'int', DOUBLE : 'float',
FLOAT : 'float', STRING : 'string', STRING_PTR : 'char**', FLOAT : 'float', STRING : 'string', STRING_PTR : 'char**',
BOOL : 'bool', SYMBOL : 'z3_symbol', PRINT_MODE : 'int', ERROR_CODE : 'int' } BOOL : 'bool', SYMBOL : 'z3_symbol', PRINT_MODE : 'int', ERROR_CODE : 'int' }
next_type_id = FIRST_OBJ_ID next_type_id = FIRST_OBJ_ID
@ -95,7 +95,7 @@ next_type_id = FIRST_OBJ_ID
def def_Type(var, c_type, py_type): def def_Type(var, c_type, py_type):
global next_type_id global next_type_id
exec('%s = %s' % (var, next_type_id), globals()) exec('%s = %s' % (var, next_type_id), globals())
Type2Str[next_type_id] = c_type Type2Str[next_type_id] = c_type
Type2PyStr[next_type_id] = py_type Type2PyStr[next_type_id] = py_type
next_type_id = next_type_id + 1 next_type_id = next_type_id + 1
@ -637,18 +637,18 @@ def mk_java(java_dir, package_name):
elif k == IN_ARRAY or k == INOUT_ARRAY: elif k == IN_ARRAY or k == INOUT_ARRAY:
if param_type(param) == INT or param_type(param) == UINT: if param_type(param) == INT or param_type(param) == UINT:
java_wrapper.write(' %s * _a%s = (%s*) jenv->GetIntArrayElements(a%s, NULL);\n' % (type2str(param_type(param)), i, type2str(param_type(param)), i)) java_wrapper.write(' %s * _a%s = (%s*) jenv->GetIntArrayElements(a%s, NULL);\n' % (type2str(param_type(param)), i, type2str(param_type(param)), i))
else: else:
java_wrapper.write(' GETLONGAELEMS(%s, a%s, _a%s);\n' % (type2str(param_type(param)), i, i)) java_wrapper.write(' GETLONGAELEMS(%s, a%s, _a%s);\n' % (type2str(param_type(param)), i, i))
elif k == OUT_ARRAY: elif k == OUT_ARRAY:
java_wrapper.write(' %s * _a%s = (%s *) malloc(((unsigned)a%s) * sizeof(%s));\n' % (type2str(param_type(param)), java_wrapper.write(' %s * _a%s = (%s *) malloc(((unsigned)a%s) * sizeof(%s));\n' % (type2str(param_type(param)),
i, i,
type2str(param_type(param)), type2str(param_type(param)),
param_array_capacity_pos(param), param_array_capacity_pos(param),
type2str(param_type(param)))) type2str(param_type(param))))
if param_type(param) == INT or param_type(param) == UINT: if param_type(param) == INT or param_type(param) == UINT:
java_wrapper.write(' jenv->GetIntArrayRegion(a%s, 0, (jsize)a%s, (jint*)_a%s);\n' % (i, param_array_capacity_pos(param), i)) java_wrapper.write(' jenv->GetIntArrayRegion(a%s, 0, (jsize)a%s, (jint*)_a%s);\n' % (i, param_array_capacity_pos(param), i))
else: else:
java_wrapper.write(' GETLONGAREGION(%s, a%s, 0, a%s, _a%s);\n' % (type2str(param_type(param)), i, param_array_capacity_pos(param), i)) java_wrapper.write(' GETLONGAREGION(%s, a%s, 0, a%s, _a%s);\n' % (type2str(param_type(param)), i, param_array_capacity_pos(param), i))
elif k == IN and param_type(param) == STRING: elif k == IN and param_type(param) == STRING:
java_wrapper.write(' Z3_string _a%s = (Z3_string) jenv->GetStringUTFChars(a%s, NULL);\n' % (i, i)) java_wrapper.write(' Z3_string _a%s = (Z3_string) jenv->GetStringUTFChars(a%s, NULL);\n' % (i, i))
elif k == OUT_MANAGED_ARRAY: elif k == OUT_MANAGED_ARRAY:
@ -679,7 +679,7 @@ def mk_java(java_dir, package_name):
java_wrapper.write('(%s)a%i' % (param2str(param), i)) java_wrapper.write('(%s)a%i' % (param2str(param), i))
i = i + 1 i = i + 1
java_wrapper.write(');\n') java_wrapper.write(');\n')
# cleanup # cleanup
i = 0 i = 0
for param in params: for param in params:
k = param_kind(param) k = param_kind(param)
@ -715,7 +715,7 @@ def mk_java(java_dir, package_name):
if result == STRING: if result == STRING:
java_wrapper.write(' return jenv->NewStringUTF(result);\n') java_wrapper.write(' return jenv->NewStringUTF(result);\n')
elif result != VOID: elif result != VOID:
java_wrapper.write(' return (%s) result;\n' % type2javaw(result)) java_wrapper.write(' return (%s) result;\n' % type2javaw(result))
java_wrapper.write('}\n') java_wrapper.write('}\n')
java_wrapper.write('#ifdef __cplusplus\n') java_wrapper.write('#ifdef __cplusplus\n')
java_wrapper.write('}\n') java_wrapper.write('}\n')
@ -945,7 +945,7 @@ def def_API(name, result, params):
error ("unsupported parameter for %s, %s" % (ty, name, p)) error ("unsupported parameter for %s, %s" % (ty, name, p))
elif kind == OUT_ARRAY: elif kind == OUT_ARRAY:
sz = param_array_capacity_pos(p) sz = param_array_capacity_pos(p)
sz_p = params[sz] sz_p = params[sz]
sz_p_k = param_kind(sz_p) sz_p_k = param_kind(sz_p)
tstr = type2str(ty) tstr = type2str(ty)
if sz_p_k == OUT or sz_p_k == INOUT: if sz_p_k == OUT or sz_p_k == INOUT:
@ -1094,6 +1094,8 @@ def ml_plus_type(ts):
def ml_minus_type(ts): def ml_minus_type(ts):
if ts == 'Z3_ast' or ts == 'Z3_sort' or ts == 'Z3_func_decl' or ts == 'Z3_app' or ts == 'Z3_pattern': if ts == 'Z3_ast' or ts == 'Z3_sort' or ts == 'Z3_func_decl' or ts == 'Z3_app' or ts == 'Z3_pattern':
return 'Z3_ast' return 'Z3_ast'
if ts == 'Z3_ast_plus' or ts == 'Z3_sort_plus' or ts == 'Z3_func_decl_plus' or ts == 'Z3_app_plus' or ts == 'Z3_pattern_plus':
return 'Z3_ast'
elif ts == 'Z3_constructor_plus': elif ts == 'Z3_constructor_plus':
return 'Z3_constructor' return 'Z3_constructor'
elif ts == 'Z3_constructor_list_plus': elif ts == 'Z3_constructor_list_plus':
@ -1151,7 +1153,7 @@ def ml_has_plus_type(ts):
def ml_unwrap(t, ts, s): def ml_unwrap(t, ts, s):
if t == STRING: if t == STRING:
return '(' + ts + ') String_val(' + s + ')' return '(' + ts + ') String_val(' + s + ')'
elif t == BOOL: elif t == BOOL or (type2str(t) == 'Z3_bool'):
return '(' + ts + ') Bool_val(' + s + ')' return '(' + ts + ') Bool_val(' + s + ')'
elif t == INT or t == PRINT_MODE or t == ERROR_CODE: elif t == INT or t == PRINT_MODE or t == ERROR_CODE:
return '(' + ts + ') Int_val(' + s + ')' return '(' + ts + ') Int_val(' + s + ')'
@ -1172,7 +1174,7 @@ def ml_unwrap(t, ts, s):
def ml_set_wrap(t, d, n): def ml_set_wrap(t, d, n):
if t == VOID: if t == VOID:
return d + ' = Val_unit;' return d + ' = Val_unit;'
elif t == BOOL: elif t == BOOL or (type2str(t) == 'Z3_bool'):
return d + ' = Val_bool(' + n + ');' return d + ' = Val_bool(' + n + ');'
elif t == INT or t == UINT or t == PRINT_MODE or t == ERROR_CODE: elif t == INT or t == UINT or t == PRINT_MODE or t == ERROR_CODE:
return d + ' = Val_int(' + n + ');' return d + ' = Val_int(' + n + ');'
@ -1186,6 +1188,15 @@ def ml_set_wrap(t, d, n):
pts = ml_plus_type(type2str(t)) pts = ml_plus_type(type2str(t))
return '*(' + pts + '*)Data_custom_val(' + d + ') = ' + n + ';' return '*(' + pts + '*)Data_custom_val(' + d + ') = ' + n + ';'
def ml_alloc_and_store(t, lhs, rhs):
if t == VOID or t == BOOL or t == INT or t == UINT or t == PRINT_MODE or t == ERROR_CODE or t == INT64 or t == UINT64 or t == DOUBLE or t == STRING or (type2str(t) == 'Z3_bool'):
return ml_set_wrap(t, lhs, rhs)
else:
pts = ml_plus_type(type2str(t))
pops = ml_plus_ops_type(type2str(t))
alloc_str = '%s = caml_alloc_custom(&%s, sizeof(%s), 0, 1); ' % (lhs, pops, pts)
return alloc_str + ml_set_wrap(t, lhs, rhs)
def mk_ml(ml_dir): def mk_ml(ml_dir):
global Type2Str global Type2Str
ml_nativef = os.path.join(ml_dir, 'z3native.ml') ml_nativef = os.path.join(ml_dir, 'z3native.ml')
@ -1258,6 +1269,18 @@ def mk_ml(ml_dir):
ml_native.write(' a%d' % i) ml_native.write(' a%d' % i)
i = i + 1 i = i + 1
ml_native.write('\n') ml_native.write('\n')
ml_native.write('\n')
# null pointer helpers
for type_id in Type2Str:
type_name = Type2Str[type_id]
if ml_has_plus_type(type_name) and not type_name in ['Z3_context', 'Z3_sort', 'Z3_func_decl', 'Z3_app', 'Z3_pattern']:
ml_name = type2ml(type_id)
ml_native.write(' external context_of_%s : %s -> context = "n_context_of_%s"\n' % (ml_name, ml_name, ml_name))
ml_native.write(' external is_null_%s : %s -> bool = "n_is_null_%s"\n' % (ml_name, ml_name, ml_name))
ml_native.write(' external mk_null_%s : context -> %s = "n_mk_null_%s"\n\n' % (ml_name, ml_name, ml_name))
ml_native.write('(**/**)\n') ml_native.write('(**/**)\n')
ml_native.close() ml_native.close()
@ -1266,7 +1289,6 @@ def mk_ml(ml_dir):
mk_z3native_stubs_c(ml_dir) mk_z3native_stubs_c(ml_dir)
def mk_z3native_stubs_c(ml_dir): # C interface def mk_z3native_stubs_c(ml_dir): # C interface
ml_wrapperf = os.path.join(ml_dir, 'z3native_stubs.c') ml_wrapperf = os.path.join(ml_dir, 'z3native_stubs.c')
ml_wrapper = open(ml_wrapperf, 'w') ml_wrapper = open(ml_wrapperf, 'w')
@ -1284,16 +1306,16 @@ def mk_z3native_stubs_c(ml_dir): # C interface
ret_size = len(op) ret_size = len(op)
if result != VOID: if result != VOID:
ret_size = ret_size + 1 ret_size = ret_size + 1
# Setup frame # Setup frame
ml_wrapper.write('CAMLprim DLL_PUBLIC value n_%s(' % ml_method_name(name)) ml_wrapper.write('CAMLprim DLL_PUBLIC value n_%s(' % ml_method_name(name))
first = True first = True
i = 0 i = 0
for p in params: for p in params:
if is_in_param(p): if is_in_param(p):
if first: if first:
first = False first = False
else: else:
ml_wrapper.write(', ') ml_wrapper.write(', ')
ml_wrapper.write('value a%d' % i) ml_wrapper.write('value a%d' % i)
i = i + 1 i = i + 1
@ -1315,14 +1337,21 @@ def mk_z3native_stubs_c(ml_dir): # C interface
ml_wrapper.write(' CAMLlocal1(result);\n') ml_wrapper.write(' CAMLlocal1(result);\n')
else: else:
c = 0 c = 0
needs_tmp_value = False
for p in params: for p in params:
if is_out_param(p) or is_array_param(p): if is_out_param(p) or is_array_param(p):
c = c + 1 c = c + 1
needs_tmp_value = needs_tmp_value or param_kind(p) == OUT_ARRAY or param_kind(p) == INOUT_ARRAY
if needs_tmp_value:
c = c + 1
ml_wrapper.write(' CAMLlocal%s(result, z3rv_val' % (c+2)) ml_wrapper.write(' CAMLlocal%s(result, z3rv_val' % (c+2))
for p in params: for p in params:
if is_out_param(p) or is_array_param(p): if is_out_param(p) or is_array_param(p):
ml_wrapper.write(', _a%s_val' % i) ml_wrapper.write(', _a%s_val' % i)
i = i + 1 i = i + 1
if needs_tmp_value:
ml_wrapper.write(', tmp_val')
ml_wrapper.write(');\n') ml_wrapper.write(');\n')
if len(ap) != 0: if len(ap) != 0:
@ -1333,7 +1362,7 @@ def mk_z3native_stubs_c(ml_dir): # C interface
i = 0 i = 0
for param in params: for param in params:
if param_type(param) == CONTEXT and i == 0: if param_type(param) == CONTEXT and i == 0:
ml_wrapper.write(' Z3_context_plus * ctx_p = (Z3_context_plus*) Data_custom_val(a' + str(i) + ');\n') ml_wrapper.write(' Z3_context_plus ctx_p = *(Z3_context_plus*) Data_custom_val(a' + str(i) + ');\n')
ml_wrapper.write(' Z3_context _a0 = ctx_p->ctx;\n') ml_wrapper.write(' Z3_context _a0 = ctx_p->ctx;\n')
have_context = True have_context = True
else: else:
@ -1341,7 +1370,7 @@ def mk_z3native_stubs_c(ml_dir): # C interface
if k == OUT_ARRAY: if k == OUT_ARRAY:
ml_wrapper.write(' %s * _a%s = (%s*) malloc(sizeof(%s) * (_a%s));\n' % ( ml_wrapper.write(' %s * _a%s = (%s*) malloc(sizeof(%s) * (_a%s));\n' % (
type2str(param_type(param)), type2str(param_type(param)),
i, i,
type2str(param_type(param)), type2str(param_type(param)),
type2str(param_type(param)), type2str(param_type(param)),
param_array_capacity_pos(param))) param_array_capacity_pos(param)))
@ -1350,14 +1379,14 @@ def mk_z3native_stubs_c(ml_dir): # C interface
elif k == IN_ARRAY or k == INOUT_ARRAY: elif k == IN_ARRAY or k == INOUT_ARRAY:
t = param_type(param) t = param_type(param)
ts = type2str(t) ts = type2str(t)
ml_wrapper.write(' %s * _a%s = (%s*) malloc(sizeof(%s) * _a%s);\n' % (ts, i, ts, ts, param_array_capacity_pos(param))) ml_wrapper.write(' %s * _a%s = (%s*) malloc(sizeof(%s) * _a%s);\n' % (ts, i, ts, ts, param_array_capacity_pos(param)))
elif k == IN: elif k == IN:
t = param_type(param) t = param_type(param)
ml_wrapper.write(' %s _a%s = %s;\n' % (type2str(t), i, ml_unwrap(t, type2str(t), 'a' + str(i)))) ml_wrapper.write(' %s _a%s = %s;\n' % (type2str(t), i, ml_unwrap(t, type2str(t), 'a' + str(i))))
elif k == OUT: elif k == OUT:
ml_wrapper.write(' %s _a%s;\n' % (type2str(param_type(param)), i)) ml_wrapper.write(' %s _a%s;\n' % (type2str(param_type(param)), i))
elif k == INOUT: elif k == INOUT:
ml_wrapper.write(' %s _a%s = a%s;\n' % (type2str(param_type(param)), i, i)) ml_wrapper.write(' %s _a%s = a%s;\n' % (type2str(param_type(param)), i, i))
i = i + 1 i = i + 1
i = 0 i = 0
@ -1371,20 +1400,14 @@ def mk_z3native_stubs_c(ml_dir): # C interface
ml_wrapper.write(' }\n') ml_wrapper.write(' }\n')
i = i + 1 i = i + 1
ml_wrapper.write(' ') ml_wrapper.write('\n /* invoke Z3 function */\n ')
if result != VOID: if result != VOID:
ts = type2str(result) ts = type2str(result)
if ml_has_plus_type(ts): if ml_has_plus_type(ts):
ml_wrapper.write('%s z3rv_m = ' % ts) ml_wrapper.write('%s z3rv_m = ' % ts)
elif (result == BOOL or result == INT or result == UINT or result == PRINT_MODE or result == ERROR_CODE or result ==INT64 or result == UINT64 or result == DOUBLE or result == STRING):
ml_wrapper.write('%s z3rv = ' % ts)
else: else:
ml_wrapper.write('result = caml_alloc_custom(&default_custom_ops, sizeof(%s), 0, 1);\n ' % ts)
ml_wrapper.write('%s z3rv = ' % ts) ml_wrapper.write('%s z3rv = ' % ts)
elif len(op) != 0:
ml_wrapper.write('result = caml_alloc(%s, 0);\n ' % ret_size)
# invoke procedure # invoke procedure
ml_wrapper.write('%s(' % name) ml_wrapper.write('%s(' % name)
i = 0 i = 0
@ -1412,8 +1435,7 @@ def mk_z3native_stubs_c(ml_dir): # C interface
if result != VOID: if result != VOID:
ts = type2str(result) ts = type2str(result)
if ml_has_plus_type(ts): if ml_has_plus_type(ts):
pts = ml_plus_type(ts) pts = ml_plus_type(ts)
ml_wrapper.write(' result = caml_alloc_custom(&%s, sizeof(%s), 0, 1);\n' % (ml_plus_ops_type(ts), pts))
if name in NULLWrapped: if name in NULLWrapped:
ml_wrapper.write(' %s z3rv = %s_mk(z3rv_m);\n' % (pts, pts)) ml_wrapper.write(' %s z3rv = %s_mk(z3rv_m);\n' % (pts, pts))
else: else:
@ -1421,6 +1443,14 @@ def mk_z3native_stubs_c(ml_dir): # C interface
# convert output params # convert output params
if len(op) > 0: if len(op) > 0:
# we have output parameters (i.e. call-by-reference arguments to the Z3 native
# code function). Hence, the value returned by the OCaml native wrapper is a tuple
# which contains the Z3 native function's return value (if it is non-void) in its
# first and the output parameters in the following components.
ml_wrapper.write('\n /* construct return tuple */\n')
ml_wrapper.write(' result = caml_alloc(%s, 0);\n' % ret_size)
i = 0 i = 0
for p in params: for p in params:
pt = param_type(p) pt = param_type(p)
@ -1429,15 +1459,13 @@ def mk_z3native_stubs_c(ml_dir): # C interface
ml_wrapper.write(' _a%s_val = caml_alloc(_a%s, 0);\n' % (i, param_array_capacity_pos(p))) ml_wrapper.write(' _a%s_val = caml_alloc(_a%s, 0);\n' % (i, param_array_capacity_pos(p)))
ml_wrapper.write(' for (_i = 0; _i < _a%s; _i++) {\n' % param_array_capacity_pos(p)) ml_wrapper.write(' for (_i = 0; _i < _a%s; _i++) {\n' % param_array_capacity_pos(p))
pts = ml_plus_type(ts) pts = ml_plus_type(ts)
pops = ml_plus_ops_type(ts) pops = ml_plus_ops_type(ts)
ml_wrapper.write(' value t;\n') if ml_has_plus_type(ts):
ml_wrapper.write(' t = caml_alloc_custom(&%s, sizeof(%s), 0, 1);\n' % (pops, pts))
if ml_has_plus_type(ts):
ml_wrapper.write(' %s _a%dp = %s_mk(ctx_p, (%s) _a%d[_i]);\n' % (pts, i, pts, ml_minus_type(ts), i)) ml_wrapper.write(' %s _a%dp = %s_mk(ctx_p, (%s) _a%d[_i]);\n' % (pts, i, pts, ml_minus_type(ts), i))
ml_wrapper.write(' %s\n' % ml_set_wrap(pt, 't', '_a%dp' % i)) ml_wrapper.write(' %s\n' % ml_alloc_and_store(pt, 'tmp_val', '_a%dp' % i))
else: else:
ml_wrapper.write(' %s\n' % ml_set_wrap(pt, 't', '_a%d[_i]' % i)) ml_wrapper.write(' %s\n' % ml_alloc_and_store(pt, 'tmp_val', '_a%d[_i]' % i))
ml_wrapper.write(' Store_field(_a%s_val, _i, t);\n' % i) ml_wrapper.write(' Store_field(_a%s_val, _i, tmp_val);\n' % i)
ml_wrapper.write(' }\n') ml_wrapper.write(' }\n')
elif param_kind(p) == OUT_MANAGED_ARRAY: elif param_kind(p) == OUT_MANAGED_ARRAY:
wrp = ml_set_wrap(pt, '_a%d_val' % i, '_a%d' % i) wrp = ml_set_wrap(pt, '_a%d_val' % i, '_a%d' % i)
@ -1448,18 +1476,15 @@ def mk_z3native_stubs_c(ml_dir): # C interface
if ml_has_plus_type(ts): if ml_has_plus_type(ts):
pts = ml_plus_type(ts) pts = ml_plus_type(ts)
ml_wrapper.write(' %s _a%dp = %s_mk(ctx_p, (%s) _a%d);\n' % (pts, i, pts, ml_minus_type(ts), i)) ml_wrapper.write(' %s _a%dp = %s_mk(ctx_p, (%s) _a%d);\n' % (pts, i, pts, ml_minus_type(ts), i))
ml_wrapper.write(' %s\n' % ml_set_wrap(pt, '_a%d_val' % i, '_a%dp' % i)) ml_wrapper.write(' %s\n' % ml_alloc_and_store(pt, '_a%d_val' % i, '_a%dp' % i))
else: else:
ml_wrapper.write(' %s\n' % ml_set_wrap(pt, '_a%d_val' % i, '_a%d' % i)) ml_wrapper.write(' %s\n' % ml_alloc_and_store(pt, '_a%d_val' % i, '_a%d' % i))
i = i + 1 i = i + 1
# return tuples # return tuples
if len(op) == 0:
ml_wrapper.write(' %s\n' % ml_set_wrap(result, "result", "z3rv"))
else:
i = j = 0 i = j = 0
if result != VOID: if result != VOID:
ml_wrapper.write(' %s\n' % ml_set_wrap(result, "z3rv_val", "z3rv")) ml_wrapper.write(' %s' % ml_alloc_and_store(result, 'z3rv_val', 'z3rv'))
ml_wrapper.write(' Store_field(result, 0, z3rv_val);\n') ml_wrapper.write(' Store_field(result, 0, z3rv_val);\n')
j = j + 1 j = j + 1
for p in params: for p in params:
@ -1467,8 +1492,13 @@ def mk_z3native_stubs_c(ml_dir): # C interface
ml_wrapper.write(' Store_field(result, %s, _a%s_val);\n' % (j, i)) ml_wrapper.write(' Store_field(result, %s, _a%s_val);\n' % (j, i))
j = j + 1 j = j + 1
i = i + 1 i = i + 1
else:
# As we have no output parameters, we simply return the result
ml_wrapper.write('\n /* construct simple return value */\n')
ml_wrapper.write(' %s' % ml_alloc_and_store(result, "result", "z3rv"))
# local array cleanup # local array cleanup
ml_wrapper.write('\n /* cleanup and return */\n')
i = 0 i = 0
for p in params: for p in params:
k = param_kind(p) k = param_kind(p)
@ -1480,7 +1510,7 @@ def mk_z3native_stubs_c(ml_dir): # C interface
ml_wrapper.write(' CAMLreturn(result);\n') ml_wrapper.write(' CAMLreturn(result);\n')
ml_wrapper.write('}\n\n') ml_wrapper.write('}\n\n')
if len(ip) > 5: if len(ip) > 5:
ml_wrapper.write('CAMLprim DLL_PUBLIC value n_%s_bytecode(value * argv, int argn) {\n' % ml_method_name(name)) ml_wrapper.write('CAMLprim DLL_PUBLIC value n_%s_bytecode(value * argv, int argn) {\n' % ml_method_name(name))
ml_wrapper.write(' return n_%s(' % ml_method_name(name)) ml_wrapper.write(' return n_%s(' % ml_method_name(name))
i = 0 i = 0
while i < len(ip): while i < len(ip):

File diff suppressed because it is too large Load diff

View file

@ -32,75 +32,5 @@ and optimize = ptr
and param_descrs = ptr and param_descrs = ptr
and rcf_num = ptr and rcf_num = ptr
external is_null : ptr -> bool
= "n_is_null"
external mk_null : unit -> ptr
= "n_mk_null"
external set_internal_error_handler : ptr -> unit external set_internal_error_handler : ptr -> unit
= "n_set_internal_error_handler" = "n_set_internal_error_handler"
external context_of_symbol : symbol -> context
= "n_context_of_symbol"
external context_of_constructor : constructor -> context
= "n_context_of_constructor"
external context_of_constructor_list : constructor_list -> context
= "n_context_of_constructor_list"
external context_of_rcf_num : rcf_num -> context
= "n_context_of_rcf_num"
external context_of_ast : ast -> context
= "n_context_of_ast"
external context_of_params : params -> context
= "n_context_of_params"
external context_of_param_descrs : param_descrs -> context
= "n_context_of_param_descrs"
external context_of_model : model -> context
= "n_context_of_model"
external context_of_func_interp : func_interp -> context
= "n_context_of_func_interp"
external context_of_func_entry : func_entry -> context
= "n_context_of_func_entry"
external context_of_goal : goal -> context
= "n_context_of_goal"
external context_of_tactic : tactic -> context
= "n_context_of_tactic"
external context_of_probe : probe -> context
= "n_context_of_probe"
external context_of_apply_result : apply_result -> context
= "n_context_of_apply_result"
external context_of_solver : solver -> context
= "n_context_of_solver"
external context_of_stats : stats -> context
= "n_context_of_stats"
external context_of_ast_vector : ast_vector -> context
= "n_context_of_ast_vector"
external context_of_ast_map : ast_map -> context
= "n_context_of_ast_map"
external context_of_fixedpoint : fixedpoint -> context
= "n_context_of_fixedpoint"
external context_of_optimize : optimize -> context
= "n_context_of_optimize"

View file

@ -26,31 +26,31 @@ extern "C" {
#define CAMLlocal6(X1,X2,X3,X4,X5,X6) \ #define CAMLlocal6(X1,X2,X3,X4,X5,X6) \
CAMLlocal5(X1,X2,X3,X4,X5); \ CAMLlocal5(X1,X2,X3,X4,X5); \
CAMLlocal1(X6) CAMLlocal1(X6)
#define CAMLlocal7(X1,X2,X3,X4,X5,X6,X7) \ #define CAMLlocal7(X1,X2,X3,X4,X5,X6,X7) \
CAMLlocal5(X1,X2,X3,X4,X5); \ CAMLlocal5(X1,X2,X3,X4,X5); \
CAMLlocal2(X6,X7) CAMLlocal2(X6,X7)
#define CAMLlocal8(X1,X2,X3,X4,X5,X6,X7,X8) \ #define CAMLlocal8(X1,X2,X3,X4,X5,X6,X7,X8) \
CAMLlocal5(X1,X2,X3,X4,X5); \ CAMLlocal5(X1,X2,X3,X4,X5); \
CAMLlocal3(X6,X7,X8) CAMLlocal3(X6,X7,X8)
#define CAMLparam7(X1,X2,X3,X4,X5,X6,X7) \ #define CAMLparam7(X1,X2,X3,X4,X5,X6,X7) \
CAMLparam5(X1,X2,X3,X4,X5); \ CAMLparam5(X1,X2,X3,X4,X5); \
CAMLxparam2(X6,X7) CAMLxparam2(X6,X7)
#define CAMLparam8(X1,X2,X3,X4,X5,X6,X7,X8) \ #define CAMLparam8(X1,X2,X3,X4,X5,X6,X7,X8) \
CAMLparam5(X1,X2,X3,X4,X5); \ CAMLparam5(X1,X2,X3,X4,X5); \
CAMLxparam3(X6,X7,X8) CAMLxparam3(X6,X7,X8)
#define CAMLparam9(X1,X2,X3,X4,X5,X6,X7,X8,X9) \ #define CAMLparam9(X1,X2,X3,X4,X5,X6,X7,X8,X9) \
CAMLparam5(X1,X2,X3,X4,X5); \ CAMLparam5(X1,X2,X3,X4,X5); \
CAMLxparam4(X6,X7,X8,X9) CAMLxparam4(X6,X7,X8,X9)
#define CAMLparam12(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12) \ #define CAMLparam12(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12) \
CAMLparam5(X1,X2,X3,X4,X5); \ CAMLparam5(X1,X2,X3,X4,X5); \
CAMLxparam5(X6,X7,X8,X9,X10); \ CAMLxparam5(X6,X7,X8,X9,X10); \
CAMLxparam2(X11,X12) CAMLxparam2(X11,X12)
#define CAMLparam13(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13) \ #define CAMLparam13(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13) \
CAMLparam5(X1,X2,X3,X4,X5); \ CAMLparam5(X1,X2,X3,X4,X5); \
CAMLxparam5(X6,X7,X8,X9,X10); \ CAMLxparam5(X6,X7,X8,X9,X10); \
CAMLxparam3(X11,X12,X13) CAMLxparam3(X11,X12,X13)
static struct custom_operations default_custom_ops = { static struct custom_operations default_custom_ops = {
@ -68,51 +68,86 @@ static struct custom_operations default_custom_ops = {
CAMLprim DLL_PUBLIC value n_context_of_ ## X(value v) { \ CAMLprim DLL_PUBLIC value n_context_of_ ## X(value v) { \
CAMLparam1(v); \ CAMLparam1(v); \
CAMLlocal1(result); \ CAMLlocal1(result); \
Z3_context_plus cp; \
Z3_ ## X ## _plus * p = (Z3_ ## X ## _plus *) Data_custom_val(v); \ Z3_ ## X ## _plus * p = (Z3_ ## X ## _plus *) Data_custom_val(v); \
cp = p->cp; \
result = caml_alloc_custom(&Z3_context_plus_custom_ops, sizeof(Z3_context_plus), 0, 1); \ result = caml_alloc_custom(&Z3_context_plus_custom_ops, sizeof(Z3_context_plus), 0, 1); \
*(Z3_context_plus*)Data_custom_val(result) = *p->cp; \ *(Z3_context_plus *)Data_custom_val(result) = cp; \
/* We increment the usage counter of the context, as we just \
created a second custom block holding that context */ \
cp->obj_count++; \
CAMLreturn(result); \ CAMLreturn(result); \
} \
\
CAMLprim value DLL_PUBLIC n_is_null_ ## X (value v) { \
CAMLparam1(v); \
Z3_ ## X ## _plus* pp = (Z3_ ## X ## _plus*)Data_custom_val(v); \
CAMLreturn(Val_bool(pp->p == NULL)); \
} \
\
CAMLprim value DLL_PUBLIC n_mk_null_ ## X (value v) { \
CAMLparam1(v); \
CAMLlocal1(result); \
Z3_context_plus cp = *(Z3_context_plus*)(Data_custom_val(v)); \
Z3_ ## X ## _plus a = Z3_ ## X ## _plus_mk(cp, NULL); \
result = caml_alloc_custom(&Z3_ ## X ## _plus_custom_ops, sizeof(Z3_ ## X ## _plus), 0, 1); \
*(Z3_ ## X ## _plus*)(Data_custom_val(result)) = a; \
CAMLreturn(result); \
} }
/* Context objects */ /* Context objects */
/* The Z3context_plus_data exists exactly once for each context,
no matter how many custom blocks for that context exist.
Each custom block only stores a pointer to the corresponding
Z3_context_plus_data. This ensures that the reference counting
is performed at exactly one place and not within the custom
blocks that get copied. */
typedef struct { typedef struct {
Z3_context ctx; Z3_context ctx;
unsigned long obj_count:sizeof(unsigned long)-1; unsigned long obj_count;
unsigned ok_to_delete:1; } Z3_context_plus_data;
} Z3_context_plus;
/* A context is wrapped to an OCaml value by storing a pointer
to its associated Z3_context_plus_data instance.
This instance gets created in mk_context and is deleted
together with the Z3 context instance in try_to_delete_context
whenever the obj_count field is zero. */
typedef Z3_context_plus_data* Z3_context_plus;
Z3_context_plus Z3_context_plus_mk(Z3_context c) { Z3_context_plus Z3_context_plus_mk(Z3_context c) {
Z3_context_plus r; Z3_context_plus r = (Z3_context_plus)malloc(sizeof(Z3_context_plus_data));
r.ctx = c; r->ctx = c;
r.obj_count = 0; /* The context created here will be wrapped into a custom block.
r.ok_to_delete = 0; We regard custom blocks that point to a Z3_context_plus structure
/* printf("ctx++ %p\n", c); */ as a usage of this structure. Hence, we assign it a counter of one. */
r->obj_count = 1;
return r; return r;
} }
Z3_context Z3_context_plus_raw(Z3_context_plus * cp) { Z3_context Z3_context_plus_raw(Z3_context_plus * cp) {
return cp->ctx; return (*cp)->ctx;
} }
void try_to_delete_context(Z3_context_plus * cp) { inline void try_to_delete_context(Z3_context_plus cp) {
if (!cp->ok_to_delete || cp->obj_count != 0) if (cp->obj_count == 0) {
/* printf("Trying to delete context %p.\n", cp->ctx) */ ; /* printf("try_to_delete_context: Deleting context %p(%p) with cnt=0.\n", cp, cp->ctx); */
else {
/* printf("Actually deleting context %p.\n", cp->ctx); */
Z3_del_context(cp->ctx); Z3_del_context(cp->ctx);
cp->ctx = 0; free(cp);
cp->obj_count = 0;
cp->ok_to_delete = 0;
} }
/*
else if (cp->obj_count > 0)
printf("try_to_delete_context: Not deleting context %p(%p) with cnt=%lu.\n", cp, cp->ctx, cp->obj_count);
else if (cp->obj_count < 0)
printf("try_to_delete_context: ERROR, found context %p(%p) with negative cnt=%lu.\n", cp, cp->ctx, cp->obj_count);
*/
} }
void Z3_context_finalize(value v) { void Z3_context_finalize(value v) {
Z3_context_plus * cp = (Z3_context_plus*)Data_custom_val(v); Z3_context_plus cp = *(Z3_context_plus*)Data_custom_val(v);
/* printf("ctx--; cnt=%lu\n", cp->obj_count); */ cp->obj_count--;
cp->ok_to_delete = 1; try_to_delete_context(cp);
try_to_delete_context(cp);
} }
static struct custom_operations Z3_context_plus_custom_ops = { static struct custom_operations Z3_context_plus_custom_ops = {
@ -129,28 +164,30 @@ static struct custom_operations Z3_context_plus_custom_ops = {
/* AST objects */ /* AST objects */
typedef struct { typedef struct {
Z3_context_plus * cp; Z3_context_plus cp;
Z3_ast a; Z3_ast p;
} Z3_ast_plus; } Z3_ast_plus;
Z3_ast_plus Z3_ast_plus_mk(Z3_context_plus * cp, Z3_ast a) { Z3_ast_plus Z3_ast_plus_mk(Z3_context_plus cp, Z3_ast p) {
Z3_ast_plus r; Z3_ast_plus r;
r.cp = cp; r.cp = cp;
r.a = a; r.p = p;
/* printf("++\n"); */ /* printf("++\n"); */
cp->obj_count++; cp->obj_count++;
Z3_inc_ref(cp->ctx, a); if (p != NULL)
Z3_inc_ref(cp->ctx, p);
return r; return r;
} }
Z3_ast Z3_ast_plus_raw(Z3_ast_plus * ap) { Z3_ast Z3_ast_plus_raw(Z3_ast_plus * ap) {
return ap->a; return ap->p;
} }
void Z3_ast_finalize(value v) { void Z3_ast_finalize(value v) {
/* printf("--\n"); */ /* printf("--\n"); */
Z3_ast_plus * ap = (Z3_ast_plus*)(Data_custom_val(v)); Z3_ast_plus * ap = (Z3_ast_plus*)(Data_custom_val(v));
Z3_dec_ref(ap->cp->ctx, ap->a); if (ap->p != NULL)
Z3_dec_ref(ap->cp->ctx, ap->p);
ap->cp->obj_count--; ap->cp->obj_count--;
try_to_delete_context(ap->cp); try_to_delete_context(ap->cp);
} }
@ -159,8 +196,14 @@ int Z3_ast_compare(value v1, value v2) {
Z3_ast_plus * a1 = (Z3_ast_plus*)Data_custom_val(v1); Z3_ast_plus * a1 = (Z3_ast_plus*)Data_custom_val(v1);
Z3_ast_plus * a2 = (Z3_ast_plus*)Data_custom_val(v2); Z3_ast_plus * a2 = (Z3_ast_plus*)Data_custom_val(v2);
assert(a1->cp->ctx == a2->cp->ctx); assert(a1->cp->ctx == a2->cp->ctx);
unsigned id1 = Z3_get_ast_id(a1->cp->ctx, a1->a); if (a1->p == NULL && a2->p == NULL)
unsigned id2 = Z3_get_ast_id(a2->cp->ctx, a2->a); return 0;
if (a1->p == NULL)
return -1;
if (a2->p == NULL)
return +1;
unsigned id1 = Z3_get_ast_id(a1->cp->ctx, a1->p);
unsigned id2 = Z3_get_ast_id(a2->cp->ctx, a2->p);
if (id1 == id2) if (id1 == id2)
return 0; return 0;
else if (id1 < id2) else if (id1 < id2)
@ -171,8 +214,15 @@ int Z3_ast_compare(value v1, value v2) {
int Z3_ast_compare_ext(value v1, value v2) { int Z3_ast_compare_ext(value v1, value v2) {
Z3_ast_plus * a1 = (Z3_ast_plus*)Data_custom_val(v1); Z3_ast_plus * a1 = (Z3_ast_plus*)Data_custom_val(v1);
unsigned id1 = Z3_get_ast_id(a1->cp->ctx, a1->a); unsigned id1;
int id2 = Val_int(v2); int id2 = Val_int(v2);
if (a1->p == NULL && id2 == 0)
return 0;
if (a1->p == NULL)
return -1;
if (id2 == 0)
return +1;
id1 = Z3_get_ast_id(a1->cp->ctx, a1->p);
if (id1 == id2) if (id1 == id2)
return 0; return 0;
else if (id1 < id2) else if (id1 < id2)
@ -183,7 +233,10 @@ int Z3_ast_compare_ext(value v1, value v2) {
intnat Z3_ast_hash(value v) { intnat Z3_ast_hash(value v) {
Z3_ast_plus * ap = (Z3_ast_plus*)Data_custom_val(v); Z3_ast_plus * ap = (Z3_ast_plus*)Data_custom_val(v);
return Z3_get_ast_hash(ap->cp->ctx, ap->a); if (ap->p == NULL)
return 0;
else
return Z3_get_ast_hash(ap->cp->ctx, ap->p);
} }
static struct custom_operations Z3_ast_plus_custom_ops = { static struct custom_operations Z3_ast_plus_custom_ops = {
@ -198,16 +251,13 @@ static struct custom_operations Z3_ast_plus_custom_ops = {
MK_CTX_OF(ast) MK_CTX_OF(ast)
#define MK_PLUS_OBJ_NO_REF(X) \ #define MK_PLUS_OBJ_NO_REF(X) \
typedef struct { \ typedef struct { \
Z3_context_plus * cp; \ Z3_context_plus cp; \
Z3_ ## X p; \ Z3_ ## X p; \
} Z3_ ## X ## _plus; \ } Z3_ ## X ## _plus; \
\ \
Z3_ ## X ## _plus Z3_ ## X ## _plus_mk(Z3_context_plus * cp, Z3_ ## X p) { \ Z3_ ## X ## _plus Z3_ ## X ## _plus_mk(Z3_context_plus cp, Z3_ ## X p) { \
Z3_ ## X ## _plus r; \ Z3_ ## X ## _plus r; \
r.cp = cp; \ r.cp = cp; \
r.p = p; \ r.p = p; \
@ -224,7 +274,7 @@ MK_CTX_OF(ast)
pp->cp->obj_count--; \ pp->cp->obj_count--; \
try_to_delete_context(pp->cp); \ try_to_delete_context(pp->cp); \
} \ } \
\ \
static struct custom_operations Z3_ ## X ## _plus_custom_ops = { \ static struct custom_operations Z3_ ## X ## _plus_custom_ops = { \
(char*) "Z3_" #X " ops", \ (char*) "Z3_" #X " ops", \
Z3_ ## X ## _finalize, \ Z3_ ## X ## _finalize, \
@ -239,16 +289,17 @@ MK_CTX_OF(ast)
#define MK_PLUS_OBJ(X) \ #define MK_PLUS_OBJ(X) \
typedef struct { \ typedef struct { \
Z3_context_plus * cp; \ Z3_context_plus cp; \
Z3_ ## X p; \ Z3_ ## X p; \
} Z3_ ## X ## _plus; \ } Z3_ ## X ## _plus; \
\ \
Z3_ ## X ## _plus Z3_ ## X ## _plus_mk(Z3_context_plus * cp, Z3_ ## X p) { \ Z3_ ## X ## _plus Z3_ ## X ## _plus_mk(Z3_context_plus cp, Z3_ ## X p) { \
Z3_ ## X ## _plus r; \ Z3_ ## X ## _plus r; \
r.cp = cp; \ r.cp = cp; \
r.p = p; \ r.p = p; \
r.cp->obj_count++; \ r.cp->obj_count++; \
Z3_ ## X ## _inc_ref(cp->ctx, p); \ if (p != NULL) \
Z3_ ## X ## _inc_ref(cp->ctx, p); \
return r; \ return r; \
} \ } \
\ \
@ -258,7 +309,8 @@ MK_CTX_OF(ast)
\ \
void Z3_ ## X ## _finalize(value v) { \ void Z3_ ## X ## _finalize(value v) { \
Z3_ ## X ## _plus * pp = (Z3_ ## X ## _plus*)Data_custom_val(v); \ Z3_ ## X ## _plus * pp = (Z3_ ## X ## _plus*)Data_custom_val(v); \
Z3_ ## X ## _dec_ref(pp->cp->ctx, pp->p); \ if (pp->p != NULL) \
Z3_ ## X ## _dec_ref(pp->cp->ctx, pp->p); \
pp->cp->obj_count--; \ pp->cp->obj_count--; \
try_to_delete_context(pp->cp); \ try_to_delete_context(pp->cp); \
} \ } \
@ -275,8 +327,6 @@ MK_CTX_OF(ast)
\ \
MK_CTX_OF(X) MK_CTX_OF(X)
MK_PLUS_OBJ_NO_REF(symbol) MK_PLUS_OBJ_NO_REF(symbol)
MK_PLUS_OBJ_NO_REF(constructor) MK_PLUS_OBJ_NO_REF(constructor)
MK_PLUS_OBJ_NO_REF(constructor_list) MK_PLUS_OBJ_NO_REF(constructor_list)
@ -302,19 +352,6 @@ MK_PLUS_OBJ(optimize)
extern "C" { extern "C" {
#endif #endif
CAMLprim DLL_PUBLIC value n_is_null(value p) {
void * t = * (void**) Data_custom_val(p);
return Val_bool(t == 0);
}
CAMLprim DLL_PUBLIC value n_mk_null( void ) {
CAMLparam0();
CAMLlocal1(result);
result = caml_alloc(1, 0);
result = Val_int(0);
CAMLreturn (result);
}
void MLErrorHandler(Z3_context c, Z3_error_code e) void MLErrorHandler(Z3_context c, Z3_error_code e)
{ {
/* Internal do-nothing error handler. This is required to avoid that Z3 calls exit() /* Internal do-nothing error handler. This is required to avoid that Z3 calls exit()