/* -*-C-*-
$Id: scheme32.c,v 1.17 1999/01/02 06:11:34 cph Exp $
Copyright (c) 1993-1999 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
/* MIT Scheme under Windows system utiltities DLL source.
True NT (vs. Win32s) version
*/
#include "ntscmlib.h"
#include <stdlib.h>
#include <process.h>
static void __cdecl win32_flush_async_timer (void *);
static unsigned int WINAPI timer_thread_proc (void *);
#ifndef WIN32_TIMER_INTERVAL
#define WIN32_TIMER_INTERVAL 50
#endif
static BOOL __cdecl
win32_under_win32s_p (void)
{
return ((BOOL) 0);
}
//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 * __cdecl
win32_allocate_heap (unsigned long size, unsigned long * handle)
{
LPVOID base;
base = (VirtualAlloc (((LPVOID) NULL),
((DWORD) size),
((DWORD) (MEM_RESERVE | MEM_COMMIT)),
((DWORD) PAGE_READWRITE)));
* handle = size;
return ((char *) base);
}
static void __cdecl
win32_release_heap (char * area, unsigned long handle)
{
VirtualFree (((LPVOID) area),
((DWORD) handle),
((DWORD) MEM_DECOMMIT));
VirtualFree (((LPVOID) area),
((DWORD) 0),
((DWORD) MEM_RELEASE));
return;
}
static BOOL __cdecl
win32_lock_memory_area (void * area, unsigned long size)
{
return (VirtualLock (area, size));
}
static void __cdecl
win32_unlock_memory_area (void * area, unsigned long size)
{
(void) VirtualUnlock (area, size);
}
/* Asynchronous timer interrupt based on auxiliary thread. */
struct win32_timer_closure_s
{
unsigned long interval; /* timer interval in milliseconds */
unsigned long * base; /* register-block base address */
long memtop_off; /* offset to memtop register */
long int_code_off; /* offset to int_code register */
long int_mask_off; /* offset to int_mask register */
unsigned long bit_mask; /* interrupt bits to signal */
long ctr_off; /* offset to catatonia-counter register */
unsigned long catatonia_message; /* message to send for catatonia */
unsigned long interrupt_message; /* message to send for interrupt */
HWND window; /* window to send the messages to */
void (*grab_int_regs) (void); /* grab interrupt registers */
void (*release_int_regs) (void); /* release interrupt registers */
HANDLE thread_handle; /* handle of timer thread */
int exit_thread; /* set this true to terminate thread */
};
static UINT __cdecl
win32_install_async_timer (void ** state_ptr,
unsigned long * base,
long memtop_off,
long int_code_off,
long int_mask_off,
unsigned long bit_mask,
long ctr_off,
unsigned long catatonia_message,
unsigned long interrupt_message,
HWND window,
void (*grab_int_regs) (void),
void (*release_int_regs) (void))
{
struct win32_timer_closure_s * scm_timer;
unsigned int id;
scm_timer
= ((struct win32_timer_closure_s *)
(malloc (sizeof (struct win32_timer_closure_s))));
if (scm_timer == 0)
return (WIN32_ASYNC_TIMER_NOMEM);
(scm_timer -> interval) = WIN32_TIMER_INTERVAL;
(scm_timer -> base) = base;
(scm_timer -> memtop_off) = memtop_off;
(scm_timer -> int_code_off) = int_code_off;
(scm_timer -> int_mask_off) = int_mask_off;
(scm_timer -> bit_mask) = bit_mask;
(scm_timer -> ctr_off) = ctr_off;
(scm_timer -> catatonia_message) = catatonia_message;
(scm_timer -> interrupt_message) = interrupt_message;
(scm_timer -> window) = window;
(scm_timer -> grab_int_regs) = grab_int_regs;
(scm_timer -> release_int_regs) = release_int_regs;
(scm_timer -> exit_thread) = 0;
(scm_timer -> thread_handle)
= ((HANDLE)
(_beginthreadex (0, 0x2000, timer_thread_proc, scm_timer, 0, (&id))));
if (scm_timer -> thread_handle)
{
(*state_ptr) = scm_timer;
return (WIN32_ASYNC_TIMER_OK);
}
else
{
win32_flush_async_timer (scm_timer);
return (WIN32_ASYNC_TIMER_EXHAUSTED);
}
}
static void __cdecl
win32_flush_async_timer (void * state)
{
if (state != 0)
{
struct win32_timer_closure_s * scm_timer = state;
if (scm_timer -> thread_handle)
{
(scm_timer -> exit_thread) = 1;
(void) WaitForSingleObject ((scm_timer -> thread_handle), INFINITE);
}
(void) free (state);
}
}
#define INTERRUPT_CODE(scm_timer) \
((scm_timer -> base) [scm_timer -> int_code_off])
#define INTERRUPT_MASK(scm_timer) \
((scm_timer -> base) [scm_timer -> int_mask_off])
#define MEMTOP(scm_timer) \
((scm_timer -> base) [scm_timer -> memtop_off])
#define CATATONIA_COUNTER(scm_timer) \
((scm_timer -> base) [scm_timer -> ctr_off])
#define CATATONIA_LIMIT(scm_timer) \
((scm_timer -> base) [(scm_timer -> ctr_off) + 1])
#define CATATONIA_FLAG(scm_timer) \
((scm_timer -> base) [(scm_timer -> ctr_off) + 2])
static unsigned int WINAPI
timer_thread_proc (void * envptr)
{
struct win32_timer_closure_s * scm_timer = envptr;
while (! (scm_timer -> exit_thread))
{
Sleep (scm_timer -> interval);
(* (scm_timer -> grab_int_regs)) ();
(INTERRUPT_CODE (scm_timer)) |= (scm_timer -> bit_mask);
if (((INTERRUPT_CODE (scm_timer)) & (INTERRUPT_MASK (scm_timer))) != 0L)
{
(MEMTOP (scm_timer)) = ((unsigned long) -1L);
/* Post an interrupt message to the window. This forces it to
wake up and exit MsgWaitForMultipleObjects if needed. */
(* (scm_timer -> release_int_regs)) ();
PostMessage ((scm_timer -> window),
(scm_timer -> interrupt_message),
((WPARAM) 0),
((LPARAM) 0));
}
else
(* (scm_timer -> release_int_regs)) ();
(CATATONIA_COUNTER (scm_timer)) += 1L;
if (((CATATONIA_COUNTER (scm_timer)) > (CATATONIA_LIMIT (scm_timer)))
&& ((CATATONIA_LIMIT (scm_timer)) != 0L))
{
if ((CATATONIA_FLAG (scm_timer)) == 0L)
{
(CATATONIA_FLAG (scm_timer)) = 1L;
PostMessage ((scm_timer -> window),
(scm_timer -> catatonia_message),
((WPARAM) 0),
((LPARAM) 0));
}
(CATATONIA_COUNTER (scm_timer)) = 0L;
}
}
return (0);
}
/* These are NOPs in this version. */
static BOOL __cdecl
win32_alloc_scheme_selectors (unsigned long base,
unsigned long size,
unsigned short * scheme_cs,
unsigned short * scheme_ds,
unsigned short * scheme_ss)
{
return (FALSE);
}
static void __cdecl
win32_release_scheme_selectors (unsigned short scheme_cs,
unsigned short scheme_ds,
unsigned short scheme_ss)
{
return;
}
void FAR WINAPI
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);
}
syntax highlighted by Code2HTML, v. 0.9.1