~ubuntu-branches/ubuntu/feisty/cl-kmrcl/feisty

« back to all changes in this revision

Viewing changes to processes.lisp.orig

  • Committer: Bazaar Package Importer
  • Author(s): Kevin M. Rosenberg
  • Date: 2005-04-30 04:13:54 UTC
  • mfrom: (1.1.2 upstream) (2.1.1 sarge)
  • Revision ID: james.westby@ubuntu.com-20050430041354-jaeledyxbaei8co3
Tags: 1.84-1
New upstreamc

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*-
2
 
;;;; *************************************************************************
3
 
;;;; FILE IDENTIFICATION
4
 
;;;;
5
 
;;;; Name:          processes.lisp
6
 
;;;; Purpose:       Multiprocessing functions
7
 
;;;; Programmer:    Kevin M. Rosenberg
8
 
;;;; Date Started:  June 2003
9
 
;;;;
10
 
;;;; $Id: processes.lisp 8573 2004-01-29 23:30:50Z kevin $
11
 
;;;; *************************************************************************
12
 
 
13
 
(in-package #:kmrcl)
14
 
 
15
 
 
16
 
(defun make-process (name func)
17
 
  #+allegro (mp:process-run-function name func)
18
 
  #+cmu (mp:make-process func :name name)
19
 
  #+lispworks (mp:process-run-function name nil func)
20
 
  #+sb-thread (sb-thread:make-thread func)
21
 
  #-(or allegro cmu lispworks sb-thread) (funcall func)
22
 
  )
23
 
 
24
 
(defun destroy-process (process)
25
 
  #+cmu (mp:destroy-process process)
26
 
  #+allegro (mp:process-kill process)
27
 
  #+sb-thread (sb-thread:destroy-thread process)
28
 
  #+lispworks (mp:process-kill process)
29
 
  )
30
 
 
31
 
(defun make-lock (name)
32
 
  #+allegro (mp:make-process-lock :name name)
33
 
  #+cmu (mp:make-lock name)
34
 
  #+lispworks (mp:make-lock :name name)
35
 
  #+sb-thread (sb-thread:make-mutex :name name)
36
 
  )
37
 
 
38
 
(defmacro with-lock-held ((lock) &body body)
39
 
  #+allegro
40
 
  `(mp:with-process-lock (,lock) ,@body)
41
 
  #+cmu
42
 
  `(mp:with-lock-held (,lock) ,@body)
43
 
  #+lispworks
44
 
  `(mp:with-lock (,lock) ,@body)
45
 
  #+sb-thread
46
 
  `(sb-thread:with-recursive-lock (,lock) ,@body)
47
 
  #-(or allegro cmu lispworks sb-thread)
48
 
  `(progn ,@body)
49
 
  )
50
 
 
51
 
 
52
 
(defmacro with-timeout ((seconds) &body body)
53
 
  #+allegro
54
 
  `(mp:with-timeout (,seconds) ,@body)
55
 
  #+cmu
56
 
  `(mp:with-timeout (,seconds) ,@body)
57
 
  #+sb-thread
58
 
  `(sb-ext:with-timeout ,seconds ,@body)
59
 
  #-(or allegro cmu sb-thread)
60
 
  `(progn ,@body)
61
 
  )
62
 
  
63
 
(defun process-sleep (n)
64
 
  #+allegro (mp:process-sleep n)
65
 
  #-allegro (sleep n))
66