[MLton] Two more mingw methods

[Wesley W. Terpstra]

--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--