自学教程：C++ stat_free函数代码示例

CAMLprim value camltk_setvar(value var, value contents){  char *s;  char *stable_var = NULL;  char *utf_contents;  CheckInit();  /* SetVar makes a copy of the contents. */  /* In case we have write traces in OCaml, it's better to make sure that     var doesn't move... */  stable_var = string_to_c(var);  utf_contents = caml_string_to_tcl(contents);  s = (char *)Tcl_SetVar(cltclinterp,stable_var, utf_contents,                         TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);  stat_free(stable_var);  if( s == utf_contents ){    tk_error("camltk_setvar: Tcl_SetVar returned strange result. Call the author of mlTk!");  }  stat_free(utf_contents);  if (s == NULL)    tk_error(Tcl_GetStringResult(cltclinterp));  else     return(Val_unit);}

static DWORD WINAPI caml_thread_start(void * arg){  caml_thread_t th = (caml_thread_t) arg;  value clos;  /* Associate the thread descriptor with the thread */  TlsSetValue(thread_descriptor_key, (void *) th);  TlsSetValue(last_channel_locked_key, NULL);  /* Acquire the global mutex and set up the stack variables */  leave_blocking_section();  /* Callback the closure */  clos = Start_closure(th->descr);  modify(&(Start_closure(th->descr)), Val_unit);  callback_exn(clos, Val_unit);  /* Remove th from the doubly-linked list of threads */  th->next->prev = th->prev;  th->prev->next = th->next;  /* Release the main mutex (forever) */  ReleaseMutex(caml_mutex);#ifndef NATIVE_CODE  /* Free the memory resources */  stat_free(th->stack_low);  if (th->backtrace_buffer != NULL) free(th->backtrace_buffer);#endif  /* Free the thread descriptor */  stat_free(th);  /* The thread now stops running */  return 0;}

value string_mlval(value val){  value s;  byteoffset_t res;  extern_size = INITIAL_EXTERN_SIZE;  extern_block =    (byteoffset_t *) stat_alloc(extern_size * sizeof(unsigned long));  extern_pos = 0;  extern_table_size = INITIAL_EXTERN_TABLE_SIZE;  alloc_extern_table();  extern_table_used = 0;  res = emit_all(val);  stat_free((char *) extern_table);  /* We can allocate a string in the heap since the argument value is     not used from now on. */  if (extern_pos == 0)    {      s = alloc_string(8);      ((size_t *)s)[0] = (size_t)extern_pos;      ((size_t *)s)[1] = (size_t)res;    }  else    {      s = alloc_string(4 + extern_pos * sizeof(unsigned long));      ((size_t *)s)[0] = (size_t)extern_pos;      memmove(&Byte(s, 4), (char *)extern_block, extern_pos * sizeof(unsigned long));    }  stat_free((char *) extern_block);  return s;}

/* ML type: fddvar vector -> fddvar vector -> pairSet */EXTERNML value mlfdd_setpairs(value oldvar, value newvar) /* ML */{  int size, i, *o, *n;  bddPair *pairs;  value result;  size = Wosize_val(oldvar);  /* we use stat_alloc which guarantee that we get the memory (or it     will raise an exception). */  o    = (int *) stat_alloc(sizeof(int) * size);  n    = (int *) stat_alloc(sizeof(int) * size);  for (i=0; i<size; i++) {     o[i] = Int_val(Field(oldvar, i));     n[i] = Int_val(Field(newvar, i));  }  pairs = bdd_newpair();  fdd_setpairs(pairs, o, n, size);  /* memory allocated with stat_alloc, should be freed with     stat_free.*/  stat_free((char *) o);  stat_free((char *) n);  result = mlbdd_alloc_final(2, &mlbdd_pair_finalize);  PairSet_val(result) = pairs;  return result;}

static void mlbdd_freegcstrings() {  if(printgc) {    stat_free(pregc);    stat_free(postgc);    printgc = 0;  }}

/* Fill a preallocated vector arguments, doing expansion and all. * Assumes Tcl will *  not tamper with our strings *  make copies if strings are "persistent" */int fill_args (char **argv, int where, value v){  value l;  switch (Tag_val(v)) {  case 0:    argv[where] = caml_string_to_tcl(Field(v,0)); /* must free by stat_free */    return (where + 1);  case 1:    for (l=Field(v,0); Is_block(l); l=Field(l,1))      where = fill_args(argv,where,Field(l,0));    return where;  case 2:    { char **tmpargv;      char *merged;      int i;      int size = argv_size(Field(v,0));      tmpargv = (char **)stat_alloc((size + 1) * sizeof(char *));      fill_args(tmpargv,0,Field(v,0));      tmpargv[size] = NULL;      merged = Tcl_Merge(size,tmpargv);      for(i = 0; i<size; i++){ stat_free(tmpargv[i]); }      stat_free((char *)tmpargv);      /* must be freed by stat_free */      argv[where] = (char*)stat_alloc(strlen(merged)+1);      strcpy(argv[where], merged);      Tcl_Free(merged);      return (where + 1);    }  default:    tk_error("fill_args: illegal tag");  }}

CAMLprim value caml_thread_new(value clos){  caml_thread_t th;  value vthread = Val_unit;  value descr;  DWORD th_id;  Begin_roots2 (clos, vthread)    /* Create a finalized value to hold thread handle */    vthread = alloc_final(sizeof(struct caml_thread_handle) / sizeof(value),                          caml_thread_finalize, 1, 1000);    ((struct caml_thread_handle *)vthread)->handle = NULL;    /* Create a descriptor for the new thread */    descr = alloc_tuple(sizeof(struct caml_thread_descr) / sizeof(value));    Ident(descr) = Val_long(thread_next_ident);    Start_closure(descr) = clos;    Threadhandle(descr) = (struct caml_thread_handle *) vthread;    thread_next_ident++;    /* Create an info block for the current thread */    th = (caml_thread_t) stat_alloc(sizeof(struct caml_thread_struct));    th->descr = descr;#ifdef NATIVE_CODE    th->bottom_of_stack = NULL;    th->exception_pointer = NULL;    th->local_roots = NULL;#else    /* Allocate the stacks */    th->stack_low = (value *) stat_alloc(Thread_stack_size);    th->stack_high = th->stack_low + Thread_stack_size / sizeof(value);    th->stack_threshold = th->stack_low + Stack_threshold / sizeof(value);    th->sp = th->stack_high;    th->trapsp = th->stack_high;    th->local_roots = NULL;    th->external_raise = NULL;    th->backtrace_pos = 0;    th->backtrace_buffer = NULL;    th->backtrace_last_exn = Val_unit;#endif    /* Add thread info block to the list of threads */    th->next = curr_thread->next;    th->prev = curr_thread;    curr_thread->next->prev = th;    curr_thread->next = th;    /* Fork the new thread */    th->wthread =      CreateThread(NULL, 0, caml_thread_start, (void *) th, 0, &th_id);    if (th->wthread == NULL) {      /* Fork failed, remove thread info block from list of threads */      th->next->prev = curr_thread;      curr_thread->next = th->next;#ifndef NATIVE_CODE      stat_free(th->stack_low);#endif      stat_free(th);      caml_wthread_error("Thread.create");    }    ((struct caml_thread_handle *)vthread)->handle = th->wthread;  End_roots();  return descr;}

void set_minor_heap_size (size_t size){  char *new_heap;  value **new_table;  assert (size >= Minor_heap_min);  assert (size <= Minor_heap_max);  assert (size % sizeof (value) == 0);  if (young_ptr != young_start) minor_collection ();  assert (young_ptr == young_start);  new_heap = (char *) stat_alloc (size);  if (young_start != NULL){    stat_free ((char *) young_start);  }  young_start = new_heap;  young_end = new_heap + size;  young_ptr = young_start;  minor_heap_size = size;  ref_table_size = minor_heap_size / sizeof (value) / 8;  ref_table_reserve = 256;  new_table = (value **) stat_alloc ((ref_table_size + ref_table_reserve)				     * sizeof (value *));  if (ref_table != NULL) stat_free ((char *) ref_table);  ref_table = new_table;  ref_table_ptr = ref_table;  ref_table_threshold = ref_table + ref_table_size;  ref_table_limit = ref_table_threshold;  ref_table_end = ref_table + ref_table_size + ref_table_reserve;}

static void caml_thread_remove_info(caml_thread_t th){  if (th->next == th) all_threads = NULL; /* last Caml thread exiting */  th->next->prev = th->prev;  th->prev->next = th->next;#ifndef NATIVE_CODE  stat_free(th->stack_low);#endif  if (th->backtrace_buffer != NULL) free(th->backtrace_buffer);  stat_free(th);}

CAMLprim value ml_gsl_odeiv_free_system(value vsyst){  gsl_odeiv_system *syst = ODEIV_SYSTEM_VAL(vsyst);  struct mlgsl_odeiv_params *p = syst->params;  remove_global_root(&(p->closure));  remove_global_root(&(p->jac_closure));  remove_global_root(&(p->arr1));  remove_global_root(&(p->arr2));  remove_global_root(&(p->mat));  stat_free(p);  stat_free(syst);  return Val_unit;}

CAMLprim value unix_execve(value path, value args, value env){  char ** argv;  char ** envp;  argv = cstringvect(args);  envp = cstringvect(env);  (void) execve(String_val(path), argv, envp);  stat_free((char *) argv);  stat_free((char *) envp);  uerror("execve", path);  return Val_unit;                  /* never reached, but suppress warnings */                                /* from smart compilers */}

value caml_mpi_allgather(value sendbuf,                         value recvbuf, value recvlengths,                         value comm){  int * recvcounts, * displs;  caml_mpi_counts_displs(recvlengths, &recvcounts, &displs);  MPI_Allgatherv(String_val(sendbuf), string_length(sendbuf), MPI_BYTE,                 String_val(recvbuf), recvcounts, displs, MPI_BYTE,                 Comm_val(comm));  stat_free(recvcounts);  stat_free(displs);  return Val_unit;}

CAMLprim value unix_execvpe(value path, value args, value env){  char ** argv;  char ** saved_environ;  argv = cstringvect(args);  saved_environ = environ;  environ = cstringvect(env);  (void) execvp(String_val(path), argv);  stat_free((char *) argv);  stat_free((char *) environ);  environ = saved_environ;  uerror("execvp", path);  return Val_unit;                  /* never reached, but suppress warnings */                                /* from smart compilers */}

void realloc_stack(){  size_t size;  value * new_low, * new_high, * new_sp;  value * p;  assert(extern_sp >= stack_low);  size = stack_high - stack_low;  if (size >= Max_stack_size)    raise_out_of_memory();  size *= 2;  gc_message ("Growing stack to %ld kB./n",	      (long) size * sizeof(value) / 1024);  new_low = (value *) stat_alloc(size * sizeof(value));  new_high = new_low + size;#define shift(ptr) /    ((char *) new_high - ((char *) stack_high - (char *) (ptr)))  new_sp = (value *) shift(extern_sp);  memmove((char *)new_sp, (char *)extern_sp, (stack_high - extern_sp) * sizeof(value));  stat_free((char *) stack_low);  trapsp = (value *) shift(trapsp);  for (p = trapsp; p < new_high; p = Trap_link(p))    Trap_link(p) = (value *) shift(Trap_link(p));  stack_low = new_low;  stack_high = new_high;  stack_threshold = stack_low + Stack_threshold / sizeof (value);  extern_sp = new_sp;#undef shift}

value format_int(value fmt, value arg)      /* ML */{    char format_buffer[32];    int prec;    char * p;    char * dest;    value res;    prec = 32;    for (p = String_val(fmt); *p != 0; p++) {        if (*p >= '0' && *p <= '9') {            prec = atoi(p) + 5;            break;        }    }    if (prec <= sizeof(format_buffer)) {        dest = format_buffer;    } else {        dest = stat_alloc(prec);    }    sprintf(dest, String_val(fmt), Long_val(arg));    res = copy_string(dest);    if (dest != format_buffer) {        stat_free(dest);    }    return res;}

void caml_mpi_commit_floatarray(double * d, value data, mlsize_t len){  if (d != NULL) {    bcopy(d, (double *) data, len * sizeof(double));    stat_free(d);  }}

static void caml_thread_reinitialize(void){  caml_thread_t thr, next;  struct channel * chan;  /* Remove all other threads (now nonexistent)     from the doubly-linked list of threads */  thr = curr_thread->next;  while (thr != curr_thread) {    next = thr->next;    stat_free(thr);    thr = next;  }  curr_thread->next = curr_thread;  curr_thread->prev = curr_thread;  all_threads = curr_thread;  /* Reinitialize the master lock machinery,     just in case the fork happened while other threads were doing     leave_blocking_section */  st_masterlock_init(&caml_master_lock);  /* Tick thread is not currently running in child process, will be     re-created at next Thread.create */  caml_tick_thread_running = 0;  /* Destroy all IO mutexes; will be reinitialized on demand */  for (chan = caml_all_opened_channels;       chan != NULL;       chan = chan->next) {    if (chan->mutex != NULL) {      st_mutex_destroy(chan->mutex);      chan->mutex = NULL;    }  }}

CAMLprim value netsys_openat(value dirfd, value path, value flags, value perm){#ifdef HAVE_AT    CAMLparam4(dirfd, path, flags, perm);    int ret, cv_flags;    char * p;    /* shamelessly copied from ocaml distro */    cv_flags = convert_flag_list(flags, open_flag_table);    p = stat_alloc(string_length(path) + 1);    strcpy(p, String_val(path));    enter_blocking_section();    ret = openat(Int_val(dirfd), p, cv_flags, Int_val(perm));    leave_blocking_section();    stat_free(p);    if (ret == -1) uerror("openat", path);#if defined(NEED_CLOEXEC_EMULATION) && defined(FD_CLOEXEC)    if (convert_flag_list(flags, open_cloexec_table) != 0) {        int flags = fcntl(Int_val(dirfd), F_GETFD, 0);        if (flags == -1 || fcntl(Int_val(dirfd), F_SETFD, flags | FD_CLOEXEC) == -1)          uerror("openat", path);    }#endif    CAMLreturn (Val_int(ret));#else    invalid_argument("Netsys_posix.openat not available");#endif}

value caml_mpi_scatter(value sendbuf, value sendlengths,                        value recvbuf,                       value root, value comm){  int * sendcounts, * displs;  caml_mpi_counts_displs(sendlengths, &sendcounts, &displs);  MPI_Scatterv(String_val(sendbuf), sendcounts, displs, MPI_BYTE,               String_val(recvbuf), string_length(recvbuf), MPI_BYTE,               Int_val(root), Comm_val(comm));  if (sendcounts != NULL) {    stat_free(sendcounts);    stat_free(displs);  }  return Val_unit;}

value format_float(value fmt, value arg)    /* ML */{  char format_buffer[64];  int prec, i;  char * p;  char * dest;  value res;  prec = 64;  for (p = String_val(fmt); *p != 0; p++) {    if (*p >= '0' && *p <= '9') {      i = atoi(p) + 15;      if (i > prec) prec = i;      break;    }  }  for( ; *p != 0; p++) {    if (*p == '.') {      i = atoi(p+1) + 15;      if (i > prec) prec = i;      break;    }  }  if (prec <= sizeof(format_buffer)) {    dest = format_buffer;  } else {    dest = stat_alloc(prec);  }  sprintf(dest, String_val(fmt), Double_val(arg));  res = copy_string(dest);  if (dest != format_buffer) {    stat_free(dest);  }  return res;}

/* * Calling Tcl from Caml *   this version works on an arbitrary Tcl command, *   and does parsing and substitution */CAMLprim value camltk_tcl_eval(value str){  int code;  char *cmd = NULL;  CheckInit();  /* Tcl_Eval may write to its argument, so we take a copy   * If the evaluation raises a Caml exception, we have a space   * leak   */  Tcl_ResetResult(cltclinterp);  cmd = caml_string_to_tcl(str);  code = Tcl_Eval(cltclinterp, cmd);  stat_free(cmd);  switch (code) {  case TCL_OK:    return tcl_string_to_caml(Tcl_GetStringResult(cltclinterp));  case TCL_ERROR:    tk_error(Tcl_GetStringResult(cltclinterp));  default:  /* TCL_BREAK, TCL_CONTINUE, TCL_RETURN */    tk_error("bad tcl result");  }}

CAMLexport char * caml_search_exe_in_path(char * name){  char * fullname, * filepart;  DWORD pathlen, retcode;  pathlen = strlen(name) + 1;  if (pathlen < 256) pathlen = 256;  while (1) {    fullname = stat_alloc(pathlen);    retcode = SearchPath(NULL,              /* use system search path */			 name,			 ".exe",            /* add .exe extension if needed */			 pathlen,			 fullname,			 &filepart);    if (retcode == 0) {      caml_gc_message(0x100, "%s not found in search path/n",		      (uintnat) name);      strcpy(fullname, name);      break;    }    if (retcode < pathlen) break;    stat_free(fullname);    pathlen = retcode + 1;  }  return fullname;}

CAMLprim value ml_gsl_min_fminimizer_free(value s){  remove_global_root(&(Mparams_val(s)->closure));  stat_free(Mparams_val(s));  gsl_min_fminimizer_free(Minimizer_val(s));  return Val_unit;}

CAMLprim value ml_gdk_gc_set_dashes(value gc, value offset, value dashes){  CAMLparam3(gc, offset, dashes);  CAMLlocal1(tmp);  int l = 0;  int i;  gint8 *cdashes;  for(tmp = dashes; tmp != Val_int(0); tmp = Field(tmp,1)){    l++;  }  if( l == 0 ){ ml_raise_gdk("line dashes must have at least one element"); }  cdashes = stat_alloc(sizeof (gint8) * l);  for(i=0, tmp= dashes; i<l; i++, tmp = Field(tmp,1)){    int d;    d = Int_val(Field(tmp,0));    if( d<0 || d>255 ){      stat_free (cdashes);      ml_raise_gdk("line dashes must be [0..255]");    }    cdashes[i] = d;  }  gdk_gc_set_dashes( GdkGC_val(gc), Int_val(offset), cdashes, l);  /* stat_free (cdashes); ? */  CAMLreturn(Val_unit);}

value format_int(value fmt, value arg){	char format_buffer[32];	size_t prec;	char * p;	char * dest;	value res;	prec = 32;	for (p = String_val(fmt); *p != 0; p++) {		if (*p >= '0' && *p <= '9') {			prec = strtoul(p, NULL, 10);			break;		}	}	if (prec <= sizeof(format_buffer)) {		dest = format_buffer;	} else {		dest = stat_alloc(prec);	}	sprintf(dest, String_val(fmt), VAL_TO_LONG(arg));	res = copy_string(dest);	if (dest != format_buffer) {		stat_free(dest);	}	return res;}

value caml_mpi_gather(value sendbuf,                      value recvbuf, value recvlengths,                      value root, value comm){  int * recvcounts, * displs;  caml_mpi_counts_displs(recvlengths, &recvcounts, &displs);  MPI_Gatherv(String_val(sendbuf), string_length(sendbuf), MPI_BYTE,              String_val(recvbuf), recvcounts, displs, MPI_BYTE,              Int_val(root), Comm_val(comm));  if (recvcounts != NULL) {    stat_free(recvcounts);    stat_free(displs);  }  return Val_unit;}

value caml_mpi_cart_create(value comm, value vdims, value vperiods,                           value reorder){  int ndims = Wosize_val(vdims);  int * dims = stat_alloc(ndims * sizeof(int));  int * periods = stat_alloc(ndims * sizeof(int));  int i;  MPI_Comm newcomm;  for (i = 0; i < ndims; i++) dims[i] = Int_val(Field(vdims, i));  for (i = 0; i < ndims; i++) periods[i] = Int_val(Field(vperiods, i));  MPI_Cart_create(Comm_val(comm), ndims, dims, periods,                   Bool_val(reorder), &newcomm);  stat_free(dims);  stat_free(periods);  return caml_mpi_alloc_comm(newcomm);}

value caml_mpi_group_translate_ranks(value group1, value ranks, value group2){  int n = Wosize_val(ranks);  int * ranks1 = stat_alloc(n * sizeof(int));  int * ranks2 = stat_alloc(n * sizeof(int));  int i;  value res;  for (i = 0; i < n; i++) ranks1[i] = Int_val(Field(ranks, i));  MPI_Group_translate_ranks(Group_val(group1), n, ranks1,                            Group_val(group2), ranks2);  res = alloc(n, 0);  for (i = 0; i < n; i++) Field(res, i) = Val_int(ranks2[i]);  stat_free(ranks1);  stat_free(ranks2);  return res;}

CAMLprim value ml_gsl_monte_plain_free(value s){    remove_global_root(&(CallbackParams_val(s)->closure));    remove_global_root(&(CallbackParams_val(s)->dbl));    stat_free(CallbackParams_val(s));    gsl_monte_plain_free(GSLPLAINSTATE_VAL(s));    return Val_unit;}