From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Sat, 21 Aug 1993 04:02:56 +0000 (+0000)
Subject: - Handle address relocation to allow the NT version of Scheme to run
X-Git-Tag: 20090517-FFI~8030
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a4a1dfdf05065fcb0a69bc2fa0ee36ed864daa94;p=mit-scheme.git

- Handle address relocation to allow the NT version of Scheme to run
  under Windows 3.1.
- Cleanup of the NT sources.  Remove DOS fossils.
---

diff --git a/v7/src/microcode/ntutl/scheme16.mak b/v7/src/microcode/ntutl/scheme16.mak
index 6cfb93687..f020d8ba1 100644
--- a/v7/src/microcode/ntutl/scheme16.mak
+++ b/v7/src/microcode/ntutl/scheme16.mak
@@ -1,6 +1,6 @@
 ### -*- Fundamental -*-
 ###
-###	$Id: scheme16.mak,v 1.2 1993/08/21 03:54:51 gjr Exp $
+###	$Id: scheme16.mak,v 1.3 1993/08/21 03:56:17 gjr Exp $
 ###
 ###	Copyright (c) 1993 Massachusetts Institute of Technology
 ###
@@ -44,7 +44,7 @@ all: ntw16lib.dll
 # These have to be compiled by a 16-bit compiler (e.g. C700)
 # with the Win16 SDK!
 
-ntw16lib.obj: ntw16lib.c ntw32lib.h
+ntw16lib.obj: ntw16lib.c ntscmlib.h
 	cl /c /ASw /G2 /Gsw /Ow /W2 /Zp1 ntw16lib.c
 
 ntw16lib.dll: ntw16lib.obj ntw16lib.def
diff --git a/v7/src/microcode/ntutl/scheme31.c b/v7/src/microcode/ntutl/scheme31.c
index 146f916ea..dfefe7082 100644
--- a/v7/src/microcode/ntutl/scheme31.c
+++ b/v7/src/microcode/ntutl/scheme31.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: scheme31.c,v 1.1 1993/07/27 20:53:18 gjr Exp $
+$Id: scheme31.c,v 1.2 1993/08/21 03:56:46 gjr Exp $
 
 Copyright (c) 1993 Massachusetts Institute of Technology
 
@@ -37,32 +37,26 @@ MIT in each case. */
  */
 
 #define W32SUT_32
-#include <windows.h>
-#include <w32sut.h>
 #include "ntscmlib.h"
-#include "ntw32lib.h"
-#include <mmsystem.h>
-
-#include <stdarg.h>
 
-#ifndef STD_MSGBOX_STYLE
-#  define STD_MSGBOX_STYLE MB_OK
-#endif
+/* Utilities */
 
-static void
-TellUser (char * format, ...)
+unsigned short
+getCS (void)
 {
-  va_list arg_ptr;
-  char buffer[128];
-  
-  va_start (arg_ptr, format);
-  wvsprintf (&buffer[0], format, arg_ptr);
-  MessageBox (NULL,
-	      ((LPCSTR) &buffer[0]),
-	      ((LPCSTR) "MIT Scheme Win32 Notification"),
-	      STD_MSGBOX_STYLE);
-  va_end (arg_ptr);
-  return;
+  _asm	mov	ax,cs
+}
+
+unsigned short
+getDS (void)
+{
+  _asm	mov	ax,ds
+}
+
+unsigned short
+getSS (void)
+{
+  _asm	mov	ax,ss
 }
 
 static UT32PROC call_16_bit_code = NULL;
