home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / microcode / ntutl / scheme32.c < prev    next >
Encoding:
C/C++ Source or Header  |  1999-01-02  |  7.9 KB  |  278 lines
  1. /* -*-C-*-
  2.  
  3. $Id: scheme32.c,v 1.17 1999/01/02 06:11:34 cph Exp $
  4.  
  5. Copyright (c) 1993-1999 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. */
  21.  
  22. /* MIT Scheme under Windows system utiltities DLL source.
  23.    True NT (vs. Win32s) version 
  24.  */
  25.  
  26. #include "ntscmlib.h"
  27. #include <stdlib.h>
  28. #include <process.h>
  29.  
  30. static void __cdecl win32_flush_async_timer (void *);
  31. static unsigned int WINAPI timer_thread_proc (void *);
  32.  
  33. #ifndef WIN32_TIMER_INTERVAL
  34. #define WIN32_TIMER_INTERVAL 50
  35. #endif
  36.  
  37. static BOOL __cdecl
  38. win32_under_win32s_p (void)
  39. {
  40.   return ((BOOL) 0);
  41. }
  42.  
  43. //char *
  44. //win32_allocate_heap (unsigned long size, unsigned long * handle)
  45. //{
  46. //#ifdef CL386
  47. //  extern char * malloc (unsigned long);
  48. //#endif
  49. //  * handle = 0L;
  50. //  return ((char *) (malloc (size)));
  51. //}
  52. //
  53. //void
  54. //win32_release_heap (char * base, unsigned long handle)
  55. //{
  56. //  extern void free (char *);
  57. //
  58. //  free (base);
  59. //  return;
  60. //}
  61.  
  62.  
  63. static char * __cdecl
  64. win32_allocate_heap (unsigned long size, unsigned long * handle)
  65. {
  66.   LPVOID base;
  67.  
  68.   base = (VirtualAlloc (((LPVOID) NULL),
  69.             ((DWORD) size),
  70.             ((DWORD) (MEM_RESERVE | MEM_COMMIT)),
  71.             ((DWORD) PAGE_READWRITE)));
  72.   * handle = size;
  73.   return ((char *) base);
  74. }
  75.  
  76. static void __cdecl
  77. win32_release_heap (char * area, unsigned long handle)
  78. {
  79.   VirtualFree (((LPVOID) area),
  80.            ((DWORD) handle),
  81.            ((DWORD) MEM_DECOMMIT));
  82.   VirtualFree (((LPVOID) area),
  83.            ((DWORD) 0),
  84.            ((DWORD) MEM_RELEASE));
  85.   return;
  86. }
  87.  
  88. static BOOL __cdecl
  89. win32_lock_memory_area (void * area, unsigned long size)
  90. {
  91.   return (VirtualLock (area, size));
  92. }
  93.  
  94. static void __cdecl
  95. win32_unlock_memory_area (void * area, unsigned long size)
  96. {
  97.   (void) VirtualUnlock (area, size);
  98. }
  99.  
  100. /* Asynchronous timer interrupt based on auxiliary thread.  */
  101.  
  102. struct win32_timer_closure_s
  103. {
  104.   unsigned long interval;    /* timer interval in milliseconds */
  105.   unsigned long * base;        /* register-block base address */
  106.   long memtop_off;        /* offset to memtop register */
  107.   long int_code_off;        /* offset to int_code register */
  108.   long int_mask_off;        /* offset to int_mask register */
  109.   unsigned long bit_mask;    /* interrupt bits to signal */
  110.   long ctr_off;            /* offset to catatonia-counter register */
  111.   unsigned long catatonia_message; /* message to send for catatonia */
  112.   unsigned long interrupt_message; /* message to send for interrupt */
  113.   HWND window;            /* window to send the messages to */
  114.   void (*grab_int_regs) (void);    /* grab interrupt registers */
  115.   void (*release_int_regs) (void); /* release interrupt registers */
  116.   HANDLE thread_handle;        /* handle of timer thread */
  117.   int exit_thread;        /* set this true to terminate thread */
  118. };
  119.  
  120. static UINT __cdecl
  121. win32_install_async_timer (void ** state_ptr,
  122.                unsigned long * base,
  123.                long memtop_off,
  124.                long int_code_off,
  125.                long int_mask_off,
  126.                unsigned long bit_mask,
  127.                long ctr_off,
  128.                unsigned long catatonia_message,
  129.                unsigned long interrupt_message,
  130.                HWND window,
  131.                void (*grab_int_regs) (void),
  132.                void (*release_int_regs) (void))
  133. {
  134.   struct win32_timer_closure_s * scm_timer;
  135.   unsigned int id;
  136.  
  137.   scm_timer
  138.     = ((struct win32_timer_closure_s *)
  139.        (malloc (sizeof (struct win32_timer_closure_s))));
  140.   if (scm_timer == 0)
  141.     return (WIN32_ASYNC_TIMER_NOMEM);
  142.   (scm_timer -> interval) = WIN32_TIMER_INTERVAL;
  143.   (scm_timer -> base) = base;
  144.   (scm_timer -> memtop_off) = memtop_off;
  145.   (scm_timer -> int_code_off) = int_code_off;
  146.   (scm_timer -> int_mask_off) = int_mask_off;
  147.   (scm_timer -> bit_mask) = bit_mask;
  148.   (scm_timer -> ctr_off) = ctr_off;
  149.   (scm_timer -> catatonia_message) = catatonia_message;
  150.   (scm_timer -> interrupt_message) = interrupt_message;
  151.   (scm_timer -> window) = window;
  152.   (scm_timer -> grab_int_regs) = grab_int_regs;
  153.   (scm_timer -> release_int_regs) = release_int_regs;
  154.   (scm_timer -> exit_thread) = 0;
  155.   (scm_timer -> thread_handle)
  156.     = ((HANDLE)
  157.        (_beginthreadex (0, 0x2000, timer_thread_proc, scm_timer, 0, (&id))));
  158.   if (scm_timer -> thread_handle)
  159.     {
  160.       (*state_ptr) = scm_timer;
  161.       return (WIN32_ASYNC_TIMER_OK);
  162.     }
  163.   else
  164.     {
  165.       win32_flush_async_timer (scm_timer);
  166.       return (WIN32_ASYNC_TIMER_EXHAUSTED);
  167.     }
  168. }
  169.  
  170. static void __cdecl
  171. win32_flush_async_timer (void * state)
  172. {
  173.   if (state != 0)
  174.     {
  175.       struct win32_timer_closure_s * scm_timer = state;
  176.       if (scm_timer -> thread_handle)
  177.     {
  178.       (scm_timer -> exit_thread) = 1;
  179.       (void) WaitForSingleObject ((scm_timer -> thread_handle), INFINITE);
  180.     }
  181.       (void) free (state);
  182.     }
  183. }
  184.  
  185. #define INTERRUPT_CODE(scm_timer)                    \
  186.   ((scm_timer -> base) [scm_timer -> int_code_off])
  187.  
  188. #define INTERRUPT_MASK(scm_timer)                    \
  189.   ((scm_timer -> base) [scm_timer -> int_mask_off])
  190.  
  191. #define MEMTOP(scm_timer)                        \
  192.   ((scm_timer -> base) [scm_timer -> memtop_off])
  193.  
  194. #define CATATONIA_COUNTER(scm_timer)                    \
  195.   ((scm_timer -> base) [scm_timer -> ctr_off])
  196.  
  197. #define CATATONIA_LIMIT(scm_timer)                    \
  198.   ((scm_timer -> base) [(scm_timer -> ctr_off) + 1])
  199.  
  200. #define CATATONIA_FLAG(scm_timer)                    \
  201.   ((scm_timer -> base) [(scm_timer -> ctr_off) + 2])
  202.  
  203. static unsigned int WINAPI
  204. timer_thread_proc (void * envptr)
  205. {
  206.   struct win32_timer_closure_s * scm_timer = envptr;
  207.   while (! (scm_timer -> exit_thread))
  208.     {
  209.       Sleep (scm_timer -> interval);
  210.       (* (scm_timer -> grab_int_regs)) ();
  211.       (INTERRUPT_CODE (scm_timer)) |= (scm_timer -> bit_mask);
  212.       if (((INTERRUPT_CODE (scm_timer)) & (INTERRUPT_MASK (scm_timer))) != 0L)
  213.     {
  214.       (MEMTOP (scm_timer)) = ((unsigned long) -1L);
  215.       /* Post an interrupt message to the window.  This forces it to
  216.          wake up and exit MsgWaitForMultipleObjects if needed.  */
  217.       (* (scm_timer -> release_int_regs)) ();
  218.       PostMessage ((scm_timer -> window),
  219.                (scm_timer -> interrupt_message),
  220.                ((WPARAM) 0),
  221.                ((LPARAM) 0));
  222.     }
  223.       else
  224.     (* (scm_timer -> release_int_regs)) ();
  225.       (CATATONIA_COUNTER (scm_timer)) += 1L;
  226.       if (((CATATONIA_COUNTER (scm_timer)) > (CATATONIA_LIMIT (scm_timer)))
  227.       && ((CATATONIA_LIMIT (scm_timer)) != 0L))
  228.     {
  229.       if ((CATATONIA_FLAG (scm_timer)) == 0L)
  230.         {
  231.           (CATATONIA_FLAG (scm_timer)) = 1L;
  232.           PostMessage ((scm_timer -> window),
  233.                (scm_timer -> catatonia_message),
  234.                ((WPARAM) 0),
  235.                ((LPARAM) 0));
  236.         }
  237.       (CATATONIA_COUNTER (scm_timer)) = 0L;
  238.     }
  239.     }
  240.   return (0);
  241. }
  242.  
  243. /* These are NOPs in this version. */
  244.  
  245. static BOOL __cdecl
  246. win32_alloc_scheme_selectors (unsigned long base,
  247.                   unsigned long size,
  248.                   unsigned short * scheme_cs,
  249.                   unsigned short * scheme_ds,
  250.                   unsigned short * scheme_ss)
  251. {
  252.   return (FALSE);
  253. }
  254.  
  255. static void __cdecl
  256. win32_release_scheme_selectors (unsigned short scheme_cs,
  257.                 unsigned short scheme_ds,
  258.                 unsigned short scheme_ss)
  259. {
  260.   return;
  261. }
  262.  
  263.  
  264. void FAR WINAPI
  265. install_win32_system_utilities (WIN32_SYSTEM_UTILITIES *utils)
  266. {
  267. #define EXPORT(field) utils->field = win32_##field
  268.   EXPORT (under_win32s_p);
  269.   EXPORT (allocate_heap);
  270.   EXPORT (release_heap);
  271.   EXPORT (lock_memory_area);
  272.   EXPORT (unlock_memory_area);
  273.   EXPORT (install_async_timer);
  274.   EXPORT (flush_async_timer);
  275.   EXPORT (alloc_scheme_selectors);
  276.   EXPORT (release_scheme_selectors);
  277. }
  278.