From ed188cbf51116d486608a95bb3a06f90b0396163 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 8 Mar 2007 01:55:30 +0000
Subject: [PATCH] fix Windows memory-limit detection, and fix MrEd Windows
 console output for things like dump-memory-stats

svn: r5752
---
 src/mzscheme/gc2/msgprint.c       | 24 +++++++++++++++++-----
 src/mzscheme/gc2/vm_win.c         | 33 +++++++++++++++++++++++++------
 src/mzscheme/src/salloc.c         |  3 ++-
 src/worksp/gc2/make.ss            |  5 +++++
 src/worksp/mrstart/mrstart.vcproj |  1 +
 5 files changed, 54 insertions(+), 12 deletions(-)

diff --git a/src/mzscheme/gc2/msgprint.c b/src/mzscheme/gc2/msgprint.c
index 1c03475628..8ad30a3794 100644
--- a/src/mzscheme/gc2/msgprint.c
+++ b/src/mzscheme/gc2/msgprint.c
@@ -17,6 +17,11 @@ __declspec(dllexport) void gc_fprintf(int ignored, const char *c, ...);
 
 #ifdef GCPRINT_TO_WINDOWS_CONSOLE
 
+static BOOL WINAPI IgnoreEverything(DWORD evt)
+{
+  return TRUE;
+}
+
 static void GC_prim_stringout(char *s, int len)
 {
   static HANDLE console;
@@ -24,14 +29,23 @@ static void GC_prim_stringout(char *s, int len)
 
   if (!console) {
     COORD size;
-    int is_new;
+    CONSOLE_SCREEN_BUFFER_INFO info;
+
     console = GetStdHandle(STD_ERROR_HANDLE);
-    if (console == INVALID_HANDLE_VALUE) {
+    if (!GetConsoleScreenBufferInfo(console, &info)) {
+      /* Since getting the screen buffer info failed, 
+	 we must be in GUI mode. Create a console
+	 window --- and set the handler so that closing
+	 the window doesn't abort MrEd! */
       AllocConsole();
       console = GetStdHandle(STD_ERROR_HANDLE);
-      size.X = 90;
-      size.Y = 500;
-      SetConsoleScreenBufferSize(console, size);
+      GetConsoleScreenBufferInfo(console, &info);
+      size = info.dwSize;
+      if (size.Y < 500) {
+	size.Y = 500;
+	SetConsoleScreenBufferSize(console, size);
+      }
+      SetConsoleCtrlHandler(IgnoreEverything, TRUE);
     }
   }
 
diff --git a/src/mzscheme/gc2/vm_win.c b/src/mzscheme/gc2/vm_win.c
index d4fe891ddd..eb814c5a0c 100644
--- a/src/mzscheme/gc2/vm_win.c
+++ b/src/mzscheme/gc2/vm_win.c
@@ -125,13 +125,34 @@ static void protect_pages(void *p, size_t len, int writeable)
 #ifndef DONT_NEED_MAX_HEAP_SIZE
 typedef unsigned long size_type;
 
+typedef BOOL (WINAPI * QueryInformationJobObject_Proc)(HANDLE hJob,
+						       JOBOBJECTINFOCLASS JobObjectInfoClass,
+						       LPVOID lpJobObjectInfo,
+						       DWORD cbJobObjectInfoLength,
+						       LPDWORD lpReturnLength);
 static size_type determine_max_heap_size(void)
 {
-  /* FIXME: should use QueryInformationJobObject() */
-#if 0
-  GCPRINT(GCOUTF, 
-	  "Don't know how to get heap size for Windows: assuming 1GB\n");
-#endif
-  return (1 * 1024 * 1024 * 1024);
+  QueryInformationJobObject_Proc qijo;
+  JOBOBJECT_EXTENDED_LIMIT_INFORMATION info;
+  HMODULE hm;
+  SYSTEM_INFO si;
+
+  hm = LoadLibrary("kernel32.dll");
+  if (hm)
+    qijo = (QueryInformationJobObject_Proc)GetProcAddress(hm, "QueryInformationJobObject");
+  else
+    qijo = NULL;
+
+  if (qijo) {
+    DWORD size;
+    if (qijo(NULL, JobObjectExtendedLimitInformation, &info, sizeof(info), &size)) {
+      if (info.BasicLimitInformation.LimitFlags & JOB_OBJECT_LIMIT_PROCESS_MEMORY) {
+	return info.ProcessMemoryLimit;
+      }
+    }
+  }
+
+  GetSystemInfo(&si);
+  return (size_type)si.lpMaximumApplicationAddress - (size_type)si.lpMinimumApplicationAddress;
 }
 #endif
diff --git a/src/mzscheme/src/salloc.c b/src/mzscheme/src/salloc.c
index 2d85c284d9..4ed6a1a70e 100644
--- a/src/mzscheme/src/salloc.c
+++ b/src/mzscheme/src/salloc.c
@@ -1200,8 +1200,9 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[])
   if (scheme_external_dump_arg)
     scheme_external_dump_arg(c ? p[0] : NULL);
 
-#ifdef USE_TAGGED_ALLOCATION
   scheme_console_printf("Begin Dump\n");
+
+#ifdef USE_TAGGED_ALLOCATION
   trace_path_type = -1;
   obj_type = -1;
   if (c && SCHEME_SYMBOLP(p[0])) {
diff --git a/src/worksp/gc2/make.ss b/src/worksp/gc2/make.ss
index e7fc9389bd..18c3753d86 100644
--- a/src/worksp/gc2/make.ss
+++ b/src/worksp/gc2/make.ss
@@ -12,6 +12,11 @@
 (define opt-flags "/O2 /Oy-")
 (define re:only #f)
 
+(unless (find-executable-path "cl.exe" #f)
+  (error (string-append
+	  "Cannot find executable \"cl.exe\".\n"
+	  "You may need to find and run \"vsvars32.bat\".")))
+
 (unless (directory-exists? "xsrc")
   (make-directory "xsrc"))
 
diff --git a/src/worksp/mrstart/mrstart.vcproj b/src/worksp/mrstart/mrstart.vcproj
index cd4a6a387a..18604f33fb 100644
--- a/src/worksp/mrstart/mrstart.vcproj
+++ b/src/worksp/mrstart/mrstart.vcproj
@@ -70,6 +70,7 @@
 			<Tool
 				Name="VCLinkerTool"
 				AdditionalOptions="/MACHINE:I386"
+				AdditionalDependencies="user32.lib"
 				OutputFile="..\..\..\collects\launcher\$(ProjectName).exe"
 				LinkIncremental="1"
 				SuppressStartupBanner="true"