@@ -76,12 +70,12 @@ called_from_16_bit_code (LPVOID buff, DWORD tag)
 BOOL WINAPI
 ntw32lib_dllinit (HANDLE self, DWORD reason, LPVOID reserved)
 {
+  BOOL crt_result = TRUE;
   static counter = 0;
 
   switch (reason)
   {
     case DLL_PROCESS_ATTACH:
-#ifndef DUMMY
       if (counter++ == 0)
 	return ((UTRegister (self,
 			     NTW16LIB_DLL_NAME,
@@ -90,11 +84,8 @@ ntw32lib_dllinit (HANDLE self, DWORD reason, LPVOID reserved)
 			     & call_16_bit_code,
 			     called_from_16_bit_code,
 			     NULL))
-#if 0
 		&& crt_result
-#endif
 		);
-#endif /* DUMMY */
       break;
 
     case DLL_THREAD_ATTACH:
@@ -104,16 +95,14 @@ ntw32lib_dllinit (HANDLE self, DWORD reason, LPVOID reserved)
       break;    
 
     case DLL_PROCESS_DETACH:
-#ifndef DUMMY
       if (--counter == 0)
 	UTUnRegister (self);
-#endif
       break;
 
     default:
       return (FALSE);
   }
-  return (TRUE);
+  return (crt_result);
 }
 
 BOOL
@@ -122,87 +111,31 @@ win32_under_win32s_p (void)
   return (TRUE);
 }
 
-#ifdef DUMMY
-#  define BASE_ADDRESS 0x1000
-#endif
-
 char *
 win32_allocate_heap (unsigned long size, unsigned long * handle)
 {
-#ifndef DUMMY
-  struct ntw32lib_malloc_s param;
-  LPVOID translation[1];
-  
-  param.size = ((SCM_ULONG) size);
-  translation[0] = ((LPVOID) NULL);
-
-  if ((* call_16_bit_code) (&param, NTW32LIB_MALLOC, &translation[0]))
-  {
-    * handle = param.handle;
-    return ((char *) (param.area));
-  }
-  else
-  {
-    * handle = 0L;
-    return ((char *) NULL);
-  }
-#elif defined(USE_VIRTUAL_ALLOC)
-  unsigned long ctr;
-  unsigned long addr;
-  unsigned long base;
-
-  for (addr = BASE_ADDRESS, ctr = 0; addr != 0; addr += BASE_ADDRESS, ctr++)
-  {
-    base = (VirtualAlloc (((LPVOID) addr),
-			  ((DWORD) size),
-			  ((DWORD) (MEM_RESERVE | MEM_COMMIT)),
-			  ((DWORD) PAGE_READWRITE)));
-    if (base != NULL)
-      break;
-  }
-
-  if (base != NULL)
-    TellUser ("Succeeded allocating address 0x%lx", base);
-  else
-    TellUser ("Failed allocating %ld bytes after %ld attempts",
-	      size, ctr);
+  LPVOID base;
 
+  base = (VirtualAlloc (((LPVOID) NULL),
+			((DWORD) size),
+			((DWORD) (MEM_RESERVE | MEM_COMMIT)),
+			((DWORD) PAGE_READWRITE)));
   * handle = size;
   return ((char *) base);
-#else
-  return ((char *) NULL);
-#endif
 }
 
 void
 win32_release_heap (char * area, unsigned long handle)
 {
-#ifndef DUMMY
-  struct ntw32lib_free_s param;
-  LPVOID translation[2];
-  
-  param.area = ((SCM_VDPTR) area);
-  param.handle = ((SCM_ULONG) handle);
-  translation[0] = ((LPVOID) & param.area);
-  translation[1] = ((LPVOID) NULL);
-  (* call_16_bit_code) (&param, NTW32LIB_MALLOC, &translation[0]);
-  return;
-#elif defined(USE_VIRTUAL_ALLOC)
   VirtualFree (((LPVOID) area),
 	       ((DWORD) handle),
 	       ((DWORD) MEM_DECOMMIT));
   return;
-#else
-  return;
-#endif
 }
