C++ String_val函数代码示例

PREFIX value ml_elm_fileselector_selected_set(value v_obj, value v_path)
{
        return Val_Eina_Bool(elm_fileselector_selected_set((Evas_Object*) v_obj,
                String_val(v_path)));
}

static DWORD WINAPI gr_open_graph_internal(value arg)
{
  RECT rc;
  int ret;
  int event;
  int x, y, w, h;
  int screenx,screeny;
  int attributes;
  static int registered;
  MSG msg;

  gr_initialized = TRUE;
  hInst = GetModuleHandle(NULL);
  x = y = w = h = CW_USEDEFAULT;
  sscanf(String_val(arg), "%dx%d+%d+%d", &w, &h, &x, &y);

  /* Open the display */
  if (grwindow.hwnd == NULL || !IsWindow(grwindow.hwnd)) {
    if (!registered) {
      registered = DoRegisterClass();
      if (!registered) {
        open_graph_errmsg = "Cannot register the window class";
        SetEvent(open_graph_event);
        return 1;
      }
    }
    grwindow.hwnd = CreateWindow(szOcamlWindowClass,
                                 WINDOW_NAME,
                                 WS_OVERLAPPEDWINDOW,
                                 x,y,
                                 w,h,
                                 NULL,0,hInst,NULL);
    if (grwindow.hwnd == NULL) {
      open_graph_errmsg = "Cannot create window";
      SetEvent(open_graph_event);
      return 1;
    }
#if 0
    if (x != CW_USEDEFAULT) {
      rc.left = 0;
      rc.top = 0;
      rc.right = w;
      rc.bottom = h;
      AdjustWindowRect(&rc,GetWindowLong(grwindow.hwnd,GWL_STYLE),0);
      MoveWindow(grwindow.hwnd,x,y,rc.right-rc.left,rc.bottom-rc.top,1);
    }
#endif
  }
  gr_reset();
  ShowWindow(grwindow.hwnd,SW_SHOWNORMAL);
  
  /* Position the current point at origin */
  grwindow.grx = 0;
  grwindow.gry = 0;
  
  caml_gr_init_event_queue();

  /* The global data structures are now correctly initialized.
     Restart the Caml main thread. */
  open_graph_errmsg = NULL;
  SetEvent(open_graph_event);

  /* Enter the message handling loop */
  while (GetMessage(&msg,NULL,0,0)) {
    TranslateMessage(&msg);  // Translates virtual key codes
    DispatchMessage(&msg);   // Dispatches message to window
    if (!IsWindow(grwindow.hwnd))
      break;
  }
  return 0;
}

