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