CAMLprim value spoc_cublasSetMatrix (value rows, value cols, value a, value lda, value b, value ldb, value dev){ CAMLparam5(rows, cols, a, lda, b); CAMLxparam2(ldb, dev); CAMLlocal4(dev_vec_array, dev_vec, gi, bigArray); CUdeviceptr d_B; void* h_A; int type_size = sizeof(double); int tag; int id; gi = Field(dev, 0); id = Int_val(Field(gi, 7)); GET_VEC(b, d_B); GET_HOST_VEC (a, h_A); CUBLAS_GET_CONTEXT; int custom = 0; GET_TYPE_SIZE; //printf("rows : %d, col: %d, type_size : %d, lda :%d, ldb : %d\n", Int_val(rows), Int_val(cols), type_size, Int_val (lda), Int_val(ldb)); //fflush(stdout); CUBLAS_CHECK_CALL(cublasSetMatrix(Int_val(rows), Int_val(cols), type_size, h_A, Int_val(lda), (void*) d_B, Int_val(ldb))); CUBLAS_RESTORE_CONTEXT; CAMLreturn(Val_unit); }
CAMLprim value stub_xc_hvm_build_native(value xc_handle, value domid, value mem_max_mib, value mem_start_mib, value image_name, value store_evtchn, value console_evtchn) { CAMLparam5(xc_handle, domid, mem_max_mib, mem_start_mib, image_name); CAMLxparam2(store_evtchn, console_evtchn); CAMLlocal1(result); char *image_name_c = strdup(String_val(image_name)); char *error[256]; xc_interface *xch; unsigned long store_mfn=0; unsigned long console_mfn=0; int r; struct flags f; /* The xenguest interface changed and was backported to XCP: */ #if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200) struct xc_hvm_build_args args; #endif get_flags(&f, _D(domid)); xch = _H(xc_handle); configure_vcpus(xch, _D(domid), f); configure_tsc(xch, _D(domid), f); #if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200) args.mem_size = (uint64_t)Int_val(mem_max_mib) << 20; args.mem_target = (uint64_t)Int_val(mem_start_mib) << 20; args.mmio_size = f.mmio_size_mib << 20; args.image_file_name = image_name_c; #endif caml_enter_blocking_section (); #if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200) r = xc_hvm_build(xch, _D(domid), &args); #else r = xc_hvm_build_target_mem(xch, _D(domid), Int_val(mem_max_mib), Int_val(mem_start_mib), image_name_c); #endif caml_leave_blocking_section (); free(image_name_c); if (r) failwith_oss_xc(xch, "hvm_build"); r = hvm_build_set_params(xch, _D(domid), Int_val(store_evtchn), &store_mfn, Int_val(console_evtchn), &console_mfn, f); if (r) failwith_oss_xc(xch, "hvm_build_params"); result = caml_alloc_tuple(2); Store_field(result, 0, caml_copy_nativeint(store_mfn)); Store_field(result, 1, caml_copy_nativeint(console_mfn)); CAMLreturn(result); }
value f_i7_caml(value i0, value i1, value i2, value i3, value i4, value i5, value i6) { CAMLparam5(i0,i1,i2,i3,i4); CAMLxparam2(i5,i6); int ii0 = Int_val(i0); int ii1 = Int_val(i1); int ii2 = Int_val(i2); int ii3 = Int_val(i3); int ii4 = Int_val(i4); int ii5 = Int_val(i5); int ii6 = Int_val(i6); CAMLreturn(Val_int(f_i7(ii0,ii1,ii2,ii3,ii4,ii5,ii6))); }
CAMLprim value spoc_cublasCaxpy (value n, value alpha, value x, value incx, value y, value incy, value dev){ CAMLparam5(n,alpha, x,incx, y); CAMLxparam2(incy, dev); CAMLlocal3(dev_vec_array, dev_vec, gi); CUdeviceptr d_A; CUdeviceptr d_B; int id; GET_VEC(x, d_A); GET_VEC(y, d_B); CUBLAS_GET_CONTEXT; cublasCaxpy(Int_val(n), Complex_val(alpha), (cuComplex*)d_A, Int_val(incx), (cuComplex*)d_B, Int_val(incy)); CUBLAS_CHECK_CALL(cublasGetError()); CUDA_RESTORE_CONTEXT; CAMLreturn(Val_unit); }
value f_i12_caml(value i0, value i1, value i2, value i3, value i4, value i5, value i6, value i7, value i8, value i9, value i10, value i11) { CAMLparam5(i0,i1,i2,i3,i4); CAMLxparam5(i5,i6,i7,i8,i9); CAMLxparam2(i10,i11); int ii0 = Int_val(i0); int ii1 = Int_val(i1); int ii2 = Int_val(i2); int ii3 = Int_val(i3); int ii4 = Int_val(i4); int ii5 = Int_val(i5); int ii6 = Int_val(i6); int ii7 = Int_val(i7); int ii8 = Int_val(i8); int ii9 = Int_val(i9); int ii10= Int_val(i10); int ii11= Int_val(i11); CAMLreturn(Val_int(f_i12(ii0,ii1,ii2,ii3,ii4,ii5,ii6,ii7,ii8,ii9,ii10,ii11))); }
CAMLprim value spoc_cublasSrotm (value n, value x, value incx, value y, value incy, value sparam, value dev){ CAMLparam5(n,x,incx, y, incy); CAMLxparam2(sparam, dev); CAMLlocal4(dev_vec_array, dev_vec, res, gi); CUdeviceptr d_A; CUdeviceptr d_B; CUdeviceptr d_C; float result; int id; GET_VEC(x, d_A); GET_VEC(y, d_B); GET_VEC(sparam, d_C); CUBLAS_GET_CONTEXT; cublasSrotm(Int_val(n), (float*)d_A, Int_val(incx), (float*)d_B, Int_val(incy), (float*)sparam); CUBLAS_CHECK_CALL(cublasGetError()); CUBLAS_RESTORE_CONTEXT; CAMLreturn(Val_unit); }
t_value ml_glteximage2dnopixels_native ( value _target_2d, value level, value _internal_format, value width, value height, value _pixel_data_format, value _pixel_data_type) { CAMLparam5 (_target_2d, level, _internal_format, width, height); CAMLxparam2 (_pixel_data_format, _pixel_data_type); GLenum pixel_data_format = conv_pixel_data_format_table[Int_val(_pixel_data_format)]; GLenum pixel_data_type = conv_pixel_data_type_table[Int_val(_pixel_data_type)]; GLenum target_2d = conv_target_2d_table[Int_val(_target_2d)]; GLint internal_format = conv_internal_format_table[Int_val(_internal_format)]; glTexImage2D( target_2d, Int_val(level), internal_format, Int_val(width), Int_val(height), 0, pixel_data_format, pixel_data_type, NULL ); CAMLreturn (Val_unit); }
CAMLprim value ocaml_f0r_update2(value plugin, value instance, value time, value inframe1, value inframe2, value inframe3, value outframe) { CAMLparam5(plugin, instance, time, inframe1, inframe2); CAMLxparam2(inframe3, outframe); f0r_instance_t *i = Instance_val(instance); plugin_t *p = Plugin_val(plugin); double t = Double_val(time); const uint32_t *in1, *in2, *in3; uint32_t *out = Caml_ba_data_val(outframe); in1 = Is_block(inframe1)?Caml_ba_data_val(Field(inframe1,0)):NULL; in2 = Is_block(inframe2)?Caml_ba_data_val(Field(inframe2,0)):NULL; in3 = Is_block(inframe3)?Caml_ba_data_val(Field(inframe3,0)):NULL; caml_release_runtime_system(); p->update2(i, t, in1, in2, in3, out); caml_acquire_runtime_system(); CAMLreturn(Val_unit); }
CAMLprim value stub_new_client_session_native(value keys, value sid, value cipherSpec, value cert_cb, value extensions, value ext_cb, value flags) { CAMLparam5(keys, sid, cipherSpec, cert_cb, extensions); CAMLxparam2(ext_cb, flags); ssl_t *ssl; int rc; rc=matrixSslNewClientSession(&ssl, sslKeys_t_val(keys), NULL, /*sslSessionId_t_val(sid), */ Int_val(cipherSpec), certCb, NULL, NULL, 0); if(rc != MATRIXSSL_REQUEST_SEND) { fprintf(stderr,"rc=%d\n",rc); caml_failwith("New client session failed"); } CAMLreturn(alloc_ssl_t(ssl)); }
CAMLprim value spoc_cuda_launch_grid(value off, value ker, value grid, value block, value ex, value gi, value queue_id){ CAMLparam5(ker, grid, ex, block, gi); CAMLxparam2(off, queue_id); CUfunction *kernel; int gridX, gridY, gridZ, blockX, blockY, blockZ; int offset; char* extra; void* extra2[5]; offset = Int_val(Field(off, 0)); gridX = Int_val(Field(grid,0)); gridY = Int_val(Field(grid,1)); gridZ = Int_val(Field(grid,2)); blockX = Int_val(Field(block,0)); blockY = Int_val(Field(block,1)); blockZ = Int_val(Field(block,2)); CUDA_GET_CONTEXT; kernel = (CUfunction*) ker; extra = (char*)ex; extra2[0] = CU_LAUNCH_PARAM_BUFFER_POINTER; extra2[1] = extra; extra2[2] = CU_LAUNCH_PARAM_BUFFER_SIZE; extra2[3] = &offset; extra2[4] = CU_LAUNCH_PARAM_END; CUDA_CHECK_CALL(cuLaunchKernel(*kernel, gridX, gridY, gridZ, blockX, blockY, blockZ, 0, queue[Int_val(queue_id)], NULL, extra2)); Store_field(off, 0, Val_int(offset)); free(extra); CUDA_RESTORE_CONTEXT; CAMLreturn(Val_unit); }
CAMLprim value stub_xc_domain_save(value handle, value fd, value domid, value max_iters, value max_factors, value flags, value hvm) { CAMLparam5(handle, fd, domid, max_iters, max_factors); CAMLxparam2(flags, hvm); struct save_callbacks callbacks; uint32_t c_flags; uint32_t c_domid; int r; unsigned long generation_id_addr; c_flags = caml_convert_flag_list(flags, suspend_flag_list); c_domid = _D(domid); memset(&callbacks, 0, sizeof(callbacks)); callbacks.data = (void*) c_domid; callbacks.suspend = dispatch_suspend; callbacks.switch_qemu_logdirty = switch_qemu_logdirty; caml_enter_blocking_section(); generation_id_addr = xenstore_get(c_domid, GENERATION_ID_ADDRESS); r = xc_domain_save(_H(handle), Int_val(fd), c_domid, Int_val(max_iters), Int_val(max_factors), c_flags, &callbacks, Bool_val(hvm) #ifdef XENGUEST_4_2 ,generation_id_addr #endif ); caml_leave_blocking_section(); if (r) failwith_oss_xc(_H(handle), "xc_domain_save"); CAMLreturn(Val_unit); }
value sankoff_CAML_create_eltarr (value is_identity, value taxon_code, value code, value number_of_states, value ecode_bigarr, value states_bigarr, value tcm_bigarr) { CAMLparam5(is_identity,taxon_code,code,number_of_states,ecode_bigarr); CAMLxparam2(states_bigarr,tcm_bigarr); CAMLlocal1(res); int num_states; num_states = Int_val(number_of_states); int tcode = Int_val(taxon_code); int iside = Int_val(is_identity); int mycode = Int_val(code); int * cost_mat; int dimcm1, dimcm2; int * states_arrarr; int dims1, dims2; int * ecode_arr; int dim; ecode_arr = (int*) Data_bigarray_val(ecode_bigarr); dim = Bigarray_val(ecode_bigarr)->dim[0];//number of elts states_arrarr = (int*) Data_bigarray_val(states_bigarr); dims1 = Bigarray_val(states_bigarr)->dim[0]; //number of elts dims2 = Bigarray_val(states_bigarr)->dim[1]; //number of states in each elt if (dim!=dims1) failwith ("sankoff.c, size of ecode array != number of charactors"); if (dims2!= num_states) failwith ("sankoff.c, size of states array != number of states"); cost_mat = (int*) Data_bigarray_val(tcm_bigarr); dimcm1 = Bigarray_val(tcm_bigarr)->dim[0];//number of states dimcm2 = Bigarray_val(tcm_bigarr)->dim[1];//number of states if ((dimcm1!=dimcm2)||(dimcm1!=dims2)) failwith ("sankoff.c, wrong size of costmat between states"); eltarr_p neweltarr; //alloc struct elt_arr neweltarr = (eltarr_p)calloc(1,sizeof(struct elt_arr)); neweltarr->code = mycode; neweltarr->taxon_code = tcode; neweltarr->left_taxon_code = tcode; neweltarr->right_taxon_code = tcode; neweltarr->sum_cost = 0; neweltarr->num_states = dimcm1; neweltarr->num_elts = dim; neweltarr->is_identity = iside; //alloc its pointers neweltarr->tcm = (int*)calloc(dimcm1*dimcm2,sizeof(int)); memcpy(neweltarr->tcm,cost_mat,sizeof(int) * dimcm1 * dimcm2); neweltarr->elts = (elt_p)calloc(dim,sizeof(struct elt)); int i; int j; int * states_arr; elt_p newelt; for (i=0;i<dim;i++) { newelt = &((neweltarr->elts)[i]); assert(newelt!=NULL); newelt->ecode = ecode_arr[i]; newelt->num_states = num_states; newelt->states = (int*)calloc( num_states, sizeof(int) ); newelt->leftstates = (int*)calloc( num_states, sizeof(int) ); newelt->rightstates = (int*)calloc( num_states, sizeof(int) ); //for new median_3 if (median_3_su) { newelt->left_costdiff_mat = (int*)calloc(num_states*num_states,sizeof(int)); newelt->right_costdiff_mat = (int*)calloc(num_states*num_states,sizeof(int)); } states_arr = sankoff_move_to_line_i(states_arrarr,dims1,dims2,i); //the infinity on ocaml side is diff from here, so we pass -1 instead //memcpy(newelt->states,states_arr,sizeof(int)*num_states); for (j=0;j<num_states;j++) { (newelt->states)[j] = ( states_arr[j]==(-1) ) ? infinity : states_arr[j]; } newelt->beta = (int*)calloc(num_states,sizeof(int)); newelt->e = (int*)calloc(num_states,sizeof(int)); newelt->m = (int*)calloc(num_states,sizeof(int)); sankoff_canonize(newelt,cost_mat); } res = caml_alloc_custom (&sankoff_custom_operations_eltarr,sizeof (eltarr_p), 1,alloc_custom_max); Sankoff_return_eltarr(res) = neweltarr; CAMLreturn(res); }
value_t c_win32_dial ( value_t _mt, value_t _entryName, value_t phoneNumber, value_t userName, value_t password, value_t domain, value_t callback ) { char * entryName = String_val ( _entryName ); int mt = Bool_val ( _mt ); DWORD dwRet; RASDIALPARAMS rdParams; HRASCONN hRasConn; CAMLparam5 ( mt, _entryName, phoneNumber, userName, password ); CAMLxparam2 ( domain, callback ); printf ( "Callback passed = 0x%08x, deref = 0x%08x\n", (unsigned) callback, (unsigned)(*(void **)callback) ); fflush ( stdout ); hRasConn = NULL; rdParams.dwSize = sizeof(RASDIALPARAMS); lstrcpy(rdParams.szEntryName, entryName ); lstrcpy(rdParams.szPhoneNumber, String_val ( phoneNumber ) ); lstrcpy(rdParams.szCallbackNumber, "" ); lstrcpy(rdParams.szUserName, String_val ( userName ) ); lstrcpy(rdParams.szPassword, String_val ( password ) ); lstrcpy(rdParams.szDomain, String_val ( domain ) ); cb_info.g_status = 0; cb_info.mt = mt; cb_info.p_closure = &callback; cb_info.entryName = entryName; textout ( mtINFO, "Dialing %s", entryName ); if (debug_print) printf ( "I am inside c_win32_dial!\n" ); if ( mt ) enter_blocking_section (); dwRet = RasDial ( NULL, NULL, &rdParams, 1L, (RASDIALFUNC) RasDialFunc1, &hRasConn ); if ( mt ) leave_blocking_section (); if ( dwRet ) { char szBuf[256]; if ( RasGetErrorString( dwRet, szBuf, 256 ) != 0 ) wsprintf( (LPSTR)szBuf, "Undefined RAS Dial Error (%ld).", dwRet ); textout ( mtERR, "Error attempting to connect: %s", szBuf ); hangup ( hRasConn ); } CAMLreturn (Val_bool ( 1 )); return 0; /* dummy, to shut down warning */ }