Esempio n. 1
0
sexp sexp_double_to_ratio (sexp ctx, double f) {
  int sign, i;
  sexp_gc_var3(res, whole, scale);
  if (f == trunc(f))
    return sexp_bignum_normalize(sexp_double_to_bignum(ctx, f));
  sexp_gc_preserve3(ctx, res, whole, scale);
  whole = sexp_double_to_bignum(ctx, trunc(f));
  res = sexp_fixnum_to_bignum(ctx, SEXP_ZERO);
  scale = SEXP_ONE;
  sign = (f < 0 ? -1 : 1);
  for (i=0, f=fabs(f-trunc(f)); f != trunc(f) && i < 15; i++) {
    res = sexp_bignum_fxmul(ctx, NULL, res, 10, 0);
    f = f * 10;
    res = sexp_bignum_fxadd(ctx, res, double_10s_digit(f));
    f = f - trunc(f);
    scale = sexp_mul(ctx, scale, SEXP_TEN);
  }
  sexp_bignum_sign(res) = sign;
  res = sexp_bignum_normalize(res);
  scale = sexp_bignum_normalize(scale);
  res = sexp_make_ratio(ctx, res, scale);
  res = sexp_ratio_normalize(ctx, res, SEXP_FALSE);
  res = sexp_add(ctx, res, whole);
  sexp_gc_release3(ctx);
  return res;
}
Esempio n. 2
0
static sexp sexp_heap_walk (sexp ctx, int depth, int printp) {
  size_t freed;
  sexp_uint_t stats[256], hi_type=0, i;
  sexp_heap h = sexp_context_heap(ctx);
  sexp p, out=SEXP_FALSE;
  sexp_free_list q, r;
  char *end;
  sexp_gc_var3(res, tmp, name);

  if (printp)
    out = sexp_parameter_ref(ctx,
                             sexp_env_ref(ctx,
                                          sexp_context_env(ctx),
                                          sexp_global(ctx,SEXP_G_CUR_OUT_SYMBOL),
                                          SEXP_FALSE));

  /* run gc once to remove unused variables */
  sexp_gc(ctx, &freed);

  /* initialize stats */
  for (i=0; i<256; i++) stats[i]=0;

  /* loop over each heap chunk */
  for ( ; h; h=h->next) {
    p = (sexp) (h->data + sexp_heap_align(sexp_sizeof(pair)));
    q = h->free_list;
    end = (char*)h->data + h->size;
    while (((char*)p) < end) {
      /* find the preceding and succeeding free list pointers */
      for (r=q->next; r && ((char*)r<(char*)p); q=r, r=r->next)
        ;
      if ((char*)r == (char*)p) { /* this is a free block, skip */
        p = (sexp) (((char*)p) + r->size);
        continue;
      }
      /* otherwise maybe print, then increment the stat and continue */
      if (sexp_oportp(out)) {
        sexp_print_simple(ctx, p, out, depth);
        sexp_write_char(ctx, '\n', out);
      }
      stats[sexp_pointer_tag(p)]++;
      if (sexp_pointer_tag(p) > hi_type)
        hi_type = sexp_pointer_tag(p);
      p = (sexp) (((char*)p) + sexp_heap_align(sexp_allocated_bytes(ctx, p)));
    }
  }

  /* build and return results */
  sexp_gc_preserve3(ctx, res, tmp, name);
  res = SEXP_NULL;
  for (i=hi_type; i>0; i--)
    if (stats[i]) {
      name = sexp_string_to_symbol(ctx, sexp_type_name_by_index(ctx, i));
      tmp = sexp_cons(ctx, name, sexp_make_fixnum(stats[i]));
      res = sexp_cons(ctx, tmp, res);
    }
  sexp_gc_release3(ctx);
  return res;
}
Esempio n. 3
0
sexp sexp_complex_add (sexp ctx, sexp a, sexp b) {
  sexp_gc_var3(res, real, imag);
  sexp_gc_preserve3(ctx, res, real, imag);
  real = sexp_add(ctx, sexp_complex_real(a), sexp_complex_real(b));
  imag = sexp_add(ctx, sexp_complex_imag(a), sexp_complex_imag(b));
  res = sexp_make_complex(ctx, real, imag);
  sexp_gc_release3(ctx);
  return sexp_complex_normalize(res);
}
Esempio n. 4
0
sexp sexp_ratio_div (sexp ctx, sexp a, sexp b) {
  sexp_gc_var3(res, num, den);
  sexp_gc_preserve3(ctx, res, num, den);
  num = sexp_mul(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(b));
  den = sexp_mul(ctx, sexp_ratio_denominator(a), sexp_ratio_numerator(b));
  res = sexp_make_ratio(ctx, num, den);
  sexp_gc_release3(ctx);
  return sexp_ratio_normalize(ctx, res, SEXP_FALSE);
}
Esempio n. 5
0
sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char* version, const sexp_abi_identifier_t abi) {
  sexp_gc_var3(name, tmp, op);
  if (!(sexp_version_compatible(ctx, version, sexp_version)
        && sexp_abi_compatible(ctx, abi, SEXP_ABI_IDENTIFIER)))
    return SEXP_ABI_ERROR;
  sexp_gc_preserve3(ctx, name, tmp, op);
  sexp_gc_release3(ctx);
  return SEXP_VOID;
}
Esempio n. 6
0
sexp sexp_current_ntp_clock_values (sexp ctx, sexp self, sexp_sint_t n) {
  double second;
  int leap_second_indicator;
  sexp_gc_var3(res, car, cdr);
  current_ntp_clock_values (&second, &leap_second_indicator);
  sexp_gc_preserve3(ctx, res, car, cdr);
  cdr = sexp_make_boolean(leap_second_indicator);
  car = sexp_make_flonum(ctx, second);
  res = sexp_cons(ctx, car, cdr);
  sexp_gc_release3(ctx);
  return res;
}
Esempio n. 7
0
static sexp sexp_qsort_less (sexp ctx, sexp *vec,
                             sexp_sint_t lo, sexp_sint_t hi,
                             sexp less, sexp key) {
  sexp_sint_t mid, i, j;
  sexp tmp, res, args1;
  sexp_gc_var3(a, b, args2);
  sexp_gc_preserve3(ctx, a, b, args2);
  args2 = sexp_list2(ctx, SEXP_VOID, SEXP_VOID);
  args1 = sexp_cdr(args2);
 loop:
  if (lo >= hi) {
    res = SEXP_VOID;
  } else {
    mid = lo + (hi-lo)/2;
    swap(tmp, vec[mid], vec[hi]);
    if (sexp_truep(key)) {
      sexp_car(args1) = tmp;
      b = sexp_apply(ctx, key, args1);
    } else {
      b = tmp;
    }
    for (i=j=lo; i < hi; i++) {
      if (sexp_truep(key)) {
        sexp_car(args1) = vec[i];
        a = sexp_apply(ctx, key, args1);
      } else {
        a = vec[i];
      }
      sexp_car(args2) = a;
      sexp_car(args1) = b;
      res = sexp_apply(ctx, less, args2);
      if (sexp_exceptionp(res))
        goto done;
      else if (sexp_truep(res))
        swap(res, vec[i], vec[j]), j++;
    }
    swap(tmp, vec[j], vec[hi]);
    res = sexp_qsort_less(ctx, vec, lo, j-1, less, key);
    if (sexp_exceptionp(res))
      goto done;
    if (j < hi-1) {
      lo = j;
      goto loop; /* tail recurse on right side */
    }
  }
 done:
  sexp_gc_release3(ctx);
  return res;
}
Esempio n. 8
0
sexp sexp_double_to_bignum (sexp ctx, double f) {
  int sign;
  sexp_gc_var3(res, scale, tmp);
  sexp_gc_preserve3(ctx, res, scale, tmp);
  res = sexp_fixnum_to_bignum(ctx, SEXP_ZERO);
  scale = sexp_fixnum_to_bignum(ctx, SEXP_ONE);
  sign = (f < 0 ? -1 : 1);
  for (f=fabs(f); f >= 1.0; f=trunc(f/10)) {
    tmp = sexp_bignum_fxmul(ctx, NULL, scale, double_10s_digit(f), 0);
    res = sexp_bignum_add(ctx, res, res, tmp);
    scale = sexp_bignum_fxmul(ctx, NULL, scale, 10, 0);
  }
  sexp_bignum_sign(res) = sign;
  sexp_gc_release3(ctx);
  return res;
}
Esempio n. 9
0
static sexp sexp_load_standard_repl_env (sexp ctx, sexp env, sexp k) {
  sexp_gc_var3(e, p, res);
  sexp_gc_preserve3(ctx, e, p, res);
  e = sexp_load_standard_env(ctx, env, k);
  if (sexp_exceptionp(e)) return e;
  sexp_load_standard_ports(ctx, e, stdin, stdout, stderr, 0);
#if SEXP_USE_GREEN_THREADS
  p  = sexp_param_ref(ctx, e, sexp_global(ctx, SEXP_G_CUR_IN_SYMBOL));
  if (sexp_portp(p)) sexp_maybe_block_port(ctx, p, 1);
#endif
  res = sexp_make_env(ctx);
  sexp_env_parent(res) = e;
  sexp_set_parameter(ctx, res, sexp_global(ctx, SEXP_G_INTERACTION_ENV_SYMBOL), res);
  sexp_gc_release3(ctx);
  return res;
}
Esempio n. 10
0
sexp
sexp_init_library(sexp ctx, sexp self, sexp_sint_t n, sexp env,
                  const char* version, const sexp_abi_identifier_t abi){
    sexp_gc_var3(name, tmp, op);
    sexp args;
    /* check ABI */
    if(!(sexp_version_compatible(ctx, version, sexp_version)
         && sexp_abi_compatible(ctx, abi, SEXP_ABI_IDENTIFIER))) {
        return SEXP_ABI_ERROR;
    }
    sexp_gc_preserve3(ctx, name, tmp, op);

    op = sexp_define_foreign(ctx, env, "yuniffi_nccc_call", 7,
                             sexp_yuniffi_nccc_call_bridge);
    if(sexp_opcodep(op)){
        sexp_opcode_return_type(op) = SEXP_VOID;
        /* 1: func   */ sexp_opcode_arg2_type(op) = SEXP_VOID;
        /* 2: in     */
        /* 3: in_off */ sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
        /* N: [1:in_len, 2:out, 3:out_off, 4:out_len] */
        sexp_opcode_argn_type(op) = 
            sexp_make_vector(ctx, SEXP_FOUR, sexp_make_fixnum(SEXP_OBJECT));
        args = sexp_opcode_argn_type(op);
        sexp_vector_set(args, SEXP_ZERO,  sexp_make_fixnum(SEXP_FIXNUM));
        sexp_vector_set(args, SEXP_TWO,   sexp_make_fixnum(SEXP_FIXNUM));
        sexp_vector_set(args, SEXP_THREE, sexp_make_fixnum(SEXP_FIXNUM));
    }else{
        /* FIXME: abort() here? */
    }

    op = sexp_define_foreign(ctx, env, "yuniffi_nccc_proc_register", 1,
                             sexp_yuniffi_nccc_proc_register);
    if(sexp_opcodep(op)){
        sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
        /* 1: proc   */ sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_PROCEDURE);
    }

    op = sexp_define_foreign(ctx, env, "yuniffi_nccc_proc_release", 1,
                             sexp_yuniffi_nccc_proc_release);
    if(sexp_opcodep(op)){
        sexp_opcode_return_type(op) = SEXP_VOID;
        /* 1: proc   */ sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
    }

    sexp_gc_release3(ctx);
    return SEXP_VOID;
}
Esempio n. 11
0
sexp sexp_complex_atan (sexp ctx, sexp z) {
  sexp_gc_var3(res, tmp1, tmp2);
  sexp_gc_preserve3(ctx, res, tmp1, tmp2);
  tmp1 = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ONE);
  tmp1 = sexp_complex_mul(ctx, z, tmp1);
  res = sexp_make_complex(ctx, SEXP_ONE, SEXP_ZERO);
  res = sexp_complex_sub(ctx, res, tmp1);
  res = sexp_complex_log(ctx, res);
  tmp2 = sexp_make_complex(ctx, SEXP_ONE, SEXP_ZERO);
  tmp2 = sexp_complex_add(ctx, tmp2, tmp1);
  tmp2 = sexp_complex_log(ctx, tmp2);
  res = sexp_complex_sub(ctx, res, tmp2);
  tmp1 = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ONE);
  sexp_complex_imag(tmp1) = sexp_make_flonum(ctx, 0.5);
  res = sexp_complex_mul(ctx, res, tmp1);
  sexp_gc_release3(ctx);
  return res;
}
Esempio n. 12
0
static sexp sexp_get_time_of_day_stub (sexp ctx, sexp self, sexp_sint_t n) {
  int err;
  struct timeval* tmp0;
  struct timezone* tmp1;
  sexp_gc_var3(res, res0, res1);
  sexp_gc_preserve3(ctx, res, res0, res1);
  tmp0 = (struct timeval*) calloc(1, 1 + sizeof(tmp0[0]));
  tmp1 = (struct timezone*) calloc(1, 1 + sizeof(tmp1[0]));
  err = gettimeofday(tmp0, tmp1);
  if (err) {
  res = SEXP_FALSE;
  } else {
  res0 = sexp_make_cpointer(ctx, sexp_unbox_fixnum(sexp_opcode_arg1_type(self)), tmp0, SEXP_FALSE, 1);
  res1 = sexp_make_cpointer(ctx, sexp_unbox_fixnum(sexp_opcode_arg2_type(self)), tmp1, SEXP_FALSE, 1);
  res = SEXP_NULL;
  sexp_push(ctx, res, res1);
  sexp_push(ctx, res, res0);
  }
  sexp_gc_release3(ctx);
  return res;
}
Esempio n. 13
0
static void repl (sexp ctx, sexp env) {
  sexp in, out, err;
  sexp_gc_var3(obj, tmp, res);
  sexp_gc_preserve3(ctx, obj, tmp, res);
  sexp_context_tracep(ctx) = 1;
  in  = sexp_param_ref(ctx, env, sexp_global(ctx, SEXP_G_CUR_IN_SYMBOL));
  out = sexp_param_ref(ctx, env, sexp_global(ctx, SEXP_G_CUR_OUT_SYMBOL));
  err = sexp_param_ref(ctx, env, sexp_global(ctx, SEXP_G_CUR_ERR_SYMBOL));
  sexp_port_sourcep(in) = 1;
  while (1) {
    sexp_write_string(ctx, "> ", out);
    sexp_flush(ctx, out);
    sexp_maybe_block_port(ctx, in, 1);
    obj = sexp_read(ctx, in);
    sexp_maybe_unblock_port(ctx, in);
    if (obj == SEXP_EOF)
      break;
    if (sexp_exceptionp(obj)) {
      sexp_print_exception(ctx, obj, err);
    } else {
      tmp = sexp_env_bindings(env);
      sexp_context_top(ctx) = 0;
      res = sexp_eval(ctx, obj, env);
      if (sexp_exceptionp(res)) {
        sexp_print_exception(ctx, res, err);
        sexp_stack_trace(ctx, err);
      } else {
#if SEXP_USE_WARN_UNDEFS
        sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp);
#endif
        if (res != SEXP_VOID) {
          sexp_write(ctx, res, out);
          sexp_write_char(ctx, '\n', out);
        }
      }
    }
  }
  sexp_gc_release3(ctx);
}
Esempio n. 14
0
sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char* version, const sexp_abi_identifier_t abi) {
  sexp sexp_timezone_type_obj;
  sexp sexp_timeval_type_obj;
  sexp sexp_tm_type_obj;
  sexp_gc_var3(name, tmp, op);
  if (!(sexp_version_compatible(ctx, version, sexp_version)
        && sexp_abi_compatible(ctx, abi, SEXP_ABI_IDENTIFIER)))
    return SEXP_ABI_ERROR;
  sexp_gc_preserve3(ctx, name, tmp, op);
  name = sexp_c_string(ctx, "timezone", -1);
  sexp_timezone_type_obj = sexp_register_c_type(ctx, name, sexp_finalize_c_type);
  tmp = sexp_string_to_symbol(ctx, name);
  sexp_env_define(ctx, env, tmp, sexp_timezone_type_obj);
  sexp_type_slots(sexp_timezone_type_obj) = SEXP_NULL;
  sexp_push(ctx, sexp_type_slots(sexp_timezone_type_obj), sexp_intern(ctx, "tz_dsttime", -1));
  sexp_push(ctx, sexp_type_slots(sexp_timezone_type_obj), sexp_intern(ctx, "tz_minuteswest", -1));
  sexp_type_getters(sexp_timezone_type_obj) = sexp_make_vector(ctx, SEXP_TWO, SEXP_FALSE);
  sexp_type_setters(sexp_timezone_type_obj) = sexp_make_vector(ctx, SEXP_TWO, SEXP_FALSE);
  tmp = sexp_make_type_predicate(ctx, name, sexp_timezone_type_obj);
  name = sexp_intern(ctx, "timezone?", 9);
  sexp_env_define(ctx, env, name, tmp);
  name = sexp_c_string(ctx, "timeval", -1);
  sexp_timeval_type_obj = sexp_register_c_type(ctx, name, sexp_finalize_c_type);
  tmp = sexp_string_to_symbol(ctx, name);
  sexp_env_define(ctx, env, tmp, sexp_timeval_type_obj);
  sexp_type_slots(sexp_timeval_type_obj) = SEXP_NULL;
  sexp_push(ctx, sexp_type_slots(sexp_timeval_type_obj), sexp_intern(ctx, "tv_usec", -1));
  sexp_push(ctx, sexp_type_slots(sexp_timeval_type_obj), sexp_intern(ctx, "tv_sec", -1));
  sexp_type_getters(sexp_timeval_type_obj) = sexp_make_vector(ctx, SEXP_TWO, SEXP_FALSE);
  sexp_type_setters(sexp_timeval_type_obj) = sexp_make_vector(ctx, SEXP_TWO, SEXP_FALSE);
  tmp = sexp_make_type_predicate(ctx, name, sexp_timeval_type_obj);
  name = sexp_intern(ctx, "timeval?", 8);
  sexp_env_define(ctx, env, name, tmp);
  name = sexp_c_string(ctx, "tm", -1);
  sexp_tm_type_obj = sexp_register_c_type(ctx, name, sexp_finalize_c_type);
  tmp = sexp_string_to_symbol(ctx, name);
  sexp_env_define(ctx, env, tmp, sexp_tm_type_obj);
  sexp_type_slots(sexp_tm_type_obj) = SEXP_NULL;
  sexp_push(ctx, sexp_type_slots(sexp_tm_type_obj), sexp_intern(ctx, "tm_gmtoff", -1));
  sexp_push(ctx, sexp_type_slots(sexp_tm_type_obj), sexp_intern(ctx, "tm_zone", -1));
  sexp_push(ctx, sexp_type_slots(sexp_tm_type_obj), sexp_intern(ctx, "tm_isdst", -1));
  sexp_push(ctx, sexp_type_slots(sexp_tm_type_obj), sexp_intern(ctx, "tm_yday", -1));
  sexp_push(ctx, sexp_type_slots(sexp_tm_type_obj), sexp_intern(ctx, "tm_wday", -1));
  sexp_push(ctx, sexp_type_slots(sexp_tm_type_obj), sexp_intern(ctx, "tm_year", -1));
  sexp_push(ctx, sexp_type_slots(sexp_tm_type_obj), sexp_intern(ctx, "tm_mon", -1));
  sexp_push(ctx, sexp_type_slots(sexp_tm_type_obj), sexp_intern(ctx, "tm_mday", -1));
  sexp_push(ctx, sexp_type_slots(sexp_tm_type_obj), sexp_intern(ctx, "tm_hour", -1));
  sexp_push(ctx, sexp_type_slots(sexp_tm_type_obj), sexp_intern(ctx, "tm_min", -1));
  sexp_push(ctx, sexp_type_slots(sexp_tm_type_obj), sexp_intern(ctx, "tm_sec", -1));
  sexp_type_getters(sexp_tm_type_obj) = sexp_make_vector(ctx, sexp_make_fixnum(11), SEXP_FALSE);
  sexp_type_setters(sexp_tm_type_obj) = sexp_make_vector(ctx, sexp_make_fixnum(11), SEXP_FALSE);
  tmp = sexp_make_type_predicate(ctx, name, sexp_tm_type_obj);
  name = sexp_intern(ctx, "tm?", 3);
  sexp_env_define(ctx, env, name, tmp);
  op = sexp_define_foreign(ctx, env, "time-offset", 1, (sexp_proc1)sexp_tm_get_tm_gmtoff);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_tm_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_tm_type_obj))) sexp_vector_set(sexp_type_getters(sexp_tm_type_obj), SEXP_TEN, op);
  op = sexp_define_foreign(ctx, env, "time-timezone-name", 1, (sexp_proc1)sexp_tm_get_tm_zone);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_tm_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_tm_type_obj))) sexp_vector_set(sexp_type_getters(sexp_tm_type_obj), SEXP_NINE, op);
  op = sexp_define_foreign(ctx, env, "time-dst?", 1, (sexp_proc1)sexp_tm_get_tm_isdst);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_tm_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_tm_type_obj))) sexp_vector_set(sexp_type_getters(sexp_tm_type_obj), SEXP_EIGHT, op);
  op = sexp_define_foreign(ctx, env, "time-day-of-year", 1, (sexp_proc1)sexp_tm_get_tm_yday);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_tm_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_tm_type_obj))) sexp_vector_set(sexp_type_getters(sexp_tm_type_obj), SEXP_SEVEN, op);
  op = sexp_define_foreign(ctx, env, "time-day-of-week", 1, (sexp_proc1)sexp_tm_get_tm_wday);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_tm_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_tm_type_obj))) sexp_vector_set(sexp_type_getters(sexp_tm_type_obj), SEXP_SIX, op);
  op = sexp_define_foreign(ctx, env, "time-year", 1, (sexp_proc1)sexp_tm_get_tm_year);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_tm_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_tm_type_obj))) sexp_vector_set(sexp_type_getters(sexp_tm_type_obj), SEXP_FIVE, op);
  op = sexp_define_foreign(ctx, env, "time-month", 1, (sexp_proc1)sexp_tm_get_tm_mon);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_tm_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_tm_type_obj))) sexp_vector_set(sexp_type_getters(sexp_tm_type_obj), SEXP_FOUR, op);
  op = sexp_define_foreign(ctx, env, "time-day", 1, (sexp_proc1)sexp_tm_get_tm_mday);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_tm_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_tm_type_obj))) sexp_vector_set(sexp_type_getters(sexp_tm_type_obj), SEXP_THREE, op);
  op = sexp_define_foreign(ctx, env, "time-hour", 1, (sexp_proc1)sexp_tm_get_tm_hour);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_tm_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_tm_type_obj))) sexp_vector_set(sexp_type_getters(sexp_tm_type_obj), SEXP_TWO, op);
  op = sexp_define_foreign(ctx, env, "time-minute", 1, (sexp_proc1)sexp_tm_get_tm_min);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_tm_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_tm_type_obj))) sexp_vector_set(sexp_type_getters(sexp_tm_type_obj), SEXP_ONE, op);
  op = sexp_define_foreign(ctx, env, "time-second", 1, (sexp_proc1)sexp_tm_get_tm_sec);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_tm_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_tm_type_obj))) sexp_vector_set(sexp_type_getters(sexp_tm_type_obj), SEXP_ZERO, op);
  op = sexp_define_foreign(ctx, env, "make-tm", 7, (sexp_proc1)sexp_make_tm_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_tm_type_obj));
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_argn_type(op) = sexp_make_vector(ctx, SEXP_FOUR, sexp_make_fixnum(SEXP_OBJECT));
    sexp_vector_set(sexp_opcode_argn_type(op), SEXP_ZERO, sexp_make_fixnum(SEXP_FIXNUM));
    sexp_vector_set(sexp_opcode_argn_type(op), SEXP_ONE, sexp_make_fixnum(SEXP_FIXNUM));
    sexp_vector_set(sexp_opcode_argn_type(op), SEXP_TWO, sexp_make_fixnum(SEXP_FIXNUM));
    sexp_vector_set(sexp_opcode_argn_type(op), SEXP_THREE, sexp_make_fixnum(SEXP_FIXNUM));
  }
  op = sexp_define_foreign(ctx, env, "timeval-microseconds", 1, (sexp_proc1)sexp_timeval_get_tv_usec);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_timeval_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_timeval_type_obj))) sexp_vector_set(sexp_type_getters(sexp_timeval_type_obj), SEXP_ONE, op);
  op = sexp_define_foreign(ctx, env, "timeval-seconds", 1, (sexp_proc1)sexp_timeval_get_tv_sec);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_timeval_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_timeval_type_obj))) sexp_vector_set(sexp_type_getters(sexp_timeval_type_obj), SEXP_ZERO, op);
  op = sexp_define_foreign(ctx, env, "make-timeval", 2, (sexp_proc1)sexp_make_timeval_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_timeval_type_obj));
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "timezone-dst-time", 1, (sexp_proc1)sexp_timezone_get_tz_dsttime);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_timezone_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_timezone_type_obj))) sexp_vector_set(sexp_type_getters(sexp_timezone_type_obj), SEXP_ONE, op);
  op = sexp_define_foreign(ctx, env, "timezone-offset", 1, (sexp_proc1)sexp_timezone_get_tz_minuteswest);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_timezone_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_timezone_type_obj))) sexp_vector_set(sexp_type_getters(sexp_timezone_type_obj), SEXP_ZERO, op);
  op = sexp_define_foreign(ctx, env, "time->string", 1, (sexp_proc1)sexp_time_3e_string_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_tm_type_obj));
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_CHAR);
  }
  op = sexp_define_foreign(ctx, env, "seconds->string", 1, (sexp_proc1)sexp_seconds_3e_string_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_CHAR);
  }
  op = sexp_define_foreign(ctx, env, "time->seconds", 1, (sexp_proc1)sexp_time_3e_seconds_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_tm_type_obj));
  }
  op = sexp_define_foreign(ctx, env, "seconds->time", 1, (sexp_proc1)sexp_seconds_3e_time_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_tm_type_obj));
  }
  op = sexp_define_foreign_opt(ctx, env, "set-time-of-day!", 2, (sexp_proc1)sexp_set_time_of_day_x_stub, SEXP_FALSE);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_timeval_type_obj));
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_timezone_type_obj));
  }
  op = sexp_define_foreign(ctx, env, "get-time-of-day", 0, (sexp_proc1)sexp_get_time_of_day_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_timeval_type_obj));
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_timezone_type_obj));
  }
  op = sexp_define_foreign(ctx, env, "current-seconds", 0, (sexp_proc1)sexp_current_seconds_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_OBJECT);
  }
  sexp_gc_release3(ctx);
  return SEXP_VOID;
}
Esempio n. 15
0
sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char* version, const sexp_abi_identifier_t abi) {
  sexp sexp_stat_type_obj;
  sexp sexp_dirent_type_obj;
  sexp sexp_DIR_type_obj;
  sexp_gc_var3(name, tmp, op);
  if (!(sexp_version_compatible(ctx, version, sexp_version)
        && sexp_abi_compatible(ctx, abi, SEXP_ABI_IDENTIFIER)))
    return SEXP_ABI_ERROR;
  sexp_gc_preserve3(ctx, name, tmp, op);
  name = sexp_intern(ctx, "lock/unlock", 11);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, LOCK_UN));
  name = sexp_intern(ctx, "lock/non-blocking", 17);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, LOCK_NB));
  name = sexp_intern(ctx, "lock/exclusive", 14);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, LOCK_EX));
  name = sexp_intern(ctx, "lock/shared", 11);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, LOCK_SH));
  name = sexp_intern(ctx, "access/execute", 14);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, X_OK));
  name = sexp_intern(ctx, "access/write", 12);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, W_OK));
  name = sexp_intern(ctx, "access/read", 11);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, R_OK));
  name = sexp_intern(ctx, "open/non-block", 14);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, O_NONBLOCK));
  name = sexp_intern(ctx, "open/append", 11);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, O_APPEND));
  name = sexp_intern(ctx, "open/truncate", 13);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, O_TRUNC));
  name = sexp_intern(ctx, "open/exclusive", 14);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, O_EXCL));
  name = sexp_intern(ctx, "open/create", 11);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, O_CREAT));
  name = sexp_intern(ctx, "open/read-write", 15);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, O_RDWR));
  name = sexp_intern(ctx, "open/write", 10);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, O_WRONLY));
  name = sexp_intern(ctx, "open/read", 9);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, O_RDONLY));
  name = sexp_intern(ctx, "perm/others-execute", 19);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_IXOTH));
  name = sexp_intern(ctx, "perm/others-write", 17);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_IWOTH));
  name = sexp_intern(ctx, "perm/others-read", 16);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_IROTH));
  name = sexp_intern(ctx, "perm/group-execute", 18);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_IXGRP));
  name = sexp_intern(ctx, "perm/group-write", 16);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_IWGRP));
  name = sexp_intern(ctx, "perm/group-read", 15);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_IRGRP));
  name = sexp_intern(ctx, "perm/user-execute", 17);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_IXUSR));
  name = sexp_intern(ctx, "perm/user-write", 15);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_IWUSR));
  name = sexp_intern(ctx, "perm/user-read", 14);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_IRUSR));
  name = sexp_intern(ctx, "file/sticky", 11);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_ISVTX));
  name = sexp_intern(ctx, "file/sgid", 9);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_ISGID));
  name = sexp_intern(ctx, "file/suid", 9);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_ISUID));
  name = sexp_intern(ctx, "file/fifo", 9);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_IFIFO));
  name = sexp_intern(ctx, "file/character", 14);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_IFCHR));
  name = sexp_intern(ctx, "file/directory", 14);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_IFDIR));
  name = sexp_intern(ctx, "file/block", 10);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_IFBLK));
  name = sexp_intern(ctx, "file/regular", 12);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_IFREG));
  name = sexp_intern(ctx, "file/link", 9);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_IFLNK));
  name = sexp_intern(ctx, "file/socket", 11);
  sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, S_IFSOCK));
  name = sexp_c_string(ctx, "stat", -1);
  sexp_stat_type_obj = sexp_register_c_type(ctx, name, sexp_finalize_c_type);
  tmp = sexp_string_to_symbol(ctx, name);
  sexp_env_define(ctx, env, tmp, sexp_stat_type_obj);
  sexp_type_slots(sexp_stat_type_obj) = SEXP_NULL;
  sexp_push(ctx, sexp_type_slots(sexp_stat_type_obj), sexp_intern(ctx, "st_ctime", -1));
  sexp_push(ctx, sexp_type_slots(sexp_stat_type_obj), sexp_intern(ctx, "st_mtime", -1));
  sexp_push(ctx, sexp_type_slots(sexp_stat_type_obj), sexp_intern(ctx, "st_atime", -1));
  sexp_push(ctx, sexp_type_slots(sexp_stat_type_obj), sexp_intern(ctx, "st_blocks", -1));
  sexp_push(ctx, sexp_type_slots(sexp_stat_type_obj), sexp_intern(ctx, "st_blksize", -1));
  sexp_push(ctx, sexp_type_slots(sexp_stat_type_obj), sexp_intern(ctx, "st_size", -1));
  sexp_push(ctx, sexp_type_slots(sexp_stat_type_obj), sexp_intern(ctx, "st_rdev", -1));
  sexp_push(ctx, sexp_type_slots(sexp_stat_type_obj), sexp_intern(ctx, "st_gid", -1));
  sexp_push(ctx, sexp_type_slots(sexp_stat_type_obj), sexp_intern(ctx, "st_uid", -1));
  sexp_push(ctx, sexp_type_slots(sexp_stat_type_obj), sexp_intern(ctx, "st_nlink", -1));
  sexp_push(ctx, sexp_type_slots(sexp_stat_type_obj), sexp_intern(ctx, "st_mode", -1));
  sexp_push(ctx, sexp_type_slots(sexp_stat_type_obj), sexp_intern(ctx, "st_ino", -1));
  sexp_push(ctx, sexp_type_slots(sexp_stat_type_obj), sexp_intern(ctx, "st_dev", -1));
  sexp_type_getters(sexp_stat_type_obj) = sexp_make_vector(ctx, sexp_make_fixnum(13), SEXP_FALSE);
  sexp_type_setters(sexp_stat_type_obj) = sexp_make_vector(ctx, sexp_make_fixnum(13), SEXP_FALSE);
  tmp = sexp_make_type_predicate(ctx, name, sexp_stat_type_obj);
  name = sexp_intern(ctx, "stat?", 5);
  sexp_env_define(ctx, env, name, tmp);
  name = sexp_c_string(ctx, "dirent", -1);
  sexp_dirent_type_obj = sexp_register_c_type(ctx, name, sexp_finalize_c_type);
  tmp = sexp_string_to_symbol(ctx, name);
  sexp_env_define(ctx, env, tmp, sexp_dirent_type_obj);
  sexp_type_slots(sexp_dirent_type_obj) = SEXP_NULL;
  sexp_push(ctx, sexp_type_slots(sexp_dirent_type_obj), sexp_intern(ctx, "d_name", -1));
  sexp_type_getters(sexp_dirent_type_obj) = sexp_make_vector(ctx, SEXP_ONE, SEXP_FALSE);
  sexp_type_setters(sexp_dirent_type_obj) = sexp_make_vector(ctx, SEXP_ONE, SEXP_FALSE);
  name = sexp_c_string(ctx, "DIR", -1);
  sexp_DIR_type_obj = sexp_register_c_type(ctx, name, sexp_closedir_stub);
  tmp = sexp_string_to_symbol(ctx, name);
  sexp_env_define(ctx, env, tmp, sexp_DIR_type_obj);
  op = sexp_define_foreign(ctx, env, "closedir", 1, (sexp_proc1)sexp_closedir_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = SEXP_VOID;
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_DIR_type_obj));
  }
  op = sexp_define_foreign(ctx, env, "dirent-name", 1, (sexp_proc1)sexp_dirent_get_d_name);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_dirent_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_dirent_type_obj))) sexp_vector_set(sexp_type_getters(sexp_dirent_type_obj), SEXP_ZERO, op);
  op = sexp_define_foreign(ctx, env, "stat-ctime", 1, (sexp_proc1)sexp_stat_get_st_ctime);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_stat_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_stat_type_obj))) sexp_vector_set(sexp_type_getters(sexp_stat_type_obj), sexp_make_fixnum(12), op);
  op = sexp_define_foreign(ctx, env, "stat-mtime", 1, (sexp_proc1)sexp_stat_get_st_mtime);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_stat_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_stat_type_obj))) sexp_vector_set(sexp_type_getters(sexp_stat_type_obj), sexp_make_fixnum(11), op);
  op = sexp_define_foreign(ctx, env, "stat-atime", 1, (sexp_proc1)sexp_stat_get_st_atime);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_stat_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_stat_type_obj))) sexp_vector_set(sexp_type_getters(sexp_stat_type_obj), SEXP_TEN, op);
  op = sexp_define_foreign(ctx, env, "stat-blocks", 1, (sexp_proc1)sexp_stat_get_st_blocks);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_stat_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_stat_type_obj))) sexp_vector_set(sexp_type_getters(sexp_stat_type_obj), SEXP_NINE, op);
  op = sexp_define_foreign(ctx, env, "stat-blksize", 1, (sexp_proc1)sexp_stat_get_st_blksize);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_stat_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_stat_type_obj))) sexp_vector_set(sexp_type_getters(sexp_stat_type_obj), SEXP_EIGHT, op);
  op = sexp_define_foreign(ctx, env, "stat-size", 1, (sexp_proc1)sexp_stat_get_st_size);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_stat_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_stat_type_obj))) sexp_vector_set(sexp_type_getters(sexp_stat_type_obj), SEXP_SEVEN, op);
  op = sexp_define_foreign(ctx, env, "stat-rdev", 1, (sexp_proc1)sexp_stat_get_st_rdev);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_stat_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_stat_type_obj))) sexp_vector_set(sexp_type_getters(sexp_stat_type_obj), SEXP_SIX, op);
  op = sexp_define_foreign(ctx, env, "stat-gid", 1, (sexp_proc1)sexp_stat_get_st_gid);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_stat_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_stat_type_obj))) sexp_vector_set(sexp_type_getters(sexp_stat_type_obj), SEXP_FIVE, op);
  op = sexp_define_foreign(ctx, env, "stat-uid", 1, (sexp_proc1)sexp_stat_get_st_uid);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_stat_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_stat_type_obj))) sexp_vector_set(sexp_type_getters(sexp_stat_type_obj), SEXP_FOUR, op);
  op = sexp_define_foreign(ctx, env, "stat-nlinks", 1, (sexp_proc1)sexp_stat_get_st_nlink);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_stat_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_stat_type_obj))) sexp_vector_set(sexp_type_getters(sexp_stat_type_obj), SEXP_THREE, op);
  op = sexp_define_foreign(ctx, env, "stat-mode", 1, (sexp_proc1)sexp_stat_get_st_mode);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_stat_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_stat_type_obj))) sexp_vector_set(sexp_type_getters(sexp_stat_type_obj), SEXP_TWO, op);
  op = sexp_define_foreign(ctx, env, "stat-ino", 1, (sexp_proc1)sexp_stat_get_st_ino);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_stat_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_stat_type_obj))) sexp_vector_set(sexp_type_getters(sexp_stat_type_obj), SEXP_ONE, op);
  op = sexp_define_foreign(ctx, env, "stat-dev", 1, (sexp_proc1)sexp_stat_get_st_dev);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_stat_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_stat_type_obj))) sexp_vector_set(sexp_type_getters(sexp_stat_type_obj), SEXP_ZERO, op);
  op = sexp_define_foreign(ctx, env, "is-a-tty?", 1, (sexp_proc1)sexp_is_a_tty_p_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_BOOLEAN);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_OBJECT);
  }
  op = sexp_define_foreign(ctx, env, "chmod", 2, (sexp_proc1)sexp_chmod_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "file-lock", 2, (sexp_proc1)sexp_file_lock_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "file-access", 2, (sexp_proc1)sexp_file_access_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "file-truncate", 2, (sexp_proc1)sexp_file_truncate_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "set-file-descriptor-status!", 2, (sexp_proc1)sexp_set_file_descriptor_status_x_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "get-file-descriptor-status", 1, (sexp_proc1)sexp_get_file_descriptor_status_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "set-file-descriptor-flags!", 2, (sexp_proc1)sexp_set_file_descriptor_flags_x_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "get-file-descriptor-flags", 1, (sexp_proc1)sexp_get_file_descriptor_flags_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign_opt(ctx, env, "make-fifo", 2, (sexp_proc1)sexp_make_fifo_stub, sexp_make_integer(ctx, 436));
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "open-pipe", 0, (sexp_proc1)sexp_open_pipe_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FILENO);
  }
  op = sexp_define_foreign_opt(ctx, env, "open", 3, (sexp_proc1)sexp_open_stub, sexp_make_integer(ctx, 420));
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FILENO);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "close-file-descriptor", 1, (sexp_proc1)sexp_close_file_descriptor_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FILENO);
  }
  op = sexp_define_foreign(ctx, env, "duplicate-file-descriptor-to", 2, (sexp_proc1)sexp_duplicate_file_descriptor_to_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FILENO);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FILENO);
  }
  op = sexp_define_foreign(ctx, env, "duplicate-file-descriptor", 1, (sexp_proc1)sexp_duplicate_file_descriptor_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FILENO);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FILENO);
  }
  op = sexp_define_foreign(ctx, env, "readdir", 1, (sexp_proc1)sexp_readdir_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_dirent_type_obj));
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_DIR_type_obj));
  }
  op = sexp_define_foreign(ctx, env, "opendir", 1, (sexp_proc1)sexp_opendir_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_DIR_type_obj));
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING);
  }
  op = sexp_define_foreign(ctx, env, "delete-directory", 1, (sexp_proc1)sexp_delete_directory_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING);
  }
  op = sexp_define_foreign_opt(ctx, env, "create-directory", 2, (sexp_proc1)sexp_create_directory_stub, sexp_make_integer(ctx, 509));
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "change-directory", 1, (sexp_proc1)sexp_change_directory_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING);
  }
  op = sexp_define_foreign(ctx, env, "current-directory", 0, (sexp_proc1)sexp_current_directory_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CHAR);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "rename-file", 2, (sexp_proc1)sexp_rename_file_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_STRING);
  }
  op = sexp_define_foreign(ctx, env, "symbolic-link-file", 2, (sexp_proc1)sexp_symbolic_link_file_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_STRING);
  }
  op = sexp_define_foreign(ctx, env, "link-file", 2, (sexp_proc1)sexp_link_file_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_STRING);
  }
  op = sexp_define_foreign(ctx, env, "%delete-file", 1, (sexp_proc1)sexp_25_delete_file_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING);
  }
  op = sexp_define_foreign(ctx, env, "readlink", 3, (sexp_proc1)sexp_readlink_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "file-link-status", 1, (sexp_proc1)sexp_file_link_status_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_stat_type_obj));
  }
  op = sexp_define_foreign(ctx, env, "fstat", 1, (sexp_proc1)sexp_fstat_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_stat_type_obj));
  }
  op = sexp_define_foreign(ctx, env, "stat", 1, (sexp_proc1)sexp_stat_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_stat_type_obj));
  }
  op = sexp_define_foreign(ctx, env, "S_ISSOCK", 1, (sexp_proc1)sexp_S_ISSOCK_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_BOOLEAN);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "S_ISLNK", 1, (sexp_proc1)sexp_S_ISLNK_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_BOOLEAN);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "S_ISFIFO", 1, (sexp_proc1)sexp_S_ISFIFO_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_BOOLEAN);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "S_ISBLK", 1, (sexp_proc1)sexp_S_ISBLK_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_BOOLEAN);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "S_ISCHR", 1, (sexp_proc1)sexp_S_ISCHR_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_BOOLEAN);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "S_ISDIR", 1, (sexp_proc1)sexp_S_ISDIR_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_BOOLEAN);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "S_ISREG", 1, (sexp_proc1)sexp_S_ISREG_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_BOOLEAN);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  sexp_gc_release3(ctx);
  return SEXP_VOID;
}
Esempio n. 16
0
sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char* version, const sexp_abi_identifier_t abi) {
  sexp sexp_player_type_obj;
  sexp_gc_var3(name, tmp, op);
  if (!(sexp_version_compatible(ctx, version, sexp_version)
        && sexp_abi_compatible(ctx, abi, SEXP_ABI_IDENTIFIER)))
    return SEXP_ABI_ERROR;
  sexp_gc_preserve3(ctx, name, tmp, op);
  name = sexp_c_string(ctx, "player", -1);
  sexp_player_type_obj = sexp_register_c_type(ctx, name, sexp_finalize_c_type);
  tmp = sexp_string_to_symbol(ctx, name);
  sexp_env_define(ctx, env, tmp, sexp_player_type_obj);
  sexp_type_slots(sexp_player_type_obj) = SEXP_NULL;
  sexp_push(ctx, sexp_type_slots(sexp_player_type_obj), sexp_intern(ctx, "y", -1));
  sexp_push(ctx, sexp_type_slots(sexp_player_type_obj), sexp_intern(ctx, "x", -1));
  sexp_push(ctx, sexp_type_slots(sexp_player_type_obj), sexp_intern(ctx, "hp_max", -1));
  sexp_push(ctx, sexp_type_slots(sexp_player_type_obj), sexp_intern(ctx, "hp", -1));
  sexp_push(ctx, sexp_type_slots(sexp_player_type_obj), sexp_intern(ctx, "exp", -1));
  sexp_push(ctx, sexp_type_slots(sexp_player_type_obj), sexp_intern(ctx, "level", -1));
  sexp_push(ctx, sexp_type_slots(sexp_player_type_obj), sexp_intern(ctx, "race", -1));
  sexp_push(ctx, sexp_type_slots(sexp_player_type_obj), sexp_intern(ctx, "gender", -1));
  sexp_push(ctx, sexp_type_slots(sexp_player_type_obj), sexp_intern(ctx, "name", -1));
  sexp_type_getters(sexp_player_type_obj) = sexp_make_vector(ctx, SEXP_NINE, SEXP_FALSE);
  sexp_type_setters(sexp_player_type_obj) = sexp_make_vector(ctx, SEXP_NINE, SEXP_FALSE);
  tmp = sexp_make_type_predicate(ctx, name, sexp_player_type_obj);
  name = sexp_intern(ctx, "player?", 7);
  sexp_env_define(ctx, env, name, tmp);
  op = sexp_define_foreign(ctx, env, "player-y", 1, (sexp_proc1)sexp_player_get_y);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_player_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_player_type_obj))) sexp_vector_set(sexp_type_getters(sexp_player_type_obj), SEXP_EIGHT, op);
  op = sexp_define_foreign(ctx, env, "player-x", 1, (sexp_proc1)sexp_player_get_x);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_player_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_player_type_obj))) sexp_vector_set(sexp_type_getters(sexp_player_type_obj), SEXP_SEVEN, op);
  op = sexp_define_foreign(ctx, env, "player-hp-max", 1, (sexp_proc1)sexp_player_get_hp_max);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_player_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_player_type_obj))) sexp_vector_set(sexp_type_getters(sexp_player_type_obj), SEXP_SIX, op);
  op = sexp_define_foreign(ctx, env, "player-hp", 1, (sexp_proc1)sexp_player_get_hp);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_player_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_player_type_obj))) sexp_vector_set(sexp_type_getters(sexp_player_type_obj), SEXP_FIVE, op);
  op = sexp_define_foreign(ctx, env, "player-exp", 1, (sexp_proc1)sexp_player_get_exp);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_player_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_player_type_obj))) sexp_vector_set(sexp_type_getters(sexp_player_type_obj), SEXP_FOUR, op);
  op = sexp_define_foreign(ctx, env, "player-level", 1, (sexp_proc1)sexp_player_get_level);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_player_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_player_type_obj))) sexp_vector_set(sexp_type_getters(sexp_player_type_obj), SEXP_THREE, op);
  op = sexp_define_foreign(ctx, env, "player-race", 1, (sexp_proc1)sexp_player_get_race);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_player_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_player_type_obj))) sexp_vector_set(sexp_type_getters(sexp_player_type_obj), SEXP_TWO, op);
  op = sexp_define_foreign(ctx, env, "player-gender", 1, (sexp_proc1)sexp_player_get_gender);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_player_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_player_type_obj))) sexp_vector_set(sexp_type_getters(sexp_player_type_obj), SEXP_ONE, op);
  op = sexp_define_foreign(ctx, env, "player-name", 1, (sexp_proc1)sexp_player_get_name);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_STRING);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_player_type_obj));
  }
  if (sexp_vectorp(sexp_type_getters(sexp_player_type_obj))) sexp_vector_set(sexp_type_getters(sexp_player_type_obj), SEXP_ZERO, op);
  op = sexp_define_foreign(ctx, env, "random_uint_range", 2, (sexp_proc1)sexp_random_uint_range_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "random_uint", 1, (sexp_proc1)sexp_random_uint_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "random_reseed_time", 0, (sexp_proc1)sexp_random_reseed_time_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = SEXP_VOID;
  }
  op = sexp_define_foreign(ctx, env, "random_reseed", 1, (sexp_proc1)sexp_random_reseed_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = SEXP_VOID;
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "random_init", 1, (sexp_proc1)sexp_random_init_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = SEXP_VOID;
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "player_move", 3, (sexp_proc1)sexp_player_move_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = SEXP_VOID;
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_player_type_obj));
    sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
    sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  op = sexp_define_foreign(ctx, env, "player_delete", 1, (sexp_proc1)sexp_player_delete_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = SEXP_VOID;
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_player_type_obj));
  }
  op = sexp_define_foreign(ctx, env, "player_new", 0, (sexp_proc1)sexp_player_new_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = sexp_make_fixnum(sexp_type_tag(sexp_player_type_obj));
  }
  op = sexp_define_foreign(ctx, env, "sleep", 1, (sexp_proc1)sexp_sleep_stub);
  if (sexp_opcodep(op)) {
    sexp_opcode_return_type(op) = SEXP_VOID;
    sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
  }
  sexp_gc_release3(ctx);
  return SEXP_VOID;
}