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 / scheme16.c < prev    next >
Encoding:
C/C++ Source or Header  |  1999-01-02  |  12.7 KB  |  561 lines
  1. /* -*-C-*-
  2.  
  3. $Id: scheme16.c,v 1.11 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.    Win16 side of the Win32s version.
  24.  */
  25.  
  26. #define _WINDLL
  27. #define W32SUT_16
  28. #include "ntscmlib.h"
  29. #include <dos.h>
  30.  
  31. #ifdef DEBUG
  32. #include <windows.h>
  33. int
  34. TellUser (char FAR * format, ...)
  35. {
  36.   va_list arg_ptr;
  37.   char buffer[1024];
  38.   
  39.   va_start (arg_ptr, format);
  40.   wvsprintf (&buffer[0], format, arg_ptr);
  41.   va_end (arg_ptr);
  42.   return (MessageBox (NULL,
  43.               ((LPCSTR) &buffer[0]),
  44.               ((LPCSTR) "MIT Scheme Win16 Notification"),
  45.               (MB_TASKMODAL | MB_ICONINFORMATION | MB_OK)));
  46. }
  47.  
  48. #define DEBUGGING(what) what
  49. #else
  50. #define DEBUGGING(what) do { } while (0)
  51. #endif /* DEBUG */
  52.  
  53. struct seg_desc_s
  54. {
  55.   unsigned long low;
  56.   unsigned long high;
  57. };
  58.  
  59. static BOOL
  60. DPMI_get_descriptor (UINT selector, struct seg_desc_s far * desc)
  61. {
  62.   UINT saved_es;
  63.  
  64.   _asm
  65.   {
  66.     _emit    066h
  67.     push    di
  68.     _emit    066h
  69.     push    bx
  70.     _emit    066h
  71.     xor    di,di
  72.     mov    ax,es
  73.     mov    word ptr [bp-2],ax
  74.     les    di, dword ptr 6[bp]
  75.     mov    bx, word ptr 4[bp]
  76.     mov    ax, 000bh
  77.     int    31h
  78.     jc    fail
  79.     mov    ax, word ptr [bp-2]
  80.     mov    es,ax
  81.     _emit    066h
  82.     pop    bx
  83.     _emit    066h
  84.     pop    di
  85.     mov    ax,0
  86.     leave
  87.     ret
  88.   fail:
  89.     mov    ax, word ptr [bp-2]
  90.     mov    es,ax
  91.     _emit    066h
  92.     pop    bx
  93.     _emit    066h
  94.     pop    di
  95.     mov    ax,1
  96.     leave
  97.     ret
  98.   }
  99. }
  100.  
  101. static BOOL
  102. DPMI_set_descriptor (UINT selector, struct seg_desc_s far * desc)
  103. {
  104.   UINT saved_es;
  105.  
  106.   _asm
  107.   {
  108.     _emit    066h
  109.     push    di
  110.     _emit    066h
  111.     push    bx
  112.     _emit    066h
  113.     xor    di,di
  114.     mov    ax,es
  115.     mov    word ptr [bp-2],ax
  116.     les    di, dword ptr 6[bp]
  117.     mov    bx, word ptr 4[bp]
  118.     mov    ax, 000ch
  119.     int    31h
  120.     jc    fail
  121.     mov    ax, word ptr [bp-2]
  122.     mov    es,ax
  123.     _emit    066h
  124.     pop    bx
  125.     _emit    066h
  126.     pop    di
  127.     mov    ax,0
  128.     leave
  129.     ret
  130.   fail:
  131.     mov    ax, word ptr [bp-2]
  132.     mov    es,ax
  133.     _emit    066h
  134.     pop    bx
  135.     _emit    066h
  136.     pop    di
  137.     mov    ax,1
  138.     leave
  139.     ret
  140.   }
  141. }
  142.  
  143. static DWORD
  144. win16_alloc_scheme_selectors (struct ntw32lib_selalloc_s FAR * buf)
  145. {
  146.   UINT cs_sel, ds_sel;
  147.   struct seg_desc_s desc;
  148.   unsigned long nbase, nlimit;
  149.   
  150.   ds_sel = (AllocSelector (0));
  151.   if (ds_sel == 0)
  152.     return (0L);
  153.   nbase = (GetSelectorBase (buf->ds32));
  154.  
  155.   nbase = (nbase + buf->base);
  156.   (void) DPMI_get_descriptor (buf->ds32, & desc);
  157.  
  158.   desc.low &= 0xffffUL;
  159.   desc.low |= (nbase << 16);
  160.   desc.high &= 0x00ffff00UL;
  161.   desc.high |= (nbase & 0xff000000UL);
  162.   desc.high |= ((nbase >> 16) & 0xff);
  163.   (void) DPMI_set_descriptor (ds_sel, & desc);
  164.  
  165.   cs_sel = (AllocDStoCSAlias (ds_sel));
  166.   if (cs_sel == 0)
  167.   {
  168. #if 0
  169.     FreeSelector (ds_sel);
  170. #endif
  171.     return (0L);
  172.   }
  173.   buf->cs = cs_sel;
  174.   buf->ds = ds_sel;
  175.   buf->ss = ds_sel;
  176.  
  177.   nbase = (GetSelectorBase (cs_sel));
  178.   nlimit = (GetSelectorLimit (cs_sel));
  179.  
  180.   if ((nbase != 0) && (nlimit != 0))
  181.     return (1L);
  182.   else
  183.   {
  184. #if 0
  185.     FreeSelector (cs_sel);
  186.     FreeSelector (ds_sel);      
  187. #endif
  188.     return (0L);
  189.   }
  190. }
  191.  
  192. static DWORD
  193. win16_release_scheme_selectors (struct ntw32lib_selfree_s FAR * buf)
  194. {
  195. #if 0
  196.   if ((buf->ds != 0) && (buf->ds != buf->ds32))
  197.     FreeSelector (buf->ds);
  198.   if ((buf->cs != 0) && (buf->cs != buf->cs32))
  199.     FreeSelector (buf->cs);
  200. #endif
  201.   return (1L);
  202. }
  203.  
  204. static BOOL
  205. DPMI_lock_unlock (UINT fun, unsigned long lin, unsigned long nbytes)
  206. {
  207.   _asm
  208.   {
  209.         push    si
  210.     push    di
  211.     push    bx
  212.  
  213.     mov    ax, 4[bp]
  214.     mov    cx, 6[bp]
  215.     mov    bx, 8[bp]
  216.     mov    di, 10[bp]
  217.     mov    si, 12[bp]
  218.  
  219.     int    31h
  220.     jc    fail
  221.     mov    ax,1
  222.     jmp    join
  223.  
  224.     fail:
  225.     xor    ax,ax
  226.     join:
  227.     pop    bx
  228.     pop    di
  229.     pop    si
  230.     leave
  231.     ret
  232.   }
  233. }
  234.  
  235. static BOOL
  236. pagelockunlock (unsigned int dpmi_fun, void FAR * low, unsigned long nbytes)
  237. {
  238.   unsigned int seg, off;
  239.   unsigned long base, lin;
  240.  
  241.   seg = (FP_SEG (low));
  242.   off = (FP_OFF (low));
  243.   base = (GetSelectorBase (seg));
  244.   lin = (base + ((unsigned long) off));
  245.  
  246.   return (DPMI_lock_unlock (dpmi_fun, lin, nbytes));
  247. }
  248.  
  249. static BOOL
  250. pagelock (void FAR * low, unsigned long nbytes)
  251. {
  252.   return (pagelockunlock (0x0600, low, nbytes));
  253. }
  254.  
  255. static BOOL
  256. pageunlock (void FAR * low, unsigned long nbytes)
  257. {
  258.   return (pagelockunlock (0x0601, low, nbytes));
  259. }
  260.  
  261. static DWORD
  262. win16_lock_area (struct ntw32lib_vlock_s FAR * buf)
  263. {
  264.   return ((DWORD) (pagelock (buf->area, buf->size)));
  265. }
  266.  
  267. static DWORD
  268. win16_unlock_area (struct ntw32lib_vulock_s FAR * buf)
  269. {
  270.   return ((DWORD) (pageunlock (buf->area, buf->size)));  
  271. }
  272.  
  273. #ifndef MK_FP
  274. static void FAR * 
  275. MK_FP (unsigned short seg, unsigned short off)
  276. {
  277.   union
  278.   {
  279.     struct
  280.     {
  281.       unsigned short off;
  282.       unsigned short seg;
  283.     } split;
  284.     void FAR * result;
  285.   } views;
  286.  
  287.   views.split.seg = seg;
  288.   views.split.off = off;
  289.   return (views.result);
  290. }
  291. #endif /* MK_FP */
  292.  
  293. static WORD htimer = 0;
  294. static unsigned long timer_index = 0;
  295. static WORD (FAR PASCAL * KillSystemTimer) (WORD htimer);
  296.  
  297. static struct ntw16lib_itimer_s
  298. {
  299.   struct ntw16lib_itimer_s FAR * next;
  300.   unsigned long index;
  301.   unsigned long FAR * base;
  302.   long memtop_off;
  303.   long int_code_off;
  304.   long int_mask_off;
  305.   unsigned long bit_mask;
  306.   long ctr_off;
  307.   UINT catatonia_message;
  308.   UINT interrupt_message;
  309.   HWND window;
  310.   UINT selector;
  311.   HGLOBAL ghan;
  312. } FAR * async_timers = ((struct ntw16lib_itimer_s FAR *) NULL);
  313.  
  314. #define INTERRUPT_CODE(scm_timer)                    \
  315.   ((scm_timer -> base) [scm_timer -> int_code_off])
  316.  
  317. #define INTERRUPT_MASK(scm_timer)                    \
  318.   ((scm_timer -> base) [scm_timer -> int_mask_off])
  319.  
  320. #define MEMTOP(scm_timer)                        \
  321.   ((scm_timer -> base) [scm_timer -> memtop_off])
  322.  
  323. #define CATATONIA_COUNTER(scm_timer)                    \
  324.   ((scm_timer -> base) [scm_timer -> ctr_off])
  325.  
  326. #define CATATONIA_LIMIT(scm_timer)                    \
  327.   ((scm_timer -> base) [(scm_timer -> ctr_off) + 1])
  328.  
  329. #define CATATONIA_FLAG(scm_timer)                    \
  330.   ((scm_timer -> base) [(scm_timer -> ctr_off) + 2])
  331.  
  332. void FAR _export 
  333. scheme_asynctimer (void)
  334. {
  335.   struct ntw16lib_itimer_s FAR * scm_timer;
  336.  
  337.   for (scm_timer = async_timers;
  338.        scm_timer != ((struct ntw16lib_itimer_s FAR *) NULL);
  339.        scm_timer = scm_timer->next)
  340.     {
  341.       (INTERRUPT_CODE (scm_timer)) |= (scm_timer -> bit_mask);
  342.       if (((INTERRUPT_CODE (scm_timer)) & (INTERRUPT_MASK (scm_timer)))
  343.       != 0L)
  344.     {
  345.       (MEMTOP (scm_timer)) = ((unsigned long) -1L);
  346.       PostMessage ((scm_timer -> window),
  347.                (scm_timer -> interrupt_message),
  348.                ((WPARAM) 0),
  349.                ((LPARAM) 0));
  350.     }
  351.       (CATATONIA_COUNTER (scm_timer)) += 1L;
  352.       if (((CATATONIA_COUNTER (scm_timer)) > (CATATONIA_LIMIT (scm_timer)))
  353.       && ((CATATONIA_LIMIT (scm_timer)) != 0L))
  354.     {
  355.       if ((CATATONIA_FLAG (scm_timer)) == 0L)
  356.         {
  357.           (CATATONIA_FLAG (scm_timer)) = 1L;
  358.           PostMessage ((scm_timer -> window),
  359.                (scm_timer -> catatonia_message),
  360.                ((WPARAM) 0),
  361.                ((LPARAM) 0));
  362.         }
  363.       (CATATONIA_COUNTER (scm_timer)) = 0L;
  364.     }
  365.     }
  366. }
  367.  
  368. static void
  369. scheme_asynctimer_end (void)
  370. {
  371. }
  372.  
  373. static void
  374. possibly_uninstall_async_handler (void)
  375. {
  376.   if (async_timers != ((struct ntw16lib_itimer_s FAR *) NULL))
  377.     return;
  378.   DEBUGGING (TellUser ("Un-Installing asynctimer."));
  379.   if (htimer != 0)
  380.   {
  381.     KillSystemTimer (htimer);
  382.     htimer = 0;
  383.   }
  384.   pageunlock (&async_timers,
  385.           (sizeof (struct ntw16lib_itimer_s FAR *)));
  386.   pageunlock (((void FAR *) scheme_asynctimer),
  387.           ((unsigned long) scheme_asynctimer_end)
  388.           - ((unsigned long) scheme_asynctimer));
  389.   return;
  390. }
  391.  
  392. static DWORD
  393. win16_flush_timer (struct ntw32lib_ftimer_s FAR * buf)
  394. {
  395.   unsigned long index = buf->handle;
  396.   struct ntw16lib_itimer_s FAR * FAR * ptr = & async_timers;
  397.  
  398.   while ((* ptr) != ((struct ntw16lib_itimer_s FAR *) NULL))
  399.   {
  400.     if (((* ptr) -> index) == index)
  401.     {
  402.       struct ntw16lib_itimer_s FAR * current = (* ptr);
  403.  
  404.       (* ptr) = current->next;
  405.       if (index == (timer_index - 1))
  406.     timer_index = index;
  407.       FreeSelector (current->selector);
  408.       GlobalPageUnlock (current->ghan);
  409.       GlobalUnlock (current->ghan);
  410.       GlobalFree (current->ghan);
  411.       possibly_uninstall_async_handler ();
  412.       return (1L);
  413.     }
  414.     ptr = & ((* ptr) -> next);
  415.   }
  416.   return (0L);
  417. }
  418.  
  419. static DWORD
  420. do_install_async_handler (void)
  421. {
  422.   WORD (FAR PASCAL * CreateSystemTimer) (WORD rate, FARPROC callback);
  423.   HINSTANCE hsystem;
  424.  
  425.   DEBUGGING (TellUser ("Installing asynctimer."));
  426.   if (! (pagelock (((void FAR *) scheme_asynctimer),
  427.            ((unsigned long) scheme_asynctimer_end)
  428.            - ((unsigned long) scheme_asynctimer))))
  429.     return (WIN32_ASYNC_TIMER_NOLOCK);
  430.   else if (! (pagelock (&async_timers,
  431.             (sizeof (struct ntw16lib_itimer_s FAR *)))))
  432.   {
  433.     pageunlock (((void FAR *) scheme_asynctimer),
  434.         ((unsigned long) scheme_asynctimer_end)
  435.         - ((unsigned long) scheme_asynctimer));
  436.     return (WIN32_ASYNC_TIMER_NOLOCK);
  437.   }
  438.  
  439.   hsystem = (GetModuleHandle ("SYSTEM"));
  440.   CreateSystemTimer = (GetProcAddress (hsystem, "CREATESYSTEMTIMER"));
  441.   KillSystemTimer = (GetProcAddress (hsystem, "KILLSYSTEMTIMER"));
  442.  
  443.   if ((CreateSystemTimer == ((WORD (FAR PASCAL *) (WORD, FARPROC)) NULL))
  444.       || (KillSystemTimer == ((WORD (FAR PASCAL *) (WORD)) NULL)))
  445.   {
  446.     possibly_uninstall_async_handler ();
  447.     return (WIN32_ASYNC_TIMER_NONE);
  448.   }
  449.  
  450.   htimer = (CreateSystemTimer (55, ((FARPROC) scheme_asynctimer)));
  451.   if (htimer == 0)
  452.   {
  453.     possibly_uninstall_async_handler ();
  454.     return (WIN32_ASYNC_TIMER_EXHAUSTED);
  455.   }
  456.   return (WIN32_ASYNC_TIMER_OK);
  457. }
  458.  
  459. static DWORD
  460. win16_install_timer (struct ntw32lib_itimer_s FAR * buf)
  461. {
  462.   struct ntw16lib_itimer_s FAR * scm_timer;
  463.   DWORD result;
  464.   HGLOBAL ghan;
  465.  
  466.   if (htimer == 0)
  467.   {
  468.     result = (do_install_async_handler ());
  469.     if (result != WIN32_ASYNC_TIMER_OK)
  470.       return (result);
  471.   }
  472.  
  473.   ghan = (GlobalAlloc (GMEM_FIXED, (sizeof (struct ntw16lib_itimer_s))));
  474.   if (ghan == ((HGLOBAL) NULL))
  475.   {
  476.     possibly_uninstall_async_handler ();
  477.     return (WIN32_ASYNC_TIMER_NOMEM);
  478.   }
  479.   scm_timer = ((struct ntw16lib_itimer_s FAR *) (GlobalLock (ghan)));
  480.   if (scm_timer == ((struct ntw16lib_itimer_s FAR *) NULL))
  481.   {
  482.     GlobalFree (ghan);
  483.     possibly_uninstall_async_handler ();
  484.     return (WIN32_ASYNC_TIMER_NOLOCK);
  485.   }
  486.   if ((GlobalPageLock (ghan)) == 0)
  487.   {
  488.     GlobalUnlock (ghan);
  489.     GlobalFree (ghan);
  490.     possibly_uninstall_async_handler ();
  491.     return (WIN32_ASYNC_TIMER_NOLOCK);
  492.   }
  493.  
  494.   scm_timer->selector = (AllocSelector (FP_SEG (buf->base)));
  495.   if (scm_timer->selector == 0)
  496.   {
  497.     GlobalPageUnlock (ghan);
  498.     GlobalUnlock (ghan);
  499.     GlobalFree (ghan);
  500.     possibly_uninstall_async_handler ();
  501.     return (WIN32_ASYNC_TIMER_NOLDT);
  502.   }
  503.  
  504.   scm_timer->next = async_timers;
  505.   scm_timer->index = timer_index++;
  506.   scm_timer->base = (MK_FP (scm_timer->selector, (FP_OFF (buf->base))));
  507.   scm_timer->memtop_off = buf->memtop_off;
  508.   scm_timer->int_code_off = buf->int_code_off;
  509.   scm_timer->int_mask_off = buf->int_mask_off;
  510.   scm_timer->bit_mask = buf->bit_mask;
  511.   scm_timer->ctr_off = buf->ctr_off;
  512.   scm_timer->catatonia_message = ((UINT) buf->catatonia_message);
  513.   scm_timer->interrupt_message = ((UINT) buf->interrupt_message);
  514.   scm_timer->window = ((HWND) buf->window);
  515.   scm_timer->ghan = ghan;
  516.  
  517.   buf->handle = scm_timer->index;
  518.   async_timers = scm_timer;
  519.  
  520.   return (WIN32_ASYNC_TIMER_OK);
  521. }
  522.  
  523. /* The 32-bit call-back thunk is not really needed right now, but ... */
  524.  
  525. static UT16CBPROC call_32_bit_code = NULL;
  526.  
  527. DWORD FAR PASCAL
  528. ntw16lib_init (UT16CBPROC call_back, LPVOID buff)
  529. {
  530.   call_32_bit_code = call_back;
  531.   return (1L);
  532. }
  533.  
  534. DWORD FAR PASCAL
  535. ntw16lib_handler (LPVOID buf, DWORD func)
  536. {
  537.   switch (func)
  538.   {
  539.     case NTW32LIB_VIRTUAL_LOCK:
  540.       return (win16_lock_area (buf));
  541.  
  542.     case NTW32LIB_VIRTUAL_UNLOCK:
  543.       return (win16_unlock_area (buf));
  544.  
  545.     case NTW32LIB_INSTALL_TIMER:
  546.       return (win16_install_timer (buf));
  547.  
  548.     case NTW32LIB_FLUSH_TIMER:
  549.       return (win16_flush_timer (buf));
  550.  
  551.     case NTW32LIB_ALLOC_SELECTORS:
  552.       return (win16_alloc_scheme_selectors (buf));
  553.  
  554.     case NTW32LIB_FREE_SELECTORS:
  555.       return (win16_release_scheme_selectors (buf));
  556.  
  557.     default:
  558.       return (0L);
  559.   }
  560. }
  561.