1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2%
3% File:           pthread_util.SL
4% Description:    various useful functions for pthreads
5% Author:         Winfried Neun, ZIB Berlin
6% Created:        5 February 2007 (SUN4 version)
7% Status:         Open Source: BSD License
8% Mode:           Lisp
9% Package:        Utilities
10%
11% Redistribution and use in source and binary forms, with or without
12% modification, are permitted provided that the following conditions are met:
13%
14%    * Redistributions of source code must retain the relevant copyright
15%      notice, this list of conditions and the following disclaimer.
16%    * Redistributions in binary form must reproduce the above copyright
17%      notice, this list of conditions and the following disclaimer in the
18%      documentation and/or other materials provided with the distribution.
19%
20% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
21% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
22% THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
23% PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR
24% CONTRIBUTORS
25% BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
26% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
27% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
28% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
29% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
30% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31% POSSIBILITY OF SUCH DAMAGE.
32%
33%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
34
35(setq status (gtwarray 1))
36(wputv status 0 42)
37
38(setq arg (gtwarray 1))
39
40  % Numbers carefully taken from a C program with sizeofs ...
41(de gtthread() (gtwarray 1))
42(de gtthread_attr() (gtwarray 9))
43(de gtthread_mutex() (gtwarray 6))
44
45(setq mutex (gtthread_mutex))
46
47(de psl_create_thread_nonblock (start argh)
48  (prog (threa)
49   (setq threa (gtthread))
50   (pthread_mutex_init mutex 0)
51   (wputv arg 0 argh)
52   (pthread_create threa (gtthread_attr)
53                (mkfixn (inf (getfcodepointer start))) arg)
54
55%   (sleep 1) (print "waiting")  (pthread_mutex_lock mutex)
56%   (print "waited")
57
58   (return (wgetv threa 0))))
59
60(de psl_create_thread (start argh)
61  (prog (threa)
62   (setq threa (gtthread))
63   (pthread_mutex_init mutex 0)
64   (wputv arg 0 argh)
65   (pthread_create threa (gtthread_attr)
66		(mkfixn (inf (getfcodepointer start))) arg)
67
68%   (sleep 1) (print "waiting")  (pthread_mutex_lock mutex)
69%   (print "waited")
70
71   (pthread_join (wgetv threa 0) status)
72   (return (wgetv status 0))))
73
74(de guinea-pig ()
75%%%                     (pthread_mutex_lock mutex)
76%%%			(sleep 10)
77%%%                     (pthread_mutex_unlock mutex)
78      (pthread_exit (apply (car (wgetv arg 0)) (cdr (wgetv arg 0)))))
79
80
81(load nbig32)
82(de pthread_karatsuba (u v)
83  (prog (lu lv u_up v_up u_low v_low mixed thr)
84   (setq lu (bsize u))
85   (setq lv (bsize v))
86   (setq u_up (lshift u (minus (times2 (quotient (plus2 lu 1) 2) 32))))
87   (setq v_up (lshift u (minus (times2 (quotient (plus2 lv 1) 2) 32))))
88   (setq u_low (land (sub1 (lshift 2 (times2 (quotient lu 2) 32))) u))
89   (setq v_low (land (sub1 (lshift 2 (times2 (quotient lv 2) 32))) v))
90   (setq thr
91   (psl_create_thread_nonblock 'guinea-pig (list 'cons (list 'times2 u_up v_up))
92                                              (list 'times2 u_low v_low)))
93   (setq mixed (times2 (plus2 u_up u_low) (plus2 v_up v_low)))
94   (pthread_join thr status)
95
96))
97
98
99
100(psl_create_thread 'guinea-pig (list 'member 999000 liste))
101(print (wgetv status 0))
102(psl_create_thread 'guinea-pig (list 'member 'a liste))
103(print (wgetv status 0))
104