better virtual memory behaviour.
There used to be two version of the library NTSCMLIB.DLL, one version
for WIN32S, and another version for NT (and '95). The WIN32S version
had a partner, NTW16LIB.DLL, to handle the 16-bit side of things.
The system was configured for Windows 3.1 or NT by copying the
appropriate version of NTSCMLIB.DLL into the same directory as
SCHEME.EXE, or putting an appropriate directory in the PATH.
The new scheme is that instead of two NTSCMLIB.DLL files and a
NTW16LIB.DLL file there will be three files:
SCHEME32.DLL The true 32 bit version (NT & '95)
SCHEME31.DLL The windows 3.1 (win32s) version
SCHEME16.DLL and its 16 bit buddy
These are no longer bound at link time. Instead, nttop.c now detects
WIN32S vs. NT and explicitly loads the appropriate version. To
support this dynamic linking, the utilities referenced via a
WIN32_SYSTEM_UTILITIES structure.
Now both SCHEME31.DLL and SCHEME32.DLL use VirtualAlloc, so the
garbage collector has been changed to de-commit and re-commit the
pages in the old half-space. Toy experiments show that roughly 30-50%
of the working set is in the old half-space.
The allocation code *could* be changed to reserve the virtual address
space of the whole heap as this would allow an extensible heap.
/* -*-C-*-
-$Id: cmpint.c,v 1.88 1996/01/04 23:59:47 cph Exp $
+$Id: cmpint.c,v 1.89 1996/03/23 19:25:23 adams Exp $
Copyright (c) 1989-96 Massachusetts Institute of Technology
winnt_catatonia_block = ((unsigned long *) &mem->catatonia_block[0]);
RegistersPtr = mem->Registers;
- if (! (win32_lock_memory_area (mem, (sizeof (REGMEM)))))
+ if (! (win32_system_utilities.lock_memory_area (mem, (sizeof (REGMEM)))))
{
outf_error ("Unable to lock registers\n");
outf_flush_error ();
void
DEFUN_VOID (winnt_deallocate_registers)
{
- win32_unlock_memory_area (®mem, (sizeof (REGMEM)));
+ win32_system_utilities.unlock_memory_area (®mem, (sizeof (REGMEM)));
return;
}
/* -*-C-*-
-$Id: memmag.c,v 9.58 1995/10/08 15:22:15 cph Exp $
+$Id: memmag.c,v 9.59 1996/03/23 19:25:17 adams Exp $
Copyright (c) 1987-95 Massachusetts Institute of Technology
}
COMPILER_TRANSPORT_END ();
+
+#ifdef WINNT
+ /* Since we allocated the heap with VirtualAlloc, we can decommit the old
+ half-space to tell the VM system that it comtains trash.
+ Immediately recommitting the region allows the old half-space to be used
+ for temporary storage (e.g. by fasdump).
+ We are careful to do this with pages that are strictly within the old
+ half-space
+ */
+ { long pagesize = 4096;
+ void *base =
+ ((void*)
+ (((DWORD)((char*)Unused_Heap_Bottom + pagesize)) & ~(pagesize-1))) ;
+ DWORD len =
+ ((DWORD)(((char*)Unused_Heap_Top) - ((char*)base))) & ~(pagesize-1);
+ VirtualFree (base, len, MEM_DECOMMIT);
+ VirtualAlloc (base, len, MEM_COMMIT, PAGE_READWRITE);
+ }
+#endif
+
CLEAR_INTERRUPT (INT_GC);
return;
}
/* -*-C-*-
-$Id: memmag.h,v 1.3 1995/10/24 04:56:12 cph Exp $
+$Id: memmag.h,v 1.4 1996/03/23 19:25:10 adams Exp $
-Copyright (c) 1993-95 Massachusetts Institute of Technology
+Copyright (c) 1993-96 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
#ifdef WINNT_RAW_ADDRESSES
-#define WIN32_ALLOCATE_HEAP win32_allocate_heap
-#define WIN32_RELEASE_HEAP win32_release_heap
+#define WIN32_ALLOCATE_HEAP win32_system_utilities.allocate_heap
+#define WIN32_RELEASE_HEAP win32_system_utilities.release_heap
#else /* not WINNT_RAW_ADDRESSES */
total_fudge = (actual_fudge_1 + actual_fudge_2);
actual_size = (size + total_fudge);
- base = (win32_allocate_heap (actual_size, handle));
+ base = (win32_system_utilities.allocate_heap (actual_size, handle));
if (base == ((char *) NULL))
return (base);
virtual_base = (base + total_fudge);
winnt_address_delta = (((unsigned long) base) + actual_fudge_1);
- if (! (win32_alloc_scheme_selectors (winnt_address_delta,
- (size + actual_fudge_2),
- &Scheme_Code_Segment_Selector,
- &Scheme_Data_Segment_Selector,
- &Scheme_Stack_Segment_Selector)))
+ if (! (win32_system_utilities.alloc_scheme_selectors
+ (winnt_address_delta,
+ (size + actual_fudge_2),
+ &Scheme_Code_Segment_Selector,
+ &Scheme_Data_Segment_Selector,
+ &Scheme_Stack_Segment_Selector)))
/* Let the higher-level code fail. */
winnt_address_delta = 0L;
WIN32_RELEASE_HEAP (char * area, unsigned long handle)
{
if (winnt_address_delta != 0)
- win32_release_scheme_selectors (Scheme_Code_Segment_Selector,
- Scheme_Data_Segment_Selector,
- Scheme_Stack_Segment_Selector);
- win32_release_heap ((area - total_fudge), handle);
+ win32_system_utilities.release_scheme_selectors
+ (Scheme_Code_Segment_Selector,
+ Scheme_Data_Segment_Selector,
+ Scheme_Stack_Segment_Selector);
+ win32_system_utilities.release_heap ((area - total_fudge), handle);
return;
}
/* -*-C-*-
-$Id: ntio.c,v 1.11 1995/10/24 05:05:08 cph Exp $
+$Id: ntio.c,v 1.12 1996/03/23 19:25:04 adams Exp $
-Copyright (c) 1992-95 Massachusetts Institute of Technology
+Copyright (c) 1992-96 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
int OS_have_select_p = 0;
extern HANDLE master_tty_window;
-extern BOOL __cdecl win32_under_win32s_p (void);
extern void EXFUN (NT_initialize_channels, (void));
extern void EXFUN (NT_reset_channels, (void));
extern void EXFUN (NT_restore_channels, (void));
/* -*-C-*-
-$Id: ntscmlib.h,v 1.5 1995/10/24 05:24:48 cph Exp $
+$Id: ntscmlib.h,v 1.6 1996/03/23 19:24:58 adams Exp $
-Copyright (c) 1993-95 Massachusetts Institute of Technology
+Copyright (c) 1993-96 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
/* Exports to Scheme */
-extern BOOL __cdecl
- win32_under_win32s_p (void);
-
-extern char * __cdecl
- win32_allocate_heap (unsigned long, /* size */
- unsigned long *); /* handle */
-extern void __cdecl
- win32_release_heap (char *, /* base */
- unsigned long); /* handle */
-
-extern BOOL __cdecl
- win32_lock_memory_area (void *, /* area */
- unsigned long); /* size */
-extern void __cdecl
- win32_unlock_memory_area (void *, /* area */
- unsigned long); /* size */
-
-extern UINT __cdecl
- win32_install_async_timer (void **, /* timer state */
- unsigned long *, /* regs */
- long, /* memtop off */
- long, /* int_code off */
- long, /* int_mask off */
- unsigned long, /* mask */
- long, /* ctr_off */
- unsigned long, /* message */
- HWND); /* window */
-
-extern void __cdecl
- win32_flush_async_timer (void *);
-
-extern BOOL __cdecl
- win32_alloc_scheme_selectors (unsigned long, /* base */
- unsigned long, /* limit */
- unsigned short *, /* cs */
- unsigned short *, /* ds */
- unsigned short *); /* ss */
-
-extern void __cdecl
- win32_release_scheme_selectors (unsigned short, /* cs */
- unsigned short, /* ds */
- unsigned short); /* ss */
+typedef struct {
+
+ BOOL (__cdecl *under_win32s_p) ();
+
+ char *
+ (__cdecl *allocate_heap) (unsigned long, /* size */
+ unsigned long *); /* handle */
+ void
+ (__cdecl *release_heap) (char *, /* base */
+ unsigned long); /* handle */
+
+ BOOL
+ (__cdecl *lock_memory_area) (void *, /* area */
+ unsigned long); /* size */
+ void
+ (__cdecl *unlock_memory_area) (void *, /* area */
+ unsigned long); /* size */
+
+ UINT
+ (__cdecl *install_async_timer) (void **, /* timer state */
+ unsigned long *, /* regs */
+ long, /* memtop off */
+ long, /* int_code off */
+ long, /* int_mask off */
+ unsigned long, /* mask */
+ long, /* ctr_off */
+ unsigned long, /* message */
+ HWND); /* window */
+
+ void
+ (__cdecl *flush_async_timer) (void *);
+
+ BOOL
+ (__cdecl *alloc_scheme_selectors) (unsigned long, /* base */
+ unsigned long, /* limit */
+ unsigned short *, /* cs */
+ unsigned short *, /* ds */
+ unsigned short *); /* ss */
+
+ void
+ (__cdecl *release_scheme_selectors) (unsigned short, /* cs */
+ unsigned short, /* ds */
+ unsigned short); /* ss */
+
+} WIN32_SYSTEM_UTILITIES;
+
+extern WIN32_SYSTEM_UTILITIES win32_system_utilities;
#endif /* not W32SUT_16 */
\f
#if defined(W32SUT_32) || defined(W32SUT_16)
#define STRINGIFY(arg) #arg
-#define NTW16LIB_DLL_NAME "ntw16lib.dll"
+#define NTW16LIB_DLL_NAME "scheme16.dll"
#define NTW16LIB_DLL_INIT ntw16lib_init
#define NTW16LIB_DLL_ENTRY ntw16lib_handler
/* -*-C-*-
-$Id: ntsig.c,v 1.16 1994/05/19 00:05:14 adams Exp $
+$Id: ntsig.c,v 1.17 1996/03/23 19:24:53 adams Exp $
-Copyright (c) 1992-1993 Massachusetts Institute of Technology
+Copyright (c) 1992-96 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
winnt_catatonia_block[CATATONIA_BLOCK_LIMIT]
= (CATATONIA_PERIOD / ASYNC_TIMER_PERIOD);
winnt_catatonia_block[CATATONIA_BLOCK_FLAG] = 0;
- switch (win32_install_async_timer (&timer_state,
- &Registers[0],
- REGBLOCK_MEMTOP,
- REGBLOCK_INT_CODE,
- REGBLOCK_INT_MASK,
- (INT_Global_GC | INT_Global_1),
- catatonia_offset,
- WM_CATATONIC,
- master_tty_window))
+ switch (win32_system_utilities.install_async_timer
+ (&timer_state,
+ &Registers[0],
+ REGBLOCK_MEMTOP,
+ REGBLOCK_INT_CODE,
+ REGBLOCK_INT_MASK,
+ (INT_Global_GC | INT_Global_1),
+ catatonia_offset,
+ WM_CATATONIC,
+ master_tty_window))
{
case WIN32_ASYNC_TIMER_OK:
return (NULL);
static void
DEFUN_VOID (flush_timer)
{
- win32_flush_async_timer (timer_state);
+ win32_system_utilities.flush_async_timer (timer_state);
return;
}
\f
/* -*-C-*-
-$Id: ntsys.h,v 1.4 1993/09/03 18:03:31 gjr Exp $
+$Id: ntsys.h,v 1.5 1996/03/23 19:24:46 adams Exp $
-Copyright (c) 1992-1993 Massachusetts Institute of Technology
+Copyright (c) 1992-96 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
/* Misc */
+extern BOOL win32_under_win32s_p ();
extern int nt_console_write (void * vbuffer, size_t nsize);
extern void nt_get_version (version_t * version_number);
extern BOOL nt_pathname_as_filename (char * name, char * buffer);
/* -*-C-*-
-$Id: nttop.c,v 1.16 1995/10/25 02:30:37 cph Exp $
+$Id: nttop.c,v 1.17 1996/03/23 19:24:40 adams Exp $
-Copyright (c) 1993-95 Massachusetts Institute of Technology
+Copyright (c) 1993-96 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
#include "errors.h"
#include "option.h"
#include "outf.h"
+#include "ntscmlib.h"
extern void EXFUN (execute_reload_cleanups, (void));
extern CONST char * OS_Name;
extern CONST char * OS_Variant;
+
+\f
+BOOL
+win32_under_win32s_p ()
+{
+ return ((GetVersion()) >> 31);
+}
+
+WIN32_SYSTEM_UTILITIES win32_system_utilities;
+
+HINSTANCE win32_system_utilities_dll = 0;
+
+void
+NT_initialize_win32_system_utilities ()
+{
+ char * dll_name = win32_under_win32s_p() ? "SCHEME31.DLL" : "SCHEME32.DLL";
+ char * entry_name = "install_win32_system_utilities";
+ FARPROC install;
+
+ win32_system_utilities_dll = LoadLibrary (dll_name);
+ if (win32_system_utilities_dll == NULL) {
+ outf_fatal ("MIT Scheme is unable to find or load %s\n"
+ "This essential MIT Scheme file should be in the\n"
+ "same directory as SCHEME.EXE",
+ dll_name);
+ outf_flush_fatal();
+ abort ();
+ }
+
+ install = GetProcAddress (win32_system_utilities_dll, entry_name);
+ if (install==NULL) {
+ outf_fatal ("Something is wrong with %s\n"
+ "It does not have an entry called \"%s\".",
+ dll_name, entry_name);
+ outf_flush_fatal ();
+ abort ();
+ }
+
+ install (&win32_system_utilities);
+}
\f
static int interactive;
### -*- Fundamental -*-
###
-### $Id: makefile,v 1.17 1995/10/24 05:32:20 cph Exp $
+### $Id: makefile,v 1.18 1996/03/23 19:24:33 adams Exp $
###
### Copyright (c) 1992-95 Massachusetts Institute of Technology
###
USER_PRIM_OBJECTS =
USER_LIBS =
BINDIR = \scheme\nt\microcode
-AS = mlx /Zm /Cp /c # masm386 /z #
+AS = c:\usr\lib\masm\bin\mlx /Zm /Cp /c # masm386 /z #
LDFLAGS =
cflags = $(cflags) -DMIT_SCHEME -DWINNT -DCL386 $(MACHINE_SWITCHES) -DGUI=1
syslibs = $(guilibs)
cvobj = cvtomf
-all: scheme.exe ntscmlib.dll bchschem.exe # bintopsb.exe psbtobin.exe
+all: scheme.exe scheme31.dll scheme32.dll bchschem.exe # bintopsb.exe psbtobin.exe
+# scheme16.dll has to build with a 16 bit compiler
.c.obj:
$(cc) $(cflags) $(cdebug) -c $*.c
!ENDIF
scheme: scheme.exe
-scheme.exe : $(OBJECTS) $(SCHEME_OBJECTS) scm-cl3.lst ntscmlib.dll
- $(link) $(linkdebug) $(sysflags) -out:scheme.exe @scm-cl3.lst $(syslibs) ntscmlib.lib crtdll.lib
-bchschem.exe : $(BCHOBJECTS) $(SCHEME_OBJECTS) bch-cl3.lst ntscmlib.dll
- $(link) $(linkdebug) $(sysflags) -out:bchschem.exe @bch-cl3.lst $(syslibs) ntscmlib.lib crtdll.lib
+scheme.exe : $(OBJECTS) $(SCHEME_OBJECTS) scm-cl3.lst
+## $(link) $(linkdebug) $(sysflags) -out:scheme.exe @scm-cl3.lst $(syslibs) crtdll.lib
+ $(link) $(sysflags) -out:scheme.exe @scm-cl3.lst $(syslibs) crtdll.lib
+bchschem.exe : $(BCHOBJECTS) $(SCHEME_OBJECTS) bch-cl3.lst
+## $(link) $(linkdebug) $(sysflags) -out:bchschem.exe @bch-cl3.lst $(syslibs) crtdll.lib
+ $(link) $(sysflags) -out:bchschem.exe @bch-cl3.lst $(syslibs) crtdll.lib
findprim.exe : findprim.obj
$(link) $(linkdebug) $(conflags) -out:findprim.exe findprim.obj $(conlibs)
bintopsb.exe : bintopsb.obj missing.obj
ntenv.obj : scheme.tch osenv.h ntscreen.h $(NT_DEPENDENCIES)
ntfile.obj : osfile.h osio.h ntio.h $(NT_DEPENDENCIES)
ntfs.obj : osfs.h $(NT_DEPENDENCIES)
-ntio.obj : osio.h ntio.h ntscreen.h $(NT_DEPENDENCIES)
-nttop.obj : ostop.h nttop.h osctty.h errors.h option.h $(NT_DEPENDENCIES)
+ntio.obj : osio.h ntio.h ntscmlib.h ntscreen.h $(NT_DEPENDENCIES)
+nttop.obj : ostop.h nttop.h osctty.h errors.h option.h ntscmlib.h \
+ $(NT_DEPENDENCIES)
nttty.obj : ostty.h osenv.h osio.h ntio.h osterm.h ntterm.h $(NT_DEPENDENCIES)
ntsig.obj : ossig.h osctty.h ostty.h critsec.h \
$(NT_DEPENDENCIES) ntgui.h ntio.h ntscmlib.h ntscreen.h
nttrap.obj: nttrap.h ntscmlib.h $(GC_HEAD_FILES) $(NT_DEPENDENCIES)
ntsys.obj: ntsys.h
-ntgui.obj : ntgui.c ntdialog.h ntgui.h ntscreen.h $(NT_DEPENDENCIES) scheme.tch
+ntgui.obj : ntgui.c ntdialog.h ntgui.h ntscmlib.h ntscreen.h $(NT_DEPENDENCIES) scheme.tch
ntasutl.obj : ntasutl.asm
ntkbutl.obj : ntkbutl.asm
ntscreen.obj : ntscreen.c ntgui.h ntscreen.h
cmpauxmd.obj : cmpauxmd.asm
-ntscmlib.dll: ntwntlib.dll ntw32lib.dll
- copy ntwntlib.lib ntscmlib.lib
- copy ntwntlib.dll ntscmlib.dll
-ntwntlib.obj: ntwntlib.c ntscmlib.h makefile
+scheme32.obj: scheme32.c ntscmlib.h makefile
-ntwntlib.exp: ntwntlib.obj ntscmlib.def
- $(implib) -machine:$(CPU) -def:ntscmlib.def $*.obj -out:$*.lib
+scheme32.exp: scheme32.obj scheme32.def
+ $(implib) -machine:$(CPU) -def:scheme32.def $*.obj -out:$*.lib
-ntwntlib.dll: ntwntlib.obj ntwntlib.exp
+scheme32.dll: scheme32.obj scheme32.exp
$(link) $(linkdebug) -dll -out:$*.dll \
-entry:_CRT_INIT$(DLLENTRY) \
$** $(syslibs) winmm.lib crtdll.lib
-ntw32lib.obj : ntw32lib.c ntscmlib.h makefile
-ntw32lib.exp: ntw32lib.obj ntscmlib.def
- $(implib) -machine:$(CPU) -def:ntscmlib.def $*.obj -out:$*.lib
+scheme31.obj: scheme31.c ntscmlib.h makefile
+
+scheme31.exp: scheme31.obj scheme31.def
+ $(implib) -machine:$(CPU) -def:scheme32.def $*.obj -out:$*.lib
-ntw32lib.dll: ntw32lib.obj ntw32lib.exp
+scheme31.dll: scheme31.obj scheme31.exp
$(link) $(linkdebug) -dll -out:$*.dll \
-entry:ntw32lib_dllinit$(DLLENTRY) \
$** $(syslibs) w32sut32.lib
/* -*-C-*-
-$Id: scheme16.c,v 1.7 1993/09/13 18:39:57 gjr Exp $
+$Id: scheme16.c,v 1.8 1996/03/23 19:24:27 adams Exp $
-Copyright (c) 1993 Massachusetts Institute of Technology
+Copyright (c) 1993-96 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
-LIBRARY ntw16lib
-DESCRIPTION "MIT Scheme Win16 Server for Win32s DLL"
+LIBRARY scheme16
+DESCRIPTION "MIT Scheme Win16 Server for Win32S DLL"
EXETYPE WINDOWS
### -*- Fundamental -*-
###
-### $Id: scheme16.mak,v 1.3 1993/08/21 03:56:17 gjr Exp $
+### $Id: scheme16.mak,v 1.4 1996/03/23 19:24:14 adams Exp $
###
-### Copyright (c) 1993 Massachusetts Institute of Technology
+### Copyright (c) 1996 Massachusetts Institute of Technology
###
### This material as developed by the Scheme project at the
### Massachusetts Institute of Technology, Department of
#### Makefile for the 16-bit component of the MIT Scheme Win32 support
-all: ntw16lib.dll
+all: scheme16.dll
# These have to be compiled by a 16-bit compiler (e.g. C700)
# with the Win16 SDK!
-ntw16lib.obj: ntw16lib.c ntscmlib.h
- cl /c /ASw /G2 /Gsw /Ow /W2 /Zp1 ntw16lib.c
+scheme16.obj: scheme16.c ntscmlib.h
+ cl /c /ASw /G2 /Gsw /Ow /W2 /Zp1 scheme16.c
-ntw16lib.dll: ntw16lib.obj ntw16lib.def
- link ntw16lib.obj, ntw16lib.dll,ntw16lib.map /map, \
- w32sut16.lib mdllcew.lib libw.lib/noe/nod,ntw16lib.def
+scheme16.dll: scheme16.obj scheme16.def
+ link scheme16.obj, scheme16.dll,scheme16.map /map, \
+ w32sut16.lib mdllcew.lib libw.lib/noe/nod,scheme16.def
/* -*-C-*-
-$Id: scheme31.c,v 1.6 1995/10/24 05:34:23 cph Exp $
+$Id: scheme31.c,v 1.7 1996/03/23 19:24:08 adams Exp $
Copyright (c) 1993-95 Massachusetts Institute of Technology
return (crt_result);
}
\f
-BOOL
+static BOOL
win32_under_win32s_p (void)
{
return (TRUE);
}
-char *
+static char *
win32_allocate_heap (unsigned long size, unsigned long * handle)
{
LPVOID base;
return ((char *) base);
}
-void
+static void
win32_release_heap (char * area, unsigned long handle)
{
VirtualFree (((LPVOID) area),
return;
}
-BOOL
+static BOOL
win32_lock_memory_area (LPVOID area, unsigned long size)
{
struct ntw32lib_vlock_s param;
(¶m, NTW32LIB_VIRTUAL_LOCK, &translation[0])));
}
-void
+static void
win32_unlock_memory_area (LPVOID area, unsigned long size)
{
struct ntw32lib_vulock_s param;
return;
}
\f
-UINT
+static UINT
win32_install_async_timer (void ** state_ptr,
unsigned long * base,
long memtop_off,
return (result);
}
-void
+static void
win32_flush_async_timer (void * timer_state)
{
struct ntw32lib_ftimer_s param;
\f
#define I386_PAGE_SIZE 0x1000
-BOOL
+static BOOL
win32_alloc_scheme_selectors (unsigned long base,
unsigned long size,
unsigned short * scheme_cs,
return (result);
}
-void
+static void
win32_release_scheme_selectors (unsigned short scheme_cs,
unsigned short scheme_ds,
unsigned short scheme_ss)
(* call_16_bit_code) (& param, NTW32LIB_FREE_SELECTORS, &translation[0]);
return;
}
+
+
+
+void
+install_win32_system_utilities (WIN32_SYSTEM_UTILITIES *utils)
+{
+#define EXPORT(field) utils->field = win32_##field
+ EXPORT (under_win32s_p);
+ EXPORT (allocate_heap);
+ EXPORT (release_heap);
+ EXPORT (lock_memory_area);
+ EXPORT (unlock_memory_area);
+ EXPORT (install_async_timer);
+ EXPORT (flush_async_timer);
+ EXPORT (alloc_scheme_selectors);
+ EXPORT (release_scheme_selectors);
+}
-LIBRARY ntscmlib
-DESCRIPTION "MIT Scheme Win32 DLL"
+LIBRARY scheme31
+DESCRIPTION "MIT Scheme Win32S DLL"
-VERSION 0.4
+VERSION 0.5
CODE PRELOAD MOVEABLE DISCARDABLE
DATA NONE
-EXPORTS win32_under_win32s_p @ 1
- win32_allocate_heap @ 2
- win32_release_heap @ 3
- win32_lock_memory_area @ 4
- win32_unlock_memory_area @ 5
- win32_install_async_timer @ 6
- win32_flush_async_timer @ 7
- win32_alloc_scheme_selectors @ 8
- win32_release_scheme_selectors @ 9
+EXPORTS install_win32_system_utilities @ 1
/* -*-C-*-
-$Id: scheme32.c,v 1.8 1995/10/24 05:36:00 cph Exp $
+$Id: scheme32.c,v 1.9 1996/03/23 19:23:47 adams Exp $
-Copyright (c) 1993-95 Massachusetts Institute of Technology
+Copyright (c) 1993-96 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
#include "ntscmlib.h"
#include <mmsystem.h>
\f
-BOOL
+static BOOL
win32_under_win32s_p (void)
{
return ((BOOL) 0);
}
-char *
+//char *
+//win32_allocate_heap (unsigned long size, unsigned long * handle)
+//{
+//#ifdef CL386
+// extern char * malloc (unsigned long);
+//#endif
+// * handle = 0L;
+// return ((char *) (malloc (size)));
+//}
+//
+//void
+//win32_release_heap (char * base, unsigned long handle)
+//{
+// extern void free (char *);
+//
+// free (base);
+// return;
+//}
+
+
+static char *
win32_allocate_heap (unsigned long size, unsigned long * handle)
{
-#ifdef CL386
- extern char * malloc (unsigned long);
-#endif
- * handle = 0L;
- return ((char *) (malloc (size)));
+ LPVOID base;
+
+ base = (VirtualAlloc (((LPVOID) NULL),
+ ((DWORD) size),
+ ((DWORD) (MEM_RESERVE | MEM_COMMIT)),
+ ((DWORD) PAGE_READWRITE)));
+ * handle = size;
+ return ((char *) base);
}
-void
-win32_release_heap (char * base, unsigned long handle)
+static void
+win32_release_heap (char * area, unsigned long handle)
{
- extern void free (char *);
-
- free (base);
+ VirtualFree (((LPVOID) area),
+ ((DWORD) handle),
+ ((DWORD) MEM_DECOMMIT));
+ VirtualFree (((LPVOID) area),
+ ((DWORD) 0),
+ ((DWORD) MEM_RELEASE));
return;
}
-BOOL
+static BOOL
win32_lock_memory_area (void * area, unsigned long size)
{
return (VirtualLock (area, size));
}
-void
+static void
win32_unlock_memory_area (void * area, unsigned long size)
{
(void) VirtualUnlock (area, size);
return;
}
-void
+static void
win32_flush_async_timer (void * state)
{
struct win32_timer_closure_s * scm_timer
return;
}
\f
-UINT
+static UINT
win32_install_async_timer (void ** state_ptr,
unsigned long * base,
long memtop_off,
\f
/* These are NOPs in this version. */
-BOOL
+static BOOL
win32_alloc_scheme_selectors (unsigned long base,
unsigned long size,
unsigned short * scheme_cs,
return (FALSE);
}
-void
+static void
win32_release_scheme_selectors (unsigned short scheme_cs,
unsigned short scheme_ds,
unsigned short scheme_ss)
{
return;
}
+
+
+void
+install_win32_system_utilities (WIN32_SYSTEM_UTILITIES *utils)
+{
+#define EXPORT(field) utils->field = win32_##field
+ EXPORT (under_win32s_p);
+ EXPORT (allocate_heap);
+ EXPORT (release_heap);
+ EXPORT (lock_memory_area);
+ EXPORT (unlock_memory_area);
+ EXPORT (install_async_timer);
+ EXPORT (flush_async_timer);
+ EXPORT (alloc_scheme_selectors);
+ EXPORT (release_scheme_selectors);
+}
-LIBRARY ntscmlib
+LIBRARY scheme32
DESCRIPTION "MIT Scheme Win32 DLL"
-VERSION 0.4
+VERSION 0.5
CODE PRELOAD MOVEABLE DISCARDABLE
DATA NONE
-EXPORTS win32_under_win32s_p @ 1
- win32_allocate_heap @ 2
- win32_release_heap @ 3
- win32_lock_memory_area @ 4
- win32_unlock_memory_area @ 5
- win32_install_async_timer @ 6
- win32_flush_async_timer @ 7
- win32_alloc_scheme_selectors @ 8
- win32_release_scheme_selectors @ 9
+EXPORTS install_win32_system_utilities @ 1
projects / mit-scheme.git / commitdiff