From 94ba2a064f493e79b113b362ca6dbdcba85b31ea Mon Sep 17 00:00:00 2001
From: jjgarcia <jjgarcia>
Date: Tue, 11 Jan 2005 14:40:23 +0000
Subject: [PATCH] New function for Windows system errors (M. Goffioul)

---
 src/c/error.d    | 27 +++++++++++++++++++++++++++
 src/h/external.h |  3 +++
 2 files changed, 30 insertions(+)

diff --git a/src/c/error.d b/src/c/error.d
index f3a1c4284..59cab13ee 100644
--- a/src/c/error.d
+++ b/src/c/error.d
@@ -20,6 +20,9 @@
 #include <errno.h>
 #include <signal.h>
 #include <stdlib.h>
+#ifdef _MSC_VER
+#include <windows.h>
+#endif
 
 void
 cs_overflow(void)
@@ -258,6 +261,30 @@ FElibc_error(const char *msg, int narg, ...)
 		make_constant_string(strerror(errno)));
 }
 
+#if defined(mingw32) || defined(_MSC_VER)
+void
+FEwin32_error(const char *msg, int narg, ...)
+{
+	cl_va_list args;
+	cl_object rest, win_msg_obj;
+	char *win_msg;
+
+	cl_va_start(args, narg, narg, 0);
+	rest = cl_grab_rest_args(args);
+
+	if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_ALLOCATE_BUFFER,
+	                  0, GetLastError(), 0, (void*)&win_msg, 0, NULL) == 0)
+		win_msg_obj = make_simple_string("[Unable to get error message]");
+	else {
+		win_msg_obj = make_string_copy(win_msg);
+		LocalFree(win_msg);
+	}
+
+	FEerror("~?~%Explanation: ~A.", 3, make_constant_string(msg), rest,
+		win_msg_obj);
+}
+#endif
+
 /************************************
  * Higher level interface to errors *
  ************************************/
diff --git a/src/h/external.h b/src/h/external.h
index 0818fd0c7..5a28d824d 100644
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -452,6 +452,9 @@ extern cl_object CEerror(const char *err_str, int narg, ...);
 extern void illegal_index(cl_object x, cl_object i);
 extern void FEtype_error_symbol(cl_object obj) /*__attribute__((noreturn))*/;
 extern void FElibc_error(const char *msg, int narg, ...) /*__attribute__((noreturn))*/;
+#if defined(mingw32) || defined(_MSC_VER)
+extern void FEwin32_error(const char *msg, int narg, ...) /*__attribute__((noreturn))*/;
+#endif
 
 /* eval.c */