diff --git a/chibi-scheme.vcproj b/chibi-scheme.vcproj
new file mode 100644
index 00000000..86bd69e9
--- /dev/null
+++ b/chibi-scheme.vcproj
@@ -0,0 +1,206 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/eval.c b/eval.c
index 7cfa3650..7c45ddf0 100644
--- a/eval.c
+++ b/eval.c
@@ -1334,9 +1334,9 @@ sexp sexp_make_foreign (sexp ctx, const char *name, int num_args,
sexp sexp_define_foreign_aux (sexp ctx, sexp env, const char *name, int num_args,
int flags, sexp_proc1 f, sexp data) {
+ sexp res = SEXP_VOID;
sexp_gc_var1(op);
sexp_gc_preserve1(ctx, op);
- sexp res = SEXP_VOID;
op = sexp_make_foreign(ctx, name, num_args, flags, f, data);
if (sexp_exceptionp(op))
res = op;
diff --git a/include/chibi/bignum.h b/include/chibi/bignum.h
index 580b0a7d..9c6ede07 100644
--- a/include/chibi/bignum.h
+++ b/include/chibi/bignum.h
@@ -5,7 +5,7 @@
#ifndef SEXP_BIGNUM_H
#define SEXP_BIGNUM_H
-#if (SEXP_64_BIT)
+#if (SEXP_64_BIT) && defined(__GNUC__)
typedef unsigned int uint128_t __attribute__((mode(TI)));
typedef int sint128_t __attribute__((mode(TI)));
typedef uint128_t sexp_luint_t;
diff --git a/include/chibi/features.h b/include/chibi/features.h
index 093628ce..0aec32a1 100644
--- a/include/chibi/features.h
+++ b/include/chibi/features.h
@@ -230,7 +230,7 @@
#define SEXP_BSD 1
#else
#define SEXP_BSD 0
-#ifndef _GNU_SOURCE
+#if ! defined(_GNU_SOURCE) && ! defined(_WIN32) && ! defined(PLAN9)
#define _GNU_SOURCE
#endif
#endif
@@ -260,7 +260,7 @@
#endif
#ifndef SEXP_USE_DL
-#ifdef PLAN9
+#if defined(PLAN9) || defined(_WIN32)
#define SEXP_USE_DL 0
#else
#define SEXP_USE_DL ! SEXP_USE_NO_FEATURES
@@ -387,8 +387,12 @@
#endif
#ifndef SEXP_USE_STRING_STREAMS
+#ifdef _WIN32
+#define SEXP_USE_STRING_STREAMS 0
+#else
#define SEXP_USE_STRING_STREAMS ! SEXP_USE_NO_FEATURES
#endif
+#endif
#ifndef SEXP_USE_AUTOCLOSE_PORTS
#define SEXP_USE_AUTOCLOSE_PORTS ! SEXP_USE_NO_FEATURES
@@ -434,6 +438,24 @@
#define strncasecmp cistrncmp
#define round(x) floor((x)+0.5)
#define trunc(x) floor((x)+0.5*(((x)<0)?1:0))
+#elif defined(_WIN32)
+#define snprintf(buf, len, fmt, val) sprintf(buf, fmt, val)
+#define strcasecmp lstrcmpi
+#define strncasecmp(s1, s2, n) lstrcmpi(s1, s2)
+#define round(x) floor((x)+0.5)
+#define trunc(x) floor((x)+0.5*(((x)<0)?1:0))
+#define isnan(x) (x!=x)
+#define isinf(x) (x > DBL_MAX || x < -DBL_MAX)
+#endif
+
+#ifdef _WIN32
+#define sexp_pos_infinity (DBL_MAX*DBL_MAX)
+#define sexp_neg_infinity -sexp_pos_infinity
+#define sexp_nan log(-2)
+#else
+#define sexp_pos_infinity (1.0/0.0)
+#define sexp_neg_infinity -sexp_pos_infinity
+#define sexp_nan (0.0/0.0)
#endif
#ifdef __MINGW32__
diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h
index a197e953..2cb2ebb2 100644
--- a/include/chibi/sexp.h
+++ b/include/chibi/sexp.h
@@ -40,6 +40,10 @@ typedef unsigned long size_t;
#include
#include
#include
+#if SEXP_USE_FLONUMS
+#include
+#include
+#endif
#endif
#include
@@ -115,7 +119,12 @@ enum sexp_types {
SEXP_NUM_CORE_TYPES
};
-#if SEXP_64_BIT
+#ifdef _WIN32
+typedef unsigned short sexp_tag_t;
+typedef SIZE_T sexp_uint_t;
+typedef SSIZE_T sexp_sint_t;
+#define sexp_heap_align(n) sexp_align(n, 5)
+#elif SEXP_64_BIT
typedef unsigned int sexp_tag_t;
typedef unsigned long sexp_uint_t;
typedef long sexp_sint_t;
diff --git a/sexp.c b/sexp.c
index aac5569b..de029797 100644
--- a/sexp.c
+++ b/sexp.c
@@ -851,9 +851,8 @@ sexp sexp_make_vector_op (sexp ctx sexp_api_params(self, n), sexp len, sexp dflt
}
sexp sexp_list_to_vector_op (sexp ctx sexp_api_params(self, n), sexp ls) {
- sexp x, vec = sexp_make_vector(ctx, sexp_length(ctx, ls), SEXP_VOID);
- sexp *elts;
int i;
+ sexp x, *elts, vec = sexp_make_vector(ctx, sexp_length(ctx, ls), SEXP_VOID);
if (sexp_exceptionp(vec)) return vec;
elts = sexp_vector_data(vec);
for (i=0, x=ls; sexp_pairp(x); i++, x=sexp_cdr(x))
@@ -1054,7 +1053,8 @@ sexp sexp_buffered_write_string (sexp ctx, const char *str, sexp p) {
sexp sexp_buffered_flush (sexp ctx, sexp p) {
sexp_gc_var1(tmp);
- sexp_assert_type(ctx, sexp_oportp, SEXP_OPORT, p);
+ if (! sexp_oportp(p))
+ return sexp_type_exception(ctx, NULL, SEXP_OPORT, p);
if (! sexp_port_openp(p))
return sexp_user_exception(ctx, SEXP_FALSE, "port is closed", p);
else {
@@ -1722,11 +1722,11 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
res = sexp_read_symbol(ctx, in, c1, 1);
#if SEXP_USE_INFINITIES
if (res == sexp_intern(ctx, "+inf.0", -1))
- res = sexp_make_flonum(ctx, 1.0/0.0);
+ res = sexp_make_flonum(ctx, sexp_pos_infinity);
else if (res == sexp_intern(ctx, "-inf.0", -1))
- res = sexp_make_flonum(ctx, -1.0/0.0);
+ res = sexp_make_flonum(ctx, sexp_neg_infinity);
else if (res == sexp_intern(ctx, "+nan.0", -1))
- res = sexp_make_flonum(ctx, 0.0/0.0);
+ res = sexp_make_flonum(ctx, sexp_nan);
#endif
}
break;
diff --git a/vm.c b/vm.c
index 50f8e8b8..88f0d728 100644
--- a/vm.c
+++ b/vm.c
@@ -28,7 +28,7 @@ void sexp_stack_trace (sexp ctx, sexp out) {
if (sexp_truep(sexp_bytecode_name(bc)))
sexp_write(ctx, sexp_bytecode_name(bc), out);
else
- sexp_printf(ctx, out, "anon: %p", bc);
+ sexp_write_string(ctx, "", out);
if ((ls=sexp_bytecode_source(bc)) && sexp_pairp(ls)) {
if (sexp_fixnump(sexp_cdr(ls)) && (sexp_cdr(ls) >= SEXP_ZERO)) {
sexp_write_string(ctx, " on line ", out);
@@ -1071,7 +1071,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
if (tmp2 == SEXP_ZERO) {
#if SEXP_USE_FLONUMS
if (sexp_flonump(tmp1) && sexp_flonum_value(tmp1) == 0.0)
- _ARG1 = sexp_make_flonum(ctx, 0.0/0.0);
+ _ARG1 = sexp_make_flonum(ctx, 0.0);
else
#endif
sexp_raise("divide by zero", SEXP_NULL);