under Windows 3.1.
- Cleanup of the NT sources. Remove DOS fossils.
### -*- 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
###
# 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
/* -*-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
*/
#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;
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,
& call_16_bit_code,
called_from_16_bit_code,
NULL))
-#if 0
&& crt_result
-#endif
);
-#endif /* DUMMY */
break;
case DLL_THREAD_ATTACH:
break;
case DLL_PROCESS_DETACH:
-#ifndef DUMMY
if (--counter == 0)
UTUnRegister (self);
-#endif
break;
default:
return (FALSE);
}
- return (TRUE);
+ return (crt_result);
}
\f
BOOL
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) (¶m, 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) (¶m, 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];
return ((BOOL) ((* call_16_bit_code)
(¶m, 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];
(* call_16_bit_code) (¶m, 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;
}
/* -*-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
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
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;
}
(((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)
{
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;
* 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;
+}
prntfs.obj
ntasutl.obj
-ntconio.obj
ntenv.obj
ntfile.obj
ntfs.obj
;;; -*-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
;;;
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
/* -*-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
#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 */
/* -*-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
{
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
/* -*-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
#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));
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);
}
"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);
}
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);
}
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)
{
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);
}
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)
}
{
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. */
{
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);
}
{
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 ();
static void
DEFUN (protect_fd_close, (ap), PTR ap)
{
- DOS_close (* ((int *) ap));
+ NT_close (* ((int *) ap));
+ return;
}
static void
/* -*-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
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)); \
#define Indirect_BH(In_GC) \
{ \
- if ((OBJECT_TYPE (*Old)) == TC_BROKEN_HEART) \
+ if ((OBJECT_TYPE (* Old)) == TC_BROKEN_HEART) \
continue; \
}
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;
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);
}
/* -*-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
#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 */