← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to src/c/threads_win32.d

  • Committer: Bazaar Package Importer
  • Author(s): Albin Tonnerre
  • Date: 2008-06-20 18:00:19 UTC
  • mfrom: (1.1.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20080620180019-7fbz1ln5444vtkkr
Tags: 0.9j-20080306-2ubuntu1
* Enabled unicode support. (Closes: LP #123530)
* Modify Maintainer value to match the DebianMaintainerField specification.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/c/threads_win32.d
 
1
/* -*- mode: c; c-basic-offset: 8 -*- */
1
2
/*
2
3
    threads.d -- Posix threads with support from GCC.
3
4
*/
18
19
#include <signal.h>
19
20
#include <ecl/ecl.h>
20
21
#include <ecl/internal.h>
 
22
#ifdef HAVE_SCHED_YIELD
 
23
# include <sched.h>
 
24
#endif
21
25
 
22
26
/*
23
27
 * We have to put this explicit definition here because Boehm GC
24
28
 * is designed to produce a DLL and we rather want a static
25
29
 * reference
26
30
 */
 
31
#include <windows.h>
27
32
#include <gc.h>
28
33
extern HANDLE WINAPI GC_CreateThread(
29
34
    LPSECURITY_ATTRIBUTES lpThreadAttributes, 
30
35
    DWORD dwStackSize, LPTHREAD_START_ROUTINE lpStartAddress, 
31
36
    LPVOID lpParameter, DWORD dwCreationFlags, LPDWORD lpThreadId );
32
 
 
33
37
#ifndef WITH___THREAD
34
38
DWORD cl_env_key;
35
39
#endif
220
224
}
221
225
 
222
226
cl_object
 
227
mp_process_yield(void)
 
228
{
 
229
#ifdef HAVE_SCHED_YIELD
 
230
        sched_yield();
 
231
#else
 
232
        Sleep(0); /* Use sleep(0) to yield to a >= priority thread */
 
233
#endif
 
234
        @(return)
 
235
}
 
236
 
 
237
cl_object
223
238
mp_process_enable(cl_object process)
224
239
{
225
240
        HANDLE code;
303
318
 * LOCKS or MUTEX
304
319
 */
305
320
 
306
 
@(defun mp::make-lock (&key name)
 
321
@(defun mp::make-lock (&key name ((:recursive recursive) Ct))
307
322
        cl_object output;
308
323
@
309
324
        output = cl_alloc_object(t_lock);
310
325
        output->lock.name = name;
311
326
        output->lock.mutex = CreateMutex(NULL, FALSE, NULL);
 
327
        output->lock.holder = Cnil;
 
328
        output->lock.counter = 0;
 
329
        output->lock.recursive = (recursive != Cnil);
312
330
        si_set_finalizer(output, Ct);
313
331
        @(return output)
314
332
@)
315
333
 
316
334
cl_object
 
335
mp_recursive_lock_p(cl_object lock)
 
336
{
 
337
        if (type_of(lock) != t_lock)
 
338
                FEwrong_type_argument(@'mp::lock', lock);
 
339
        @(return (lock->lock.recursive? Ct : Cnil))
 
340
}
 
341
 
 
342
cl_object
 
343
mp_lock_name(cl_object lock)
 
344
{
 
345
        if (type_of(lock) != t_lock)
 
346
                FEwrong_type_argument(@'mp::lock', lock);
 
347
        @(return lock->lock.name)
 
348
}
 
349
 
 
350
cl_object
 
351
mp_lock_holder(cl_object lock)
 
352
{
 
353
        if (type_of(lock) != t_lock)
 
354
                FEwrong_type_argument(@'mp::lock', lock);
 
355
        @(return lock->lock.holder)
 
356
}
 
357
 
 
358
cl_object
317
359
mp_giveup_lock(cl_object lock)
318
360
{
319
361
        if (type_of(lock) != t_lock)
320
362
                FEwrong_type_argument(@'mp::lock', lock);
321
 
        if (ReleaseMutex(lock->lock.mutex) == 0)
 
363
        if (lock->lock.holder != cl_env.own_process) {
 
364
                FEerror("Attempt to give up a lock ~S that is not owned by ~S.", 2,
 
365
                        lock, cl_env.own_process);
 
366
        }
 
367
        if (--lock->lock.counter == 0) {
 
368
                lock->lock.holder = Cnil;
 
369
        }
 
370
        if (ReleaseMutex(lock->lock.mutex) == 0)
322
371
                FEwin32_error("Unable to release Win32 Mutex", 0);
323
372
        @(return Ct)
324
373
}
328
377
@
329
378
        if (type_of(lock) != t_lock)
330
379
                FEwrong_type_argument(@'mp::lock', lock);
 
380
        /* In Windows, all locks are recursive. We simulate the other case. */
 
381
        if (!lock->lock.recursive && (lock->lock.holder == cl_env.own_process)) {
 
382
                FEerror("A recursive attempt was made to hold lock ~S", 1, lock);
 
383
        }
331
384
        switch (WaitForSingleObject(lock->lock.mutex, (wait==Ct?INFINITE:0))) {
332
385
                case WAIT_OBJECT_0:
 
386
                        lock->lock.holder = cl_env.own_process;
 
387
                        lock->lock.counter++;
333
388
                        output = Ct;
334
389
                        break;
335
390
                case WAIT_TIMEOUT:
345
400
        @(return output)
346
401
@)
347
402
 
 
403
/*----------------------------------------------------------------------
 
404
 * CONDITION VARIABLES
 
405
 */
 
406
 
 
407
cl_object
 
408
mp_make_condition_variable(void)
 
409
{
 
410
        FEerror("Condition variables are not supported under Windows.", 0);
 
411
        @(return Cnil)
 
412
}
 
413
 
 
414
cl_object
 
415
mp_condition_variable_wait(cl_object cv, cl_object lock)
 
416
{
 
417
        if (type_of(cv) != t_condition_variable)
 
418
                FEwrong_type_argument(@'mp::condition-variable', cv);
 
419
        if (type_of(lock) != t_lock)
 
420
                FEwrong_type_argument(@'mp::lock', lock);
 
421
        FEerror("Condition variables are not supported under Windows.", 0);
 
422
        @(return Ct)
 
423
}
 
424
 
 
425
cl_object
 
426
mp_condition_variable_timedwait(cl_object cv, cl_object lock, cl_object seconds)
 
427
{
 
428
        if (type_of(cv) != t_condition_variable)
 
429
                FEwrong_type_argument(@'mp::condition-variable', cv);
 
430
        if (type_of(lock) != t_lock)
 
431
                FEwrong_type_argument(@'mp::lock', lock);
 
432
        FEerror("Condition variables are not supported under Windows.", 0);
 
433
        @(return Cnil)
 
434
}
 
435
 
 
436
cl_object
 
437
mp_condition_variable_signal(cl_object cv)
 
438
{
 
439
        if (type_of(cv) != t_condition_variable)
 
440
                FEwrong_type_argument(@'mp::condition-variable', cv);
 
441
        FEerror("Condition variables are not supported under Windows.", 0);
 
442
        @(return Ct)
 
443
}
 
444
 
 
445
cl_object
 
446
mp_condition_variable_broadcast(cl_object cv)
 
447
{
 
448
        if (type_of(cv) != t_condition_variable)
 
449
                FEwrong_type_argument(@'mp::condition-variable', cv);
 
450
        FEerror("Condition variables are not supported under Windows.", 0);
 
451
        @(return Ct)
 
452
}
 
453
 
 
454
/*----------------------------------------------------------------------
 
455
 * INITIALIZATION
 
456
 */
 
457
 
348
458
void
349
459
init_threads()
350
460
{