-
+
 BOOL
 win32_lock_memory_area (LPVOID area, unsigned long size)
 {
-#ifdef DUMMY
-  return (TRUE);
-#else
   struct ntw32lib_vlock_s param;
   LPVOID translation[2];
 
@@ -213,15 +146,11 @@ win32_lock_memory_area (LPVOID area, unsigned long size)
 
   return ((BOOL) ((* call_16_bit_code)
 		  (&param, NTW32LIB_VIRTUAL_LOCK, &translation[0])));
-#endif
 }
 
 void
 win32_unlock_memory_area (LPVOID area, unsigned long size)
 {
-#ifdef DUMMY
-  return;
-#else
   struct ntw32lib_vulock_s param;
   LPVOID translation[2];
 
@@ -232,49 +161,91 @@ win32_unlock_memory_area (LPVOID area, unsigned long size)
 
   (* call_16_bit_code) (&param, NTW32LIB_VIRTUAL_UNLOCK, &translation[0]);
   return;
-#endif
 }
 
 UINT
-win32_install_async_timer (unsigned long * intcode_addr,
-			   unsigned long * intmask_addr,
-			   unsigned long * memtop_addr,
+win32_install_async_timer (unsigned long * base,
+			   unsigned long memtop_off,
+			   unsigned long int_code_off,
+			   unsigned long int_mask_off,
 			   unsigned long bit_mask,
-			   void ** timer_state)
+			   void ** state_ptr)
 {
-#ifdef DUMMY
-  return (0);
-#else
   struct ntw32lib_itimer_s param;
-  LPVOID translation[4];
+  LPVOID translation[2];
+  UINT result;
 
-  param.intcode_addr = ((SCM_ULPTR) intcode_addr);
-  param.intmask_addr = ((SCM_ULPTR) intmask_addr);
-  param.memtop_addr = ((SCM_ULPTR) memtop_addr);
+  param.base = ((SCM_ULPTR) base);
+  param.memtop_off = ((SCM_ULONG) memtop_off);
+  param.int_code_off = ((SCM_ULONG) int_code_off);
+  param.int_mask_off = ((SCM_ULONG) int_mask_off);
   param.bit_mask = ((SCM_ULONG) bit_mask);
 
-  translation[0] = ((LPVOID) & param.intcode_addr);
-  translation[1] = ((LPVOID) & param.intmask_addr);
-  translation[2] = ((LPVOID) & param.memtop_addr);
-  translation[3] = ((LPVOID) NULL);
+  translation[0] = ((LPVOID) & param.base);
+  translation[1] = ((LPVOID) NULL);
 
-  * timer_state = ((void *) NULL);
-  return ((UINT) ((* call_16_bit_code)
-		  (& param, NTW32LIB_INSTALL_TIMER, &translation[0])));
-#endif
+  result = ((UINT) ((* call_16_bit_code)
+		    (& param, NTW32LIB_INSTALL_TIMER, &translation[0])));
+  * state_ptr = ((void *) param.handle);
+  return (result);
 }
 
 void
 win32_flush_async_timer (void * timer_state)
 {
-#ifdef DUMMY
-  return;
-#else
   struct ntw32lib_ftimer_s param;
   LPVOID translation[1];
   
+  param.handle = ((SCM_ULONG) timer_state);
   translation[0] = ((LPVOID) NULL);
   (* call_16_bit_code) (& param, NTW32LIB_FLUSH_TIMER, &translation[0]);
   return;
-#endif  
+}
+
+#define I386_PAGE_SIZE 0x1000
+
+BOOL
+win32_alloc_scheme_selectors (unsigned long base,
+			      unsigned long size,
+			      unsigned short * scheme_cs,
+			      unsigned short * scheme_ds,
+			      unsigned short * scheme_ss)
+{
+  BOOL result;
+  struct ntw32lib_selalloc_s param;
+  LPVOID translation[1];
+
+  param.base = base;
+  param.limit = ((size + (I386_PAGE_SIZE - 1)) & (~ (I386_PAGE_SIZE - 1)));
+  param.cs32 = (getCS ());
+  param.ds32 = (getDS ());
+  param.cs = 0;
+  param.ds = 0;
+  param.ss = 0;
+  translation[0] = ((LPVOID) NULL);
+  result = ((BOOL)
+	    ((* call_16_bit_code) (& param, NTW32LIB_ALLOC_SELECTORS,
+				   &translation[0])));
+  * scheme_cs = param.cs;
+  * scheme_ds = param.ds;
+  * scheme_ss = param.ss;
+  return (result);
+}
+
+void
+win32_release_scheme_selectors (unsigned short scheme_cs,
+				unsigned short scheme_ds,
+				unsigned short scheme_ss)
+{
+  struct ntw32lib_selfree_s param;
+  LPVOID translation[1];
+
+  param.cs32 = (getCS ());
+  param.ds32 = (getDS ());
+  param.cs = scheme_cs;
+  param.ds = scheme_ds;
+  param.ss = scheme_ss;
+  translation[0] = ((LPVOID) NULL);
+  (* call_16_bit_code) (& param, NTW32LIB_FREE_SELECTORS, &translation[0]);
+  return;
 }
