[MLton] Two more mingw methods
Wesley W. Terpstra
terpstra@gkec.tu-darmstadt.de
Wed, 8 Dec 2004 03:33:50 +0100
--T4sUOijqQbZv57TR
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline
Not quite as trivial as the other two.
Obviously, I have not tested uname() on all these platforms.
I only hope it's correct from reading msdn.com.
--
Wesley W. Terpstra
--T4sUOijqQbZv57TR
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="more-fns.patch"
Index: platform/mingw.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/platform/mingw.c,v
retrieving revision 1.9
diff -u -r1.9 mingw.c
--- platform/mingw.c 2 Dec 2004 21:07:43 -0000 1.9
+++ platform/mingw.c 8 Dec 2004 02:25:14 -0000
@@ -321,7 +321,15 @@
die ("getuid not implemented");
}
int setenv (const char *name, const char *value, int overwrite) {
- die ("setenv not implemented");
+ /* We could use _putenv, but then we'd need a temporary buffer for
+ * use to concat name=value. */
+ if (overwrite || !getenv(name))
+ if (!SetEnvironmentVariable(name, value)) {
+ errno = ENOMEM; /* this happens often in Windows.. */
+ return -1;
+ }
+
+ return 0;
}
int setgid (gid_t gid) {
die ("setgid not implemented");
@@ -345,31 +353,60 @@
die ("*ttyname not implemented");
}
-/* This is just enough of uname so that MLton can self compile. Someday it would
- * be nice to add stuff to fill in the fields currently set to "unknown".
- *
- * machine
- * Use the Windows API function GetSystemInfo.
- *
- * sysname
- * For now this is hardcoded as MINGW32, but this should be suffixed with the
- * windows verision info, which can be obtained with the Windows API function
- * GetVersion (or GetVersionEx). For example, on my MinGW system, uname -s
- * displays MINGW32_NT-4.0.
- *
- * release, version
- * On MinGW, uname -r and uname -v indicate the release and version of MinGW,
- * not of the underlying Windows system. So, we need to find some
- * MinGW-specific constants or functions to get those.
- */
int uname (struct utsname *buf) {
- strcpy (buf->machine, "unknown");
+ SYSTEM_INFO si;
+ OSVERSIONINFO osv;
+ const char* os = "??";
+ const char* platform = "unknown";
+ int level;
+
+ osv.dwOSVersionInfoSize = sizeof (osv);
+ GetVersionEx(&osv);
+ switch (osv.dwPlatformId) {
+ case VER_PLATFORM_WIN32_NT:
+ if (osv.dwMinorVersion == 0) {
+ if (osv.dwMajorVersion <= 4) os = "NT";
+ else os = "2000";
+ } else if (osv.dwMinorVersion <= 1) os = "XP";
+ else if (osv.dwMinorVersion <= 2) os = "2003";
+ else os = "NTx";
+ break;
+ case VER_PLATFORM_WIN32_WINDOWS:
+ if (osv.dwMinorVersion == 0) os = "95";
+ else if (osv.dwMinorVersion < 90) os = "98";
+ else if (osv.dwMinorVersion == 90) os = "Me";
+ else os = "9X";
+ break;
+ case VER_PLATFORM_WIN32s:
+ os = "31"; /* aka DOS + Windows 3.1 */
+ break;
+ }
+
+ sprintf(buf->sysname, "MINGW32_%s-%d.%d",
+ os, (int)osv.dwMajorVersion, (int)osv.dwMinorVersion);
+
+ GetSystemInfo(&si);
+ level = si.dwProcessorType;
+ switch (si.wProcessorArchitecture) {
+ case PROCESSOR_ARCHITECTURE_INTEL:
+ if (level < 3) level = 3;
+ if (level > 6) level = 6;
+ platform = "i%d86";
+ break;
+ case PROCESSOR_ARCHITECTURE_IA64: platform = "ia64"; break;
+ case PROCESSOR_ARCHITECTURE_AMD64: platform = "amd64"; break;
+ case PROCESSOR_ARCHITECTURE_ALPHA: platform = "alpha"; break;
+ case PROCESSOR_ARCHITECTURE_MIPS: platform = "mips"; break;
+ }
+ sprintf(buf->machine, platform, level);
+
unless (0 == gethostname (buf->nodename, sizeof (buf->nodename))) {
strcpy (buf->nodename, "unknown");
}
- strcpy (buf->release, "unknown");
- strcpy (buf->sysname, "MINGW32");
- strcpy (buf->version, "unknown");
+
+ sprintf(buf->version, "%d", __MINGW32_MAJOR_VERSION);
+ sprintf(buf->release, "%d", __MINGW32_MINOR_VERSION);
+
return 0;
}
--T4sUOijqQbZv57TR--