CAMLprim value caml_extunix_recvmsg2(value vfd, value vbuf, value ofs, value vlen,
  value vflags)
{
  CAMLparam4(vfd, vbuf, ofs, vlen);
  CAMLlocal5(vres, vlist, v, vx, vsaddr);
  union {
    struct cmsghdr hdr;
    char buf[CMSG_SPACE(sizeof(int)) /* File descriptor passing */
#ifdef EXTUNIX_HAVE_IP_RECVIF
        + CMSG_SPACE(sizeof(struct sockaddr_dl)) /* IP_RECVIF */
#endif
#ifdef EXTUNIX_HAVE_IP_RECVDSTADDR
        + CMSG_SPACE(sizeof(struct in_addr))     /* IP_RECVDSTADDR */
#endif
    ];
  } cmsgbuf;
  struct iovec             iov;
  struct msghdr            msg;
  struct cmsghdr          *cmsg;
  ssize_t                  n;
  size_t                   len;
  char                     iobuf[UNIX_BUFFER_SIZE];
  struct sockaddr_storage  ss;
  int                      sendflags;
#ifdef EXTUNIX_HAVE_IP_RECVIF
  struct sockaddr_dl      *dst = NULL;
#endif

  len = Long_val(vlen);

  memset(&iov, 0, sizeof(iov));
  memset(&msg, 0, sizeof(msg));

  if (len > UNIX_BUFFER_SIZE)
    len = UNIX_BUFFER_SIZE;

  iov.iov_base = iobuf;
  iov.iov_len = len;
  msg.msg_name = &ss;
  msg.msg_namelen = sizeof(ss);
  msg.msg_iov = &iov;
  msg.msg_iovlen = 1;
  msg.msg_control = &cmsgbuf.buf;
  msg.msg_controllen = sizeof(cmsgbuf.buf);
  sendflags = caml_convert_flag_list(vflags, msg_flag_table);

  caml_enter_blocking_section();
  n = recvmsg(Int_val(vfd), &msg, sendflags);
  caml_leave_blocking_section();

  vres = caml_alloc_small(4, 0);

  if (n == -1) {
    uerror("recvmsg", Nothing);
    CAMLreturn (vres);
  }

  vsaddr = my_alloc_sockaddr(&ss);

  memmove(&Byte(vbuf, Long_val(ofs)), iobuf, n);

  vlist = Val_int(0);

  /* Build the variant list vlist */
  for (cmsg = CMSG_FIRSTHDR(&msg); cmsg != NULL;
       cmsg = CMSG_NXTHDR(&msg, cmsg)) {
    if (cmsg->cmsg_level == SOL_SOCKET &&
        cmsg->cmsg_type == SCM_RIGHTS) {
      /* CMSG_DATA is aligned, so the following is cool */
      v = caml_alloc_small(2, TAG_FILEDESCRIPTOR);
      Field(v, 0) = Val_int(*(int *)CMSG_DATA(cmsg));
      Field(v, 1) = vlist;
      vlist = v;
      continue;
    }

#ifdef EXTUNIX_HAVE_IP_RECVIF
    if (cmsg->cmsg_level == IPPROTO_IP &&
        cmsg->cmsg_type == IP_RECVIF) {
      dst = (struct sockaddr_dl *)CMSG_DATA(cmsg);
      v = caml_alloc_small(2, 0);
      vx = caml_alloc_small(1, TAG_IP_RECVIF);
      Field(vx, 0) = Val_int(dst->sdl_index);
      Field(v, 0) = vx;
      Field(v, 1) = vlist;
      vlist = v;
      continue;
    }
#endif
#ifdef EXTUNIX_HAVE_IP_RECVDSTADDR
    if (cmsg->cmsg_level == IPPROTO_IP &&
        cmsg->cmsg_type == IP_RECVDSTADDR) {
      struct in_addr ipdst;
      ipdst = *(struct in_addr *)CMSG_DATA(cmsg);
      v = caml_alloc_small(2, 0);
      vx = caml_alloc_small(1, TAG_IP_RECVDSTADDR);
      Field(vx, 0) = caml_alloc_string(4);
      memcpy(String_val(Field(vx, 0)), &ipdst, 4);
      Field(v, 0) = vx;
      Field(v, 1) = vlist;
//.........这里部分代码省略.........

void hh_load(value in_filename) {
  CAMLparam1(in_filename);
  FILE* fp = fopen(String_val(in_filename), "rb");

  if (fp == NULL) {
    caml_failwith("Failed to open file");
  }

  uint64_t magic = 0;
  read_all(fileno(fp), (void*)&magic, sizeof magic);
  assert(magic == MAGIC_CONSTANT);

  size_t revlen = 0;
  read_all(fileno(fp), (void*)&revlen, sizeof revlen);
  char revision[revlen];
  read_all(fileno(fp), (void*)revision, revlen * sizeof(char));
  assert(strncmp(revision, BuildInfo_kRevision, revlen) == 0);

  read_all(fileno(fp), (void*)&heap_init_size, sizeof heap_init_size);

  int compressed_size = 0;
  read_all(fileno(fp), (void*)&compressed_size, sizeof compressed_size);
  char* chunk_start = save_start();

  pthread_attr_t attr;
  pthread_attr_init(&attr);
  pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE);
  pthread_t thread;
  decompress_args args;
  int thread_started = 0;

  // see hh_save for a description of what we are parsing here.
  while (compressed_size > 0) {
    char* compressed = malloc(compressed_size * sizeof(char));
    assert(compressed != NULL);
    uintptr_t chunk_size = 0;
    read_all(fileno(fp), (void*)&chunk_size, sizeof chunk_size);
    read_all(fileno(fp), compressed, compressed_size * sizeof(char));
    if (thread_started) {
      intptr_t success = 0;
      int rc = pthread_join(thread, (void*)&success);
      free(args.compressed);
      assert(rc == 0);
      assert(success);
    }
    args.compressed = compressed;
    args.compressed_size = compressed_size;
    args.decompress_start = chunk_start;
    args.decompressed_size = chunk_size;
    pthread_create(&thread, &attr, (void* (*)(void*))decompress, &args);
    thread_started = 1;
    chunk_start += chunk_size;
    read_all(fileno(fp), (void*)&compressed_size, sizeof compressed_size);
  }

  if (thread_started) {
    int success;
    int rc = pthread_join(thread, (void*)&success);
    free(args.compressed);
    assert(rc == 0);
    assert(success);
  }

  fclose(fp);
  CAMLreturn0;
}

static unsigned long get_hash(value key) {
  return *((unsigned long*)String_val(key));
}

CAMLextern_C value
caml_sfHttpRequest_setUri(value httpRequest, value uri)
{
    SfHttpRequest_val(httpRequest)->setUri(String_val(uri));
    return Val_unit;
}

value register_leds_cb(value cb_name) {
    leds_closure = caml_named_value(String_val(cb_name));
    return Val_unit;
}

/* string -> Target.t option */
CAMLprim value llvm_target_by_name(value Name) {
  return llvm_target_option(LLVMGetTargetFromName(String_val(Name)));
}

/* string -> DataLayout.t */
CAMLprim value llvm_datalayout_of_string(value StringRep) {
  return llvm_alloc_data_layout(LLVMCreateTargetData(String_val(StringRep)));
}

value setLeftCreatureName(str)
{
	fi.leftName = (char*)(String_val(str));
	return Val_unit;
}

value setRightCreatureName(str)
{
	fi.rightName = (char*)(String_val(str));
	return Val_unit;
}

value setRightCreatureTexture(str)
{
	char* texture = (char*)(String_val(str));
	sfSprite_SetImage(fi.rightCreature, TexturesManager_getTexture(game.texturesManager, texture));
	return Val_unit;
}

/* Executes a pattern match with runtime options, a regular expression, a
   string offset, a string length, a subject string, a number of subgroup
   offsets, an offset vector and an optional callout function */
CAMLprim value pcre_exec_stub(value v_opt, value v_rex, value v_ofs,
                              value v_subj, value v_subgroups2, value v_ovec,
                              value v_maybe_cof)
{
  const int ofs = Int_val(v_ofs), len = caml_string_length(v_subj);

  if (ofs > len || ofs < 0)
    caml_invalid_argument("Pcre.pcre_exec_stub: illegal offset");

  {
    const pcre *code = (pcre *) Field(v_rex, 1);  /* Compiled pattern */
    const pcre_extra *extra = (pcre_extra *) Field(v_rex, 2);  /* Extra info */
    const char *ocaml_subj = String_val(v_subj);  /* Subject string */
    const int opt = Int_val(v_opt);  /* Runtime options */
    int subgroups2 = Int_val(v_subgroups2);
    const int subgroups2_1 = subgroups2 - 1;
    const int subgroups3 = (subgroups2 >> 1) + subgroups2;

    /* Special case when no callout functions specified */
    if (v_maybe_cof == None) {
      int *ovec = (int *) &Field(v_ovec, 0);

      /* Performs the match */
      const int ret =
        pcre_exec(code, extra, ocaml_subj, len, ofs, opt, ovec, subgroups3);

      if (ret < 0) {
        switch(ret) {
          case PCRE_ERROR_NOMATCH : caml_raise_constant(*pcre_exc_Not_found);
          case PCRE_ERROR_PARTIAL : caml_raise_constant(*pcre_exc_Partial);
          case PCRE_ERROR_MATCHLIMIT :
            caml_raise_constant(*pcre_exc_MatchLimit);
          case PCRE_ERROR_BADPARTIAL :
            caml_raise_constant(*pcre_exc_BadPartial);
          case PCRE_ERROR_BADUTF8 : caml_raise_constant(*pcre_exc_BadUTF8);
          case PCRE_ERROR_BADUTF8_OFFSET :
            caml_raise_constant(*pcre_exc_BadUTF8Offset);
          default :
            caml_raise_with_string(*pcre_exc_InternalError, "pcre_exec_stub");
        }
      }

      else {
        const int *ovec_src = ovec + subgroups2_1;
        long int *ovec_dst = (long int *) ovec + subgroups2_1;

        /* Converts offsets from C-integers to OCaml-Integers
           This is a bit tricky, because there are 32- and 64-bit platforms
           around and OCaml chooses the larger possibility for representing
           integers when available (also in arrays) - not so the PCRE */
        while (subgroups2--) {
          *ovec_dst = Val_int(*ovec_src);
          --ovec_src; --ovec_dst;
        }
      }
    }

    /* There are callout functions */
    else {
      value v_cof = Field(v_maybe_cof, 0);
      value v_substrings;
      char *subj = caml_stat_alloc(sizeof(char) * len);
      int *ovec = caml_stat_alloc(sizeof(int) * subgroups3);
      int ret;
      struct cod cod = { (value *) NULL, (value *) NULL, (value) NULL };
      struct pcre_extra new_extra =
#ifdef PCRE_CONFIG_MATCH_LIMIT_RECURSION
        { PCRE_EXTRA_CALLOUT_DATA, NULL, 0, NULL, NULL, 0 };
#else
        { PCRE_EXTRA_CALLOUT_DATA, NULL, 0, NULL, NULL };
#endif

      memcpy(subj, ocaml_subj, len);

      Begin_roots3(v_rex, v_cof, v_substrings);
        Begin_roots2(v_subj, v_ovec);
          v_substrings = caml_alloc_small(2, 0);
        End_roots();

        Field(v_substrings, 0) = v_subj;
        Field(v_substrings, 1) = v_ovec;

        cod.v_substrings_p = &v_substrings;
        cod.v_cof_p = &v_cof;
        new_extra.callout_data = &cod;

        if (extra == NULL) {
          ret = pcre_exec(code, &new_extra, subj, len, ofs, opt, ovec,
                          subgroups3);
        }
        else {
          new_extra.flags = PCRE_EXTRA_CALLOUT_DATA | extra->flags;
          new_extra.study_data = extra->study_data;
          new_extra.match_limit = extra->match_limit;
          new_extra.tables = extra->tables;
#ifdef PCRE_CONFIG_MATCH_LIMIT_RECURSION
          new_extra.match_limit_recursion = extra->match_limit_recursion;
//.........这里部分代码省略.........

static void extern_rec(value v)
{
  struct code_fragment * cf;
  struct extern_item * sp;
  sp = extern_stack;

  while(1) {
  if (Is_long(v)) {
    intnat n = Long_val(v);
    if (n >= 0 && n < 0x40) {
      Write(PREFIX_SMALL_INT + n);
    } else if (n >= -(1 << 7) && n < (1 << 7)) {
      writecode8(CODE_INT8, n);
    } else if (n >= -(1 << 15) && n < (1 << 15)) {
      writecode16(CODE_INT16, n);
#ifdef ARCH_SIXTYFOUR
    } else if (n < -((intnat)1 << 31) || n >= ((intnat)1 << 31)) {
      writecode64(CODE_INT64, n);
#endif
    } else
      writecode32(CODE_INT32, n);
    goto next_item;
  }
  if (Is_in_value_area(v)) {
    header_t hd = Hd_val(v);
    tag_t tag = Tag_hd(hd);
    mlsize_t sz = Wosize_hd(hd);

    if (tag == Forward_tag) {
      value f = Forward_val (v);
      if (Is_block (f)
          && (!Is_in_value_area(f) || Tag_val (f) == Forward_tag
              || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag)){
        /* Do not short-circuit the pointer. */
      }else{
        v = f;
        continue;
      }
    }
    /* Atoms are treated specially for two reasons: they are not allocated
       in the externed block, and they are automatically shared. */
    if (sz == 0) {
      if (tag < 16) {
        Write(PREFIX_SMALL_BLOCK + tag);
      } else {
        writecode32(CODE_BLOCK32, hd);
      }
      goto next_item;
    }
    /* Check if already seen */
    if (Color_hd(hd) == Caml_blue) {
      uintnat d = obj_counter - (uintnat) Field(v, 0);
      if (d < 0x100) {
        writecode8(CODE_SHARED8, d);
      } else if (d < 0x10000) {
        writecode16(CODE_SHARED16, d);
      } else {
        writecode32(CODE_SHARED32, d);
      }
      goto next_item;
    }

    /* Output the contents of the object */
    switch(tag) {
    case String_tag: {
      mlsize_t len = caml_string_length(v);
      if (len < 0x20) {
        Write(PREFIX_SMALL_STRING + len);
      } else if (len < 0x100) {
        writecode8(CODE_STRING8, len);
      } else {
        writecode32(CODE_STRING32, len);
      }
      writeblock(String_val(v), len);
      size_32 += 1 + (len + 4) / 4;
      size_64 += 1 + (len + 8) / 8;
      extern_record_location(v);
      break;
    }
    case Double_tag: {
      if (sizeof(double) != 8)
        extern_invalid_argument("output_value: non-standard floats");
      Write(CODE_DOUBLE_NATIVE);
      writeblock_float8((double *) v, 1);
      size_32 += 1 + 2;
      size_64 += 1 + 1;
      extern_record_location(v);
      break;
    }
    case Double_array_tag: {
      mlsize_t nfloats;
      if (sizeof(double) != 8)
        extern_invalid_argument("output_value: non-standard floats");
      nfloats = Wosize_val(v) / Double_wosize;
      if (nfloats < 0x100) {
        writecode8(CODE_DOUBLE_ARRAY8_NATIVE, nfloats);
      } else {
        writecode32(CODE_DOUBLE_ARRAY32_NATIVE, nfloats);
      }
      writeblock_float8((double *) v, nfloats);
//.........这里部分代码省略.........

CAMLprim value caml_sys_rename(value oldname, value newname)
{
  if (rename(String_val(oldname), String_val(newname)) != 0)
    caml_sys_error(NO_ARG);
  return Val_unit;
}