- Handle address relocation to allow the NT version of Scheme to run
authorGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Sat, 21 Aug 1993 04:02:56 +0000 (04:02 +0000)
committerGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Sat, 21 Aug 1993 04:02:56 +0000 (04:02 +0000)
  under Windows 3.1.
- Cleanup of the NT sources.  Remove DOS fossils.

v7/src/microcode/ntutl/scheme16.mak
v7/src/microcode/ntutl/scheme31.c
v7/src/microcode/ntutl/scheme32.c
v7/src/microcode/ntutl/scm-cl3.lst
v7/src/microcode/ntutl/scm-p-nt.lst
v7/src/microcode/object.h
v7/src/microcode/prntenv.c
v7/src/microcode/prntfs.c
v7/src/microcode/purify.c
v8/src/microcode/object.h

index 6cfb936874ab1cb1f046076a94ce89a8bd04e453..f020d8ba120e30ad1485ccf35e81d5129a7f5476 100644 (file)
@@ -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
index 146f916eaf05d672e8b919d3bc1da25087e164f1..dfefe70828519fcd9861e0cb05b07220c560e421 100644 (file)
@@ -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>
-\f
-#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
 }
 \f
 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);
 }
 \f
 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
 }
-\f
+
 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
 }
 \f
 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  
+}
+\f
+#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;
 }
index dadf0a4e0923f512d9eb35875835f005c8a0d1e8..12294899bf5c7f9d01d3022d75e69c8ba267bbdf 100644 (file)
@@ -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;
 }
 \f
 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);
 }
+\f
+/* 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;
+}
index 156252a24374191630b747f5b13a159756a3351b..3fccd22ab1f6b6c11f1674f6b9980c7add5862c4 100644 (file)
@@ -61,7 +61,6 @@ prntenv.obj
 prntfs.obj
 
 ntasutl.obj
-ntconio.obj
 ntenv.obj
 ntfile.obj
 ntfs.obj
index 8b4dd8637d4d938f02f0478e26ed8e0190e59c19..a0f1e7b40d48103187a3ee87c579a081614e11a0 100644 (file)
@@ -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
index 79e1ca43593624a2559d83e7b0751e3a27ade4ad..bb4653ae188d94b103a0a8ed8919afb0f4fd17ea 100644 (file)
@@ -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 */
 \f
 /* Lots of type predicates */
 
index b3d6d71bf128aa1b4726eceaf090ce4d5aeb58cf..80473444997586c498755d2ee2406fc63b010e42 100644 (file)
@@ -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
index 3ab49d471e90cab9185eee719ef6ea79d6df7343..de00d9cf5e8f1b28be1a6cbf74f514ea3e49e18f 100644 (file)
@@ -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
index de1f38b00c960a82aa00d2a5ad845dfd2b78e877..4dbb96a2eba3dedcd8eab92d9808abe7bb11e06b 100644 (file)
@@ -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);
            }
index 79e1ca43593624a2559d83e7b0751e3a27ade4ad..bb4653ae188d94b103a0a8ed8919afb0f4fd17ea 100644 (file)
@@ -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 */
 \f
 /* Lots of type predicates */