diff --git a/v7/src/microcode/ntutl/scheme32.c b/v7/src/microcode/ntutl/scheme32.c
index dadf0a4e0..12294899b 100644
--- a/v7/src/microcode/ntutl/scheme32.c
+++ b/v7/src/microcode/ntutl/scheme32.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: scheme32.c,v 1.2 1993/08/03 22:27:42 gjr Exp $
+$Id: scheme32.c,v 1.3 1993/08/21 03:57:56 gjr Exp $
 
 Copyright (c) 1993 Massachusetts Institute of Technology
 
@@ -84,11 +84,12 @@ win32_unlock_memory_area (void * area, unsigned long size)
 
 struct win32_timer_closure_s
 {
-  unsigned long * intcode_addr;
-  unsigned long * intmask_addr;
-  unsigned long * memtop_addr;
-  unsigned long bit_mask;
   UINT timer_id;
+  unsigned long * block;
+  unsigned long memtop_off;
+  unsigned long int_code_off;
+  unsigned long int_mask_off;
+  unsigned long bit_mask;
 };
 
 static void _stdcall
@@ -97,9 +98,11 @@ win32_nt_timer_tick (UINT wID, UINT wMsg, DWORD dwUser, DWORD dw1, DWORD dw2)
   struct win32_timer_closure_s * timer_closure =
     ((struct win32_timer_closure_s *) dwUser);
 
-  * timer_closure->intcode_addr |= timer_closure->bit_mask;
-  if (((* (timer_closure->intmask_addr)) & timer_closure->bit_mask) != 0)
-    * timer_closure->memtop_addr = ((unsigned long) -1);
+  timer_closure->block[timer_closure->int_code_off] |= timer_closure->bit_mask;
+  if ((timer_closure->block[timer_closure->int_mask_off]
+       & timer_closure->bit_mask)
+      != 0)
+    timer_closure->block[timer_closure->memtop_off] = ((unsigned long) -1);
   return;
 }
 
@@ -118,14 +121,15 @@ win32_flush_async_timer (void * state)
 			(((char *) win32_flush_async_timer)
 			 - ((char *) win32_nt_timer_tick)));
   (void) VirtualUnlock (timer_closure, (sizeof (struct win32_timer_closure_s)));
-  (void) free (timer_closure);
+  (void) free ((char *) timer_closure);
   return;
 }
 
 UINT
-win32_install_async_timer (unsigned long * intcode_addr,
-			   unsigned long * intmask_addr,
-			   unsigned long * memtop_addr,
+win32_install_async_timer (unsigned long * block,
+			   unsigned long memtop_off,
+			   unsigned long int_code_off,
+			   unsigned long int_mask_off,
 			   unsigned long bit_mask,
 			   void ** state_ptr)
 {
@@ -148,9 +152,10 @@ win32_install_async_timer (unsigned long * intcode_addr,
   if (timer_closure == ((struct win32_timer_closure_s *) NULL))
     return (WIN32_ASYNC_TIMER_NOMEM);
 
-  timer_closure->intcode_addr = intcode_addr;
-  timer_closure->intmask_addr = intmask_addr;
-  timer_closure->memtop_addr = memtop_addr;
+  timer_closure->block = block;
+  timer_closure->memtop_off = memtop_off;
+  timer_closure->int_code_off = int_code_off;
+  timer_closure->int_mask_off = int_mask_off;
   timer_closure->bit_mask = bit_mask;
   timer_closure->timer_id = 0;
 
@@ -180,3 +185,23 @@ win32_install_async_timer (unsigned long * intcode_addr,
   * state_ptr = ((void *) timer_closure);
   return (WIN32_ASYNC_TIMER_OK);
 }
+
+/* These are NOPs in this version. */
+
+BOOL
+win32_alloc_scheme_selectors (unsigned long base,
+			      unsigned long size,
+			      unsigned short * scheme_cs,
+			      unsigned short * scheme_ds,
+			      unsigned short * scheme_ss)
+{
+  return (FALSE);
+}
+
+void
+win32_release_scheme_selectors (unsigned short scheme_cs,
+				unsigned short scheme_ds,
+				unsigned short scheme_ss)
+{
+  return;
+}
diff --git a/v7/src/microcode/ntutl/scm-cl3.lst b/v7/src/microcode/ntutl/scm-cl3.lst
index 156252a24..3fccd22ab 100644
--- a/v7/src/microcode/ntutl/scm-cl3.lst
+++ b/v7/src/microcode/ntutl/scm-cl3.lst
@@ -61,7 +61,6 @@ prntenv.obj
 prntfs.obj
 
 ntasutl.obj
-ntconio.obj
 ntenv.obj
 ntfile.obj
 ntfs.obj
diff --git a/v7/src/microcode/ntutl/scm-p-nt.lst b/v7/src/microcode/ntutl/scm-p-nt.lst
index 8b4dd8637..a0f1e7b40 100644
--- a/v7/src/microcode/ntutl/scm-p-nt.lst
+++ b/v7/src/microcode/ntutl/scm-p-nt.lst
@@ -1,6 +1,6 @@
 ;;; -*-Fundamental-*-
 ;;;
-;;;	$Id: scm-p-nt.lst,v 1.2 1993/07/27 21:08:28 gjr Exp $
+;;;	$Id: scm-p-nt.lst,v 1.3 1993/08/21 04:02:56 gjr Exp $
 ;;;
 ;;;	Copyright (c) 1993 Massachusetts Institute of Technology
 ;;;
@@ -94,13 +94,8 @@ prostty.c
 prntenv.c
 prntfs.c
 ;;;;	Bizarre NT primitive files
-ntconio.c
 ntgui.c
-;dosint10.c
-;dosprm.c
 nttterm.c
-ntscreen.c
-
 ;;;;	GC files
 fasdump.c
 gcloop.c
diff --git a/v7/src/microcode/object.h b/v7/src/microcode/object.h
index 79e1ca435..bb4653ae1 100644
--- a/v7/src/microcode/object.h
+++ b/v7/src/microcode/object.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: object.h,v 9.41 1993/08/03 08:29:56 gjr Exp $
+$Id: object.h,v 9.42 1993/08/21 03:58:18 gjr Exp $
 
 Copyright (c) 1987-1993 Massachusetts Institute of Technology
 
@@ -183,6 +183,12 @@ extern SCHEME_OBJECT * memory_base;
 #endif
 
 #endif /* HEAP_IN_LOW_MEMORY */
+
+#ifndef SCHEME_ADDR_TO_ADDR
+  typedef SCHEME_OBJECT * SCHEME_ADDR;
+# define SCHEME_ADDR_TO_ADDR(saddr) ((SCHEME_OBJECT *) (saddr))
+# define ADDR_TO_SCHEME_ADDR(caddr) ((SCHEME_OBJECT) (caddr))
+#endif /* SCHEME_ADDR_TO_ADDR */
 
 /* Lots of type predicates */
 
diff --git a/v7/src/microcode/prntenv.c b/v7/src/microcode/prntenv.c
index b3d6d71bf..804734449 100644
--- a/v7/src/microcode/prntenv.c
+++ b/v7/src/microcode/prntenv.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: prntenv.c,v 1.2 1993/08/19 22:19:29 adams Exp $
+$Id: prntenv.c,v 1.3 1993/08/21 04:00:12 gjr Exp $
 
 Copyright (c) 1993 Massachusetts Institute of Technology
 
@@ -62,7 +62,7 @@ The result is either a string (the variable's value),\n\
 {
   PRIMITIVE_HEADER (1);
   {
-    CONST char * variable_value = (DOS_getenv (STRING_ARG (1)));
+    CONST char * variable_value = (NT_getenv (STRING_ARG (1)));
     PRIMITIVE_RETURN
       ((variable_value == 0)
        ? SHARP_F
diff --git a/v7/src/microcode/prntfs.c b/v7/src/microcode/prntfs.c
index 3ab49d471..de00d9cf5 100644
--- a/v7/src/microcode/prntfs.c
+++ b/v7/src/microcode/prntfs.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: prntfs.c,v 1.1 1993/06/24 06:59:14 gjr Exp $
+$Id: prntfs.c,v 1.2 1993/08/21 04:00:47 gjr Exp $
 
 Copyright (c) 1993 Massachusetts Institute of Technology
 
@@ -45,7 +45,7 @@ MIT in each case. */
 #endif
 
 extern int EXFUN
-  (DOS_read_file_status, (CONST char * filename, struct stat * s));
+  (NT_read_file_status, (CONST char * filename, struct stat * s));
 
 static SCHEME_OBJECT EXFUN (file_attributes_internal, (struct stat * s));
 static void EXFUN (file_mode_string, (struct stat * s, char * a));
@@ -64,7 +64,7 @@ DEFINE_PRIMITIVE ("FILE-MODES", Prim_file_modes, 1, 1,
   struct stat stat_result;
   PRIMITIVE_HEADER (1);
   PRIMITIVE_RETURN
-    ((DOS_read_file_status ((STRING_ARG (1)), (&stat_result)))
+    ((NT_read_file_status ((STRING_ARG (1)), (&stat_result)))
      ? (LONG_TO_UNSIGNED_FIXNUM ((stat_result . st_mode) & 07777))
      : SHARP_F);
 }
@@ -73,7 +73,7 @@ DEFINE_PRIMITIVE ("SET-FILE-MODES!", Prim_set_file_modes, 2, 2,
   "Set the mode bits of FILE to MODE.")
 {
   PRIMITIVE_HEADER (2);
-  if ((DOS_chmod ((STRING_ARG (1)), (arg_index_integer (2, 010000)))) < 0)
+  if ((NT_chmod ((STRING_ARG (1)), (arg_index_integer (2, 010000)))) < 0)
     error_system_call (errno, syscall_chmod);
   PRIMITIVE_RETURN (SHARP_F);
 }
@@ -83,7 +83,7 @@ DEFINE_PRIMITIVE ("FILE-MOD-TIME", Prim_file_mod_time, 1, 1, 0)
   struct stat s;
   PRIMITIVE_HEADER (1);
   PRIMITIVE_RETURN
-    ((DOS_read_file_status ((STRING_ARG (1)), (&s)))
+    ((NT_read_file_status ((STRING_ARG (1)), (&s)))
      ? (long_to_integer (s . st_mtime))
      : SHARP_F);
 }
@@ -120,7 +120,7 @@ DEFINE_PRIMITIVE ("FILE-ATTRIBUTES", Prim_file_attributes, 1, 1,
 If the file exists and its status information is accessible, the result\n\
 is a vector of 10 items (see the reference manual for details).  Otherwise\n\
 the result is #F.")
-     FILE_ATTRIBUTES_PRIMITIVE (DOS_read_file_status)
+     FILE_ATTRIBUTES_PRIMITIVE (NT_read_file_status)
 
 static SCHEME_OBJECT
 DEFUN (file_attributes_internal, (s), struct stat * s)
@@ -282,7 +282,7 @@ DEFUN (file_touch, (filename), CONST char * filename)
       {
 	count += 1;
 	/* Use O_EXCL to prevent overwriting existing file. */
-	fd = (DOS_open (filename, (O_RDWR | O_CREAT | O_EXCL), MODE_REG));
+	fd = (NT_open (filename, (O_RDWR | O_CREAT | O_EXCL), MODE_REG));
 	if (fd >= 0)
 	  {
 	    protect_fd (fd);
@@ -291,13 +291,13 @@ DEFUN (file_touch, (filename), CONST char * filename)
 	  }
 	if (errno == EEXIST)
 	  {
-	    fd = (DOS_open (filename, O_RDWR, MODE_REG));
+	    fd = (NT_open (filename, O_RDWR, MODE_REG));
 	    if (fd >= 0)
 	      {
 		protect_fd (fd);
 		break;
 	      }
-	    else if ((errno == ENOENT) || (errno == ESTALE))
+	    else if (errno == ENOENT)
 	      continue;
 	  }
 	if (count >= FILE_TOUCH_OPEN_TRIES)
@@ -306,7 +306,7 @@ DEFUN (file_touch, (filename), CONST char * filename)
   }
   {
     struct stat file_status;
-    STD_VOID_SYSTEM_CALL (syscall_fstat, (DOS_fstat (fd, (&file_status))));
+    STD_VOID_SYSTEM_CALL (syscall_fstat, (NT_fstat (fd, (&file_status))));
     if (((file_status . st_mode) & S_IFMT) != S_IFREG)
       error_bad_range_arg (1);
     /* CASE 3: file length of 0 needs special treatment. */
@@ -314,15 +314,15 @@ DEFUN (file_touch, (filename), CONST char * filename)
      {
 	char buf [1];
 	(buf[0]) = '\0';
-	STD_VOID_SYSTEM_CALL (syscall_write, (DOS_write (fd, buf, 1)));
+	STD_VOID_SYSTEM_CALL (syscall_write, (NT_write (fd, buf, 1)));
 #ifdef HAVE_TRUNCATE
-	STD_VOID_SYSTEM_CALL (syscall_ftruncate, (DOS_ftruncate (fd, 0)));
+	STD_VOID_SYSTEM_CALL (syscall_ftruncate, (NT_ftruncate (fd, 0)));
 	transaction_commit ();
 #else /* not HAVE_TRUNCATE */
 	transaction_commit ();
-	fd = (DOS_open (filename, (O_WRONLY | O_TRUNC), MODE_REG));
+	fd = (NT_open (filename, (O_WRONLY | O_TRUNC), MODE_REG));
 	if (fd >= 0)
-	  STD_VOID_SYSTEM_CALL (syscall_close, (DOS_close (fd)));
+	  STD_VOID_SYSTEM_CALL (syscall_close, (NT_close (fd)));
 #endif /* HAVE_TRUNCATE */
 	return (SHARP_F);
       }
@@ -331,11 +331,11 @@ DEFUN (file_touch, (filename), CONST char * filename)
   {
     char buf [1];
     int scr;
-    STD_UINT_SYSTEM_CALL (syscall_read, scr, (DOS_read (fd, buf, 1)));
+    STD_UINT_SYSTEM_CALL (syscall_read, scr, (NT_read (fd, buf, 1)));
     if (scr > 0)
       {
-	STD_VOID_SYSTEM_CALL (syscall_lseek, (DOS_lseek (fd, 0, SEEK_SET)));
-	STD_VOID_SYSTEM_CALL (syscall_write, (DOS_write (fd, buf, 1)));
+	STD_VOID_SYSTEM_CALL (syscall_lseek, (NT_lseek (fd, 0, SEEK_SET)));
+	STD_VOID_SYSTEM_CALL (syscall_write, (NT_write (fd, buf, 1)));
       }
   }
   transaction_commit ();
@@ -345,7 +345,8 @@ DEFUN (file_touch, (filename), CONST char * filename)
 static void
 DEFUN (protect_fd_close, (ap), PTR ap)
 {
-  DOS_close (* ((int *) ap));
+  NT_close (* ((int *) ap));
+  return;
 }
 
 static void
diff --git a/v7/src/microcode/purify.c b/v7/src/microcode/purify.c
index de1f38b00..4dbb96a2e 100644
--- a/v7/src/microcode/purify.c
+++ b/v7/src/microcode/purify.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: purify.c,v 9.49 1993/06/24 06:18:24 gjr Exp $
+$Id: purify.c,v 9.50 1993/08/21 04:01:15 gjr Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -65,6 +65,15 @@ extern SCHEME_OBJECT * EXFUN (GCLoop, (SCHEME_OBJECT *, SCHEME_OBJECT **));
   Code;									\
 }
 
+#define PURIFY_RAW_POINTER(Code)					\
+{									\
+  Old = (SCHEME_ADDR_TO_ADDR (Temp));					\
+  if ((GC_Mode == CONSTANT_COPY) &&					\
+      (Old > Low_Constant))						\
+    continue;								\
+  Code;									\
+}
+
 #define Setup_Pointer_for_Purify(Extra_Code)				\
 {									\
   Purify_Pointer(Setup_Pointer(false, Extra_Code));			\
@@ -72,7 +81,7 @@ extern SCHEME_OBJECT * EXFUN (GCLoop, (SCHEME_OBJECT *, SCHEME_OBJECT **));
 
 #define Indirect_BH(In_GC)						\
 {									\
-  if ((OBJECT_TYPE (*Old)) == TC_BROKEN_HEART)				\
+  if ((OBJECT_TYPE (* Old)) == TC_BROKEN_HEART)				\
     continue;								\
 }
 
@@ -145,12 +154,14 @@ DEFUN (PurifyLoop,
 	    fast long count;
 
 	    Scan++;
-	    for (count = READ_CACHE_LINKAGE_COUNT(Temp);
+	    for (count = (READ_CACHE_LINKAGE_COUNT (Temp));
 		 --count >= 0;
 		 Scan += 1)
 	    {
-	      Temp = *Scan;
-	      Setup_Pointer_for_Purify(Transport_Quadruple());
+	      Temp = (* Scan);
+	      PURIFY_RAW_POINTER (Setup_Internal (false,
+						  TRANSPORT_RAW_QUADRUPLE (),
+						  RAW_BH (false, continue)));
 	    }
 	    Scan -= 1;
 	    break;
@@ -173,10 +184,11 @@ DEFUN (PurifyLoop,
 	      Scan = ((SCHEME_OBJECT *) word_ptr);
 	      word_ptr = (NEXT_LINKAGE_OPERATOR_ENTRY (word_ptr));
 	      EXTRACT_OPERATOR_LINKAGE_ADDRESS (Temp, Scan);
-	      Purify_Pointer(Setup_Internal(false,
-					    Transport_Compiled(),
-					    Compiled_BH(false,
-							goto next_operator)));
+	      Purify_Pointer (Setup_Internal
+			      (false,
+			       Transport_Compiled (),
+			       Compiled_BH (false,
+					    goto next_operator)));
 	      next_operator:
 	      STORE_OPERATOR_LINKAGE_ADDRESS(Temp, Scan);
 	    }
diff --git a/v8/src/microcode/object.h b/v8/src/microcode/object.h
index 79e1ca435..bb4653ae1 100644
--- a/v8/src/microcode/object.h
+++ b/v8/src/microcode/object.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: object.h,v 9.41 1993/08/03 08:29:56 gjr Exp $
+$Id: object.h,v 9.42 1993/08/21 03:58:18 gjr Exp $
 
 Copyright (c) 1987-1993 Massachusetts Institute of Technology
 
@@ -183,6 +183,12 @@ extern SCHEME_OBJECT * memory_base;
 #endif
 
 #endif /* HEAP_IN_LOW_MEMORY */
+
+#ifndef SCHEME_ADDR_TO_ADDR
+  typedef SCHEME_OBJECT * SCHEME_ADDR;
+# define SCHEME_ADDR_TO_ADDR(saddr) ((SCHEME_OBJECT *) (saddr))
+# define ADDR_TO_SCHEME_ADDR(caddr) ((SCHEME_OBJECT) (caddr))
+#endif /* SCHEME_ADDR_TO_ADDR */
 
 /* Lots of type predicates */