From 280d97bca7ee854d24ff65a1fc1db6b91a6b4dca Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Tue, 27 Jul 1993 20:56:07 +0000 Subject: [PATCH] Initial revision --- v7/src/microcode/memmag.h | 68 +++++++ v7/src/microcode/ntscmlib.h | 61 ++++++ v7/src/microcode/ntutl/scheme16.c | 193 +++++++++++++++++++ v7/src/microcode/ntutl/scheme16.def | 14 ++ v7/src/microcode/ntutl/scheme16.mak | 59 ++++++ v7/src/microcode/ntutl/scheme31.c | 280 ++++++++++++++++++++++++++++ v7/src/microcode/ntutl/scheme31.def | 15 ++ v7/src/microcode/ntutl/scheme32.c | 180 ++++++++++++++++++ v7/src/microcode/ntutl/scheme32.def | 15 ++ 9 files changed, 885 insertions(+) create mode 100644 v7/src/microcode/memmag.h create mode 100644 v7/src/microcode/ntscmlib.h create mode 100644 v7/src/microcode/ntutl/scheme16.c create mode 100644 v7/src/microcode/ntutl/scheme16.def create mode 100644 v7/src/microcode/ntutl/scheme16.mak create mode 100644 v7/src/microcode/ntutl/scheme31.c create mode 100644 v7/src/microcode/ntutl/scheme31.def create mode 100644 v7/src/microcode/ntutl/scheme32.c create mode 100644 v7/src/microcode/ntutl/scheme32.def diff --git a/v7/src/microcode/memmag.h b/v7/src/microcode/memmag.h new file mode 100644 index 000000000..159a67510 --- /dev/null +++ b/v7/src/microcode/memmag.h @@ -0,0 +1,68 @@ +/* -*-C-*- + +$Id: memmag.h,v 1.1 1993/07/27 20:56:07 gjr Exp $ + +Copyright (c) 1993 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +Technology nor of any adaptation thereof in any advertising, +promotional, or sales literature without prior written consent from +MIT in each case. */ + +/* OS-dependent conditionalization of memory management stuff. */ + +#ifndef SCM_MEMMAG_H +#define SCM_MEMMAG_H + +#ifdef WINNT + +static unsigned long scheme_heap_handle; + +extern char * win32_allocate_heap (unsigned long, unsigned long *); +extern void win32_release_heap (char *, unsigned long); +extern void winnt_allocate_registers (void); +extern void winnt_deallocate_registers (void); + +#define HEAP_MALLOC(size) (win32_allocate_heap (size, &scheme_heap_handle)) +#define HEAP_FREE(base) win32_release_heap (((char *) (base)), scheme_heap_handle) +#define ALLOCATE_REGISTERS winnt_allocate_registers +#define DEALLOCATE_REGISTERS winnt_deallocate_registers + +#endif /* WINNT */ + +#ifndef HEAP_FREE +# define HEAP_FREE free +#endif + +#ifndef ALLOCATE_REGISTERS +# define ALLOCATE_REGISTERS() do { } while (0) +#endif + +#ifndef DEALLOCATE_REGISTERS +# define DEALLOCATE_REGISTERS() do { } while (0) +#endif + +#endif /* SCM_MEMMAG_H */ diff --git a/v7/src/microcode/ntscmlib.h b/v7/src/microcode/ntscmlib.h new file mode 100644 index 000000000..0db17710e --- /dev/null +++ b/v7/src/microcode/ntscmlib.h @@ -0,0 +1,61 @@ +/* -*-C-*- + +$Id: ntscmlib.h,v 1.1 1993/07/27 20:53:51 gjr Exp $ + +Copyright (c) 1993 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +Technology nor of any adaptation thereof in any advertising, +promotional, or sales literature without prior written consent from +MIT in each case. */ + +/* MIT Scheme under Windows system utilities exports. */ + +#ifndef SCM_NTLIB_H + +#include + +#define WIN32_ASYNC_TIMER_OK 0 +#define WIN32_ASYNC_TIMER_NONE 1 +#define WIN32_ASYNC_TIMER_EXHAUSTED 2 +#define WIN32_ASYNC_TIMER_RESOLUTION 3 +#define WIN32_ASYNC_TIMER_NOLOCK 4 +#define WIN32_ASYNC_TIMER_NOMEM 5 + +extern BOOL win32_under_win32s_p (void); + +extern char * win32_allocate_heap (unsigned long, unsigned long *); +extern void win32_release_heap (char *, unsigned long); + +extern BOOL win32_lock_memory_area (void *, unsigned long); +extern void win32_unlock_memory_area (void *, unsigned long); + +extern UINT win32_install_async_timer (unsigned long *, unsigned long *, + unsigned long *, unsigned long, + void **); +extern void win32_flush_async_timer (void *); + +#endif /* SCM_NTLIB_H */ diff --git a/v7/src/microcode/ntutl/scheme16.c b/v7/src/microcode/ntutl/scheme16.c new file mode 100644 index 000000000..fd2021ca4 --- /dev/null +++ b/v7/src/microcode/ntutl/scheme16.c @@ -0,0 +1,193 @@ +/* -*-C-*- + +$Id: scheme16.c,v 1.1 1993/07/27 20:53:27 gjr Exp $ + +Copyright (c) 1993 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +Technology nor of any adaptation thereof in any advertising, +promotional, or sales literature without prior written consent from +MIT in each case. */ + +/* MIT Scheme under Windows system utiltities DLL source. + Win16 side of the Win32s version. + */ + +#define W32SUT_16 +#include +#include +#include +#include "ntw32lib.h" + +#ifndef STD_MSGBOX_STYLE +# define STD_MSGBOX_STYLE MB_OK +#endif + +static void +TellUser (char * format, unsigned long value) +{ + char buffer[128]; + + wsprintf (&buffer[0], + ((LPCSTR) format), + value); + + MessageBox (NULL, + ((LPCSTR) &buffer[0]), + ((LPCSTR) "MIT Scheme Win16 Notification"), + STD_MSGBOX_STYLE); + return; +} + +static DWORD +win16_allocate_heap (struct ntw32lib_malloc_s FAR * buf) +{ + DWORD linear_address = 0L; + DWORD handle = 0L; + UINT lose = 0; + UINT code = 0; + +#if 0 + union _REGS regs; + + regs.x.ax = 0x0501; + regs.x.bx = (HIWORD (buf->size)); + regs.x.cx = (LOWORD (buf->size)); + (void) _int86 (0x31, ®s, ®s); + + if (regs.x.cflag) + { + TellUser ("DPMI failed.", 0L); + return (0L); + } + linear_address = (MAKELONG (regs.x.cx, regs.x.bx)); + +#elif 0 + TellUser ("Trying to allocate %ld bytes.", buf->size); + + _asm les bx,DWORD PTR [bp+4] + _asm mov bx,WORD PTR es:[bx+2] + _asm mov cx,WORD PTR es:[bx] + _asm mov ax,0501H + _asm int 031h + + _asm jnc dpmi_wins + _asm mov WORD PTR [bp-10],1 + _asm jmp dpmi_merge + + _asm dpmi_wins: + _asm mov WORD PTR [bp-4],cx + _asm mov WORD PTR [bp-2],bx + _asm dpmi_merge: + +#else + + TellUser ("Trying to allocate %ld bytes.", buf->size); + + _asm les bx,DWORD PTR [bp+4] + _asm mov ecx,DWORD PTR es:[bx] + _asm mov ebx,00200000H + _asm mov edx,1 + _asm mov ax,0504H + _asm int 031H + + _asm jnc dpmi_wins + _asm mov WORD PTR [bp-10],1 + _asm mov WORD PTR [bp-12],ax + _asm jmp dpmi_merge + + _asm dpmi_wins: + _asm mov DWORD PTR [bp-4],ebx + _asm mov DWORD PTR [bp-8],esi + _asm dpmi_merge: + +#endif + + if (lose) + { + TellUser ("DPMI call failed 0x%x", ((unsigned long) code)); + return (0L); + } + + TellUser ("Linear address = 0x%lx.", linear_address); + TellUser ("Handle = 0x%lx.", handle); + buf->area = linear_address; + buf->handle = handle; + return (linear_address); +} + +static DWORD +win16_release_heap (struct ntw32lib_malloc_s FAR * buf) +{ + TellUser ("Freeing arena with handle 0x%lx", buf->handle); + + _asm les bx,DWORD PTR [bp+4] + _asm mov si,WORD PTR es:[bx+6] + _asm mov di,WORD PTR es:[bx+4] + _asm mov ax,0502H + _asm int 031H + + return (0L); +} + +/* The 32-bit call-back thunk is not really needed right now, but ... */ + +static UT16CBPROC call_32_bit_code = NULL; + +DWORD FAR PASCAL +ntw16lib_init (UT16CBPROC call_back, LPVOID buff) +{ + call_32_bit_code = call_back; + return (1L); +} + +DWORD FAR PASCAL +ntw16lib_handler (LPVOID buf, DWORD func) +{ + switch (func) + { + case NTW32LIB_MALLOC: + return (win16_allocate_heap (buf)); + + case NTW32LIB_FREE: + return (win16_release_heap (buf)); + + case NTW32LIB_VIRTUAL_LOCK: + return (1L); + + case NTW32LIB_VIRTUAL_UNLOCK: + return (1L); + + case NTW32LIB_INSTALL_TIMER: + return (0L); + + case NTW32LIB_FLUSH_TIMER: + return (0L); + + default: + return (0L); + } +} diff --git a/v7/src/microcode/ntutl/scheme16.def b/v7/src/microcode/ntutl/scheme16.def new file mode 100644 index 000000000..016ba66aa --- /dev/null +++ b/v7/src/microcode/ntutl/scheme16.def @@ -0,0 +1,14 @@ +LIBRARY ntw16lib +DESCRIPTION "MIT Scheme Win16 Server for Win32s DLL" + +EXETYPE WINDOWS + +STUB "WINSTUB.EXE" + +CODE PRELOAD MOVEABLE DISCARDABLE +DATA PRELOAD MOVEABLE SINGLE + +HEAPSIZE 1024 + +EXPORTS ntw16lib_init @ 1 + ntw16lib_handler @ 2 diff --git a/v7/src/microcode/ntutl/scheme16.mak b/v7/src/microcode/ntutl/scheme16.mak new file mode 100644 index 000000000..dfe8fd204 --- /dev/null +++ b/v7/src/microcode/ntutl/scheme16.mak @@ -0,0 +1,59 @@ +### -*- Fundamental -*- +### +### $Id: scheme16.mak,v 1.1 1993/07/27 20:53:38 gjr Exp $ +### +### Copyright (c) 1993 Massachusetts Institute of Technology +### +### This material as developed by the Scheme project at the +### Massachusetts Institute of Technology, Department of +### Electrical Engineering and Computer Science. Permission to +### copy this software, to redistribute it, and to use it for any +### purpose is granted, subject to the following restrictions and +### understandings. +### +### 1. Any copy made of this software must include this copyright +### notice in full. +### +### 2. Users of this software agree to make their best efforts (a) +### to return to the MIT Scheme project any improvements or +### extensions that they make, so that these may be included in +### future releases; and (b) to inform MIT of noteworthy uses of +### this software. +### +### 3. All materials developed as a consequence of the use of this +### software shall duly acknowledge such use, in accordance with +### the usual standards of acknowledging credit in academic +### research. +### +### 4. MIT has made no warrantee or representation that the +### operation of this software will be error-free, and MIT is +### under no obligation to provide any services, by way of +### maintenance, update, or otherwise. +### +### 5. In conjunction with products arising from the use of this +### material, there shall be no use of the name of the +### Massachusetts Institute of Technology nor of any adaptation +### thereof in any advertising, promotional, or sales literature +### without prior written consent from MIT in each case. +### + +#### Makefile for the 16-bit component of the MIT Scheme Win32 support + +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 + cl /c /ASw /Fa /G2 /Gsw /Ow /W2 /Zp1 ntw16lib.c + +# ntw16lib.dll: ntw16lib.obj ntw16lib.def +# link ntw16lib.obj libentry.obj, ntw16lib.dll,ntw16lib.map /map, \ +# w32sut16.lib mdllcew.lib libw.lib/noe/nod,ntw16lib.def + +ntw16lib.dll: ntw16lib.obj ntw16lib.def + link ntw16lib.obj, ntw16lib.dll,ntw16lib.map /map, \ + w32sut16.lib mdllcew.lib libw.lib/noe/nod,ntw16lib.def + + + diff --git a/v7/src/microcode/ntutl/scheme31.c b/v7/src/microcode/ntutl/scheme31.c new file mode 100644 index 000000000..146f916ea --- /dev/null +++ b/v7/src/microcode/ntutl/scheme31.c @@ -0,0 +1,280 @@ +/* -*-C-*- + +$Id: scheme31.c,v 1.1 1993/07/27 20:53:18 gjr Exp $ + +Copyright (c) 1993 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +Technology nor of any adaptation thereof in any advertising, +promotional, or sales literature without prior written consent from +MIT in each case. */ + +/* MIT Scheme under Windows system utiltities DLL source. + Win32s (vs. true NT) version. + */ + +#define W32SUT_32 +#include +#include +#include "ntscmlib.h" +#include "ntw32lib.h" +#include + +#include + +#ifndef STD_MSGBOX_STYLE +# define STD_MSGBOX_STYLE MB_OK +#endif + +static void +TellUser (char * format, ...) +{ + 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; +} + +static UT32PROC call_16_bit_code = NULL; + +DWORD WINAPI +called_from_16_bit_code (LPVOID buff, DWORD tag) +{ + return (0L); +} + +BOOL WINAPI +ntw32lib_dllinit (HANDLE self, DWORD reason, LPVOID reserved) +{ + static counter = 0; + + switch (reason) + { + case DLL_PROCESS_ATTACH: +#ifndef DUMMY + if (counter++ == 0) + return ((UTRegister (self, + NTW16LIB_DLL_NAME, + "ntw16lib_init", + "ntw16lib_handler", + & 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_THREAD_DETACH: + break; + + case DLL_PROCESS_DETACH: +#ifndef DUMMY + if (--counter == 0) + UTUnRegister (self); +#endif + break; + + default: + return (FALSE); + } + return (TRUE); +} + +BOOL +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) (¶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); + + * 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 +} + +BOOL +win32_lock_memory_area (LPVOID area, unsigned long size) +{ +#ifdef DUMMY + return (TRUE); +#else + struct ntw32lib_vlock_s param; + LPVOID translation[2]; + + param.area = ((SCM_VDPTR) area); + param.size = ((SCM_ULONG) size); + translation[0] = ((LPVOID) & param.area); + translation[1] = ((LPVOID) NULL); + + 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]; + + param.area = ((SCM_VDPTR) area); + param.size = ((SCM_ULONG) size); + translation[0] = ((LPVOID) & param.area); + translation[1] = ((LPVOID) NULL); + + (* call_16_bit_code) (¶m, NTW32LIB_VIRTUAL_UNLOCK, &translation[0]); + return; +#endif +} + +UINT +win32_install_async_timer (unsigned long * intcode_addr, + unsigned long * intmask_addr, + unsigned long * memtop_addr, + unsigned long bit_mask, + void ** timer_state) +{ +#ifdef DUMMY + return (0); +#else + struct ntw32lib_itimer_s param; + LPVOID translation[4]; + + param.intcode_addr = ((SCM_ULPTR) intcode_addr); + param.intmask_addr = ((SCM_ULPTR) intmask_addr); + param.memtop_addr = ((SCM_ULPTR) memtop_addr); + 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); + + * timer_state = ((void *) NULL); + return ((UINT) ((* call_16_bit_code) + (& param, NTW32LIB_INSTALL_TIMER, &translation[0]))); +#endif +} + +void +win32_flush_async_timer (void * timer_state) +{ +#ifdef DUMMY + return; +#else + struct ntw32lib_ftimer_s param; + LPVOID translation[1]; + + translation[0] = ((LPVOID) NULL); + (* call_16_bit_code) (& param, NTW32LIB_FLUSH_TIMER, &translation[0]); + return; +#endif +} diff --git a/v7/src/microcode/ntutl/scheme31.def b/v7/src/microcode/ntutl/scheme31.def new file mode 100644 index 000000000..0e326e7cf --- /dev/null +++ b/v7/src/microcode/ntutl/scheme31.def @@ -0,0 +1,15 @@ +LIBRARY ntscmlib +DESCRIPTION "MIT Scheme Win32 DLL" + +VERSION 0.3 + +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 diff --git a/v7/src/microcode/ntutl/scheme32.c b/v7/src/microcode/ntutl/scheme32.c new file mode 100644 index 000000000..cbe83e03f --- /dev/null +++ b/v7/src/microcode/ntutl/scheme32.c @@ -0,0 +1,180 @@ +/* -*-C-*- + +$Id: scheme32.c,v 1.1 1993/07/27 20:53:58 gjr Exp $ + +Copyright (c) 1993 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +Technology nor of any adaptation thereof in any advertising, +promotional, or sales literature without prior written consent from +MIT in each case. */ + +/* MIT Scheme under Windows system utiltities DLL source. + True NT (vs. Win32s) version + */ + +#include "ntscmlib.h" +#include + +BOOL +win32_under_win32s_p (void) +{ + return ((BOOL) 0); +} + +char * +win32_allocate_heap (unsigned long size, unsigned long * handle) +{ + extern char * malloc (unsigned long); + + * handle = 0L; + return ((char *) (malloc (size))); +} + +void +win32_release_heap (char * base, unsigned long handle) +{ + extern void free (char *); + + free (base); + return; +} + +BOOL +win32_lock_memory_area (void * area, unsigned long size) +{ + return (VirtualLock (area, size)); +} + +void +win32_unlock_memory_area (void * area, unsigned long size) +{ + (void) VirtualUnlock (area, size); +} + +/* Asynchronous timer interrupt based on multimedia system + * + * WARNING: the docs say that timer_tick and all that it references must + * be in a DLL witha a FIXED attribute. + * Also, it appears to need _stdcall, but mmsystem.h refutes this + */ + +struct win32_timer_closure_s +{ + unsigned long * intcode_addr; + unsigned long * intmask_addr; + unsigned long * memtop_addr; + unsigned long bit_mask; + UINT timer_id; +}; + +static void _stdcall +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); + return; +} + +void +win32_flush_async_timer (void * state) +{ + struct win32_timer_closure_s * timer_closure + = ((struct win32_timer_closure_s *) state); + + if (timer_closure->timer_id != 0) + (void) timeKillEvent (timer_closure->timer_id); + + (void) VirtualUnlock (((void *) win32_nt_timer_tick), + (((char *) win32_flush_async_timer) + - ((char *) win32_nt_timer_tick))); + (void) VirtualUnlock (timer_closure, (sizeof (struct win32_timer_closure_s))); + (void) free (timer_closure); + return; +} + +UINT +win32_install_async_timer (unsigned long * intcode_addr, + unsigned long * intmask_addr, + unsigned long * memtop_addr, + unsigned long bit_mask, + void ** state_ptr) +{ + TIMECAPS tc; + UINT wTimerRes; + UINT msInterval = 75; + UINT msTargetResolution = 50; + struct win32_timer_closure_s * timer_closure; + + if ((timeGetDevCaps (&tc, sizeof (TIMECAPS))) != TIMERR_NOERROR) + return (WIN32_ASYNC_TIMER_NONE); + wTimerRes = (min ((max (tc.wPeriodMin, msTargetResolution)), + tc.wPeriodMax)); + if ((timeBeginPeriod (wTimerRes)) == TIMERR_NOCANDO) + return (WIN32_ASYNC_TIMER_RESOLUTION); + + timer_closure = ((struct win32_timer_closure_s *) + (malloc (sizeof (struct win32_timer_closure_s)))); + + 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->bit_mask = bit_mask; + timer_closure->timer_id = 0; + + if ((! (VirtualLock (((void *) timer_closure), + (sizeof (struct win32_timer_closure_s))))) + || (! (VirtualLock (((void *) win32_nt_timer_tick), + (((char *) win32_flush_async_timer) + - ((char *) win32_nt_timer_tick)))))) + { + win32_flush_async_timer ((void *) timer_closure); + return (WIN32_ASYNC_TIMER_NOLOCK); + } + + timer_closure->timer_id + = (timeSetEvent (msInterval, + wTimerRes, + ((LPTIMECALLBACK) win32_nt_timer_tick), + ((DWORD) timer_closure), + TIME_PERIODIC)); + + if (timer_closure->timer_id == 0) + { + win32_flush_async_timer ((void *) timer_closure); + return (WIN32_ASYNC_TIMER_EXHAUSTED); + } + + * state_ptr = ((void *) timer_closure); + return (WIN32_ASYNC_TIMER_OK); +} diff --git a/v7/src/microcode/ntutl/scheme32.def b/v7/src/microcode/ntutl/scheme32.def new file mode 100644 index 000000000..0e326e7cf --- /dev/null +++ b/v7/src/microcode/ntutl/scheme32.def @@ -0,0 +1,15 @@ +LIBRARY ntscmlib +DESCRIPTION "MIT Scheme Win32 DLL" + +VERSION 0.3 + +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 -- 2.25.1