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 / os2thrd.c < prev    next >
C/C++ Source or Header  |  1999-01-02  |  7KB  |  285 lines
  1. /* -*-C-*-
  2.  
  3. $Id: os2thrd.c,v 1.6 1999/01/02 06:11:34 cph Exp $
  4.  
  5. Copyright (c) 1994-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. #include "os2.h"
  23. #include "prims.h"
  24. #include "errors.h"
  25.  
  26. #ifdef __IBMC__
  27. #define HAVE_BEGINTHREAD
  28. #endif
  29.  
  30. #ifdef __WATCOMC__
  31. #include <process.h>
  32. #define HAVE_BEGINTHREAD
  33. #endif
  34.  
  35. #ifdef __EMX__
  36. #define HAVE_BEGINTHREAD
  37. #endif
  38.  
  39. extern void OS2_create_msg_queue (void);
  40. extern ULONG APIENTRY OS2_subthread_exception_handler
  41.   (PEXCEPTIONREPORTRECORD, PEXCEPTIONREGISTRATIONRECORD, PCONTEXTRECORD,
  42.    PVOID);
  43.  
  44. TID
  45. OS2_beginthread (thread_procedure_t procedure,
  46.          void * argument,
  47.          unsigned int stack_size)
  48. {
  49.   ULONG ss
  50.     = ((stack_size < 0x2000)
  51.        ? 0x2000
  52.        : ((stack_size + 0xfff) & (~0xfff)));
  53. #ifdef HAVE_BEGINTHREAD
  54.   int result = (_beginthread (procedure, 0, ss, argument));
  55.   if (result < 0)
  56.     OS2_error_system_call (ERROR_MAX_THRDS_REACHED, syscall_beginthread);
  57.   return (result);
  58. #else /* not HAVE_BEGINTHREAD */
  59.   TID tid;
  60.   STD_API_CALL (dos_create_thread,
  61.         ((&tid), ((PFNTHREAD) procedure), ((ULONG) argument), 0, ss));
  62.   return (tid);
  63. #endif /* not HAVE_BEGINTHREAD */
  64. }
  65.  
  66. void
  67. OS2_endthread (void)
  68. {
  69.   DosUnsetExceptionHandler (THREAD_EXCEPTION_HANDLER ());
  70. #ifdef HAVE_BEGINTHREAD
  71.   _endthread ();
  72. #else
  73.   dos_exit (EXIT_THREAD, 0);
  74. #endif
  75. }
  76.  
  77. void
  78. OS2_kill_thread (TID tid)
  79. {
  80.   STD_API_CALL (dos_kill_thread, (tid));
  81. }
  82.  
  83. TID
  84. OS2_current_tid (void)
  85. {
  86.   PTIB ptib;
  87.   PPIB ppib;
  88.   STD_API_CALL (dos_get_info_blocks, ((&ptib), (&ppib)));
  89.   return (ptib -> tib_ptib2 -> tib2_ultid);
  90. }
  91.  
  92. #ifndef __IBMC__
  93. #define MAX_TID 999
  94. static thread_store_t * thread_store_array [MAX_TID + 1];
  95.  
  96. thread_store_t **
  97. OS2_threadstore (void)
  98. {
  99.   TID tid = (OS2_current_tid ());
  100.   if (tid > MAX_TID)
  101.     OS2_logic_error ("Unexpectedly large TID.");
  102.   return (& (thread_store_array [tid]));
  103. }
  104. #endif
  105.  
  106. PID OS2_scheme_pid;
  107. TID OS2_scheme_tid;
  108.  
  109. static void thread_initialize_1 (qid_t);
  110. static void restore_errors (void *);
  111. static void signal_error (msg_t *);
  112. static void ignore_error (msg_t *);
  113. static void send_error (msg_t *);
  114.  
  115. void
  116. OS2_initialize_scheme_thread (void)
  117. {
  118.   SET_MSG_TYPE_LENGTH (mt_syscall_error, sm_syscall_error_t);
  119.   SET_MSG_TYPE_LENGTH (mt_error, sm_error_t);
  120.   SET_MSG_TYPE_LENGTH (mt_kill_request, sm_kill_request_t);
  121.   {
  122.     PTIB ptib;
  123.     PPIB ppib;
  124.     STD_API_CALL (dos_get_info_blocks, ((&ptib), (&ppib)));
  125.     OS2_scheme_pid = (ppib -> pib_ulpid);
  126.     OS2_scheme_tid = (ptib -> tib_ptib2 -> tib2_ultid);
  127.   }
  128.   thread_initialize_1 (QID_NONE);
  129.   (THREAD_ERROR_HOOK ()) = signal_error;
  130. }
  131.  
  132. int
  133. OS2_thread_initialize (PEXCEPTIONREGISTRATIONRECORD registration,
  134.                qid_t error_qid)
  135. {
  136.   /* Every thread has a message queue, so that we can use message
  137.      dialogs to report fatal errors to the user.  Otherwise, Scheme
  138.      will just die with no explanation.  */
  139.   OS2_create_msg_queue ();
  140.   return (OS2_thread_initialize_1 (registration, error_qid));
  141. }
  142.  
  143. int
  144. OS2_thread_initialize_1 (PEXCEPTIONREGISTRATIONRECORD registration,
  145.              qid_t error_qid)
  146. {
  147.   thread_initialize_1 (error_qid);
  148.   (registration -> ExceptionHandler) = OS2_subthread_exception_handler;
  149.   DosSetExceptionHandler (registration);
  150.   (THREAD_EXCEPTION_HANDLER ()) = registration;
  151.   (THREAD_ERROR_HOOK ()) = send_error;
  152.   return (setjmp (THREAD_ERROR_RESTART ()));
  153. }
  154.  
  155. static void
  156. thread_initialize_1 (qid_t error_qid)
  157. {
  158.   (* (OS2_threadstore ())) = (OS_malloc (sizeof (thread_store_t)));
  159.   (THREAD_ERROR_QUEUE ()) = error_qid;
  160.   ((THREAD_FATAL_ERROR_BUFFER ()) [0]) = '\0';
  161. }
  162.  
  163. char *
  164. OS2_thread_fatal_error_buffer (void)
  165. {
  166.   /* The default buffer may get used if an error occurs very early in
  167.      a thread, before the regular error buffer is allocated.  This can
  168.      easily happen in the Scheme thread, but shouldn't happen in the
  169.      other threads.  */
  170.   static char default_buffer [1024] = "";
  171.   return
  172.     (((* (OS2_threadstore ())) == 0)
  173.      ? default_buffer
  174.      : (THREAD_FATAL_ERROR_BUFFER ()));
  175. }
  176.  
  177. int
  178. OS2_error_message_p (msg_t * message)
  179. {
  180.   msg_type_t type = (MSG_TYPE (message));
  181.   return ((type == mt_syscall_error) || (type == mt_error));
  182. }
  183.  
  184. void
  185. OS2_handle_error_message (msg_t * message)
  186. {
  187.   (* (THREAD_ERROR_HOOK ())) (message);
  188. }
  189.  
  190. void
  191. OS2_ignore_errors (void)
  192. {
  193.   error_hook_t * hp = (dstack_alloc (sizeof (error_hook_t)));
  194.   (*hp) = (THREAD_ERROR_HOOK ());
  195.   transaction_record_action (tat_always, restore_errors, hp);
  196.   (THREAD_ERROR_HOOK ()) = ignore_error;
  197. }
  198.  
  199. static void
  200. restore_errors (void * hp)
  201. {
  202.   (THREAD_ERROR_HOOK ()) = (* ((error_hook_t *) hp));
  203. }
  204.  
  205. void
  206. OS2_error_system_call (int code, enum syscall_names name)
  207. {
  208.   OS2_handle_error_message (OS2_make_syscall_error (code, name));
  209. }
  210.  
  211. void
  212. OS2_error_anonymous (void)
  213. {
  214.   OS2_handle_error_message (OS2_make_error (ERR_EXTERNAL_RETURN));
  215. }
  216.  
  217. void
  218. OS2_error_unimplemented_primitive (void)
  219. {
  220.   OS2_handle_error_message (OS2_make_error (ERR_UNDEFINED_PRIMITIVE));
  221. }
  222.  
  223. void
  224. OS2_error_out_of_channels (void)
  225. {
  226.   OS2_handle_error_message (OS2_make_error (ERR_OUT_OF_FILE_HANDLES));
  227. }
  228.  
  229. static void
  230. signal_error (msg_t * message)
  231. {
  232.   switch (MSG_TYPE (message))
  233.     {
  234.     case mt_syscall_error:
  235.       {
  236.     int code = (SM_SYSCALL_ERROR_CODE (message));
  237.     enum syscall_names name = (SM_SYSCALL_ERROR_NAME (message));
  238.     OS2_destroy_message (message);
  239.     error_system_call (code, name);
  240.       }
  241.       break;
  242.     case mt_error:
  243.       {
  244.     long code = (SM_ERROR_CODE (message));
  245.     OS2_destroy_message (message);
  246.     signal_error_from_primitive (code);
  247.       }
  248.       break;
  249.     default:
  250.       OS2_logic_error ("Non-error message passed to signal_error.");
  251.       break;
  252.     }
  253. }
  254.  
  255. static void
  256. ignore_error (msg_t * message)
  257. {
  258. }
  259.  
  260. static void
  261. send_error (msg_t * message)
  262. {
  263.   if ((THREAD_ERROR_QUEUE ()) == QID_NONE)
  264.     OS2_logic_error ("send_error called when no error queue defined.");
  265.   OS2_send_message ((THREAD_ERROR_QUEUE ()), message);
  266.   longjmp ((THREAD_ERROR_RESTART ()), 1);
  267. }
  268.  
  269. msg_t *
  270. OS2_make_syscall_error (int code, enum syscall_names name)
  271. {
  272.   msg_t * message = (OS2_create_message (mt_syscall_error));
  273.   (SM_SYSCALL_ERROR_CODE (message)) = code;
  274.   (SM_SYSCALL_ERROR_NAME (message)) = name;
  275.   return (message);
  276. }
  277.  
  278. msg_t *
  279. OS2_make_error (long code)
  280. {
  281.   msg_t * message = (OS2_create_message (mt_error));
  282.   (SM_ERROR_CODE (message)) = code;
  283.   return (message);
  284. }
  285.