/pliant/language/schedule/parallel.pli
1	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
2	#
3	# This program is free software; you can redistribute it and/or
4	# modify it under the terms of the GNU General Public License version 2
5	# as published by the Free Software Foundation.
6	#
7	# This program is distributed in the hope that it will be useful,
8	# but WITHOUT ANY WARRANTY; without even the implied warranty of
9	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
10	# GNU General Public License for more details.
11	#
12	# You should have received a copy of the GNU General Public License
13	# version 2 along with this program; if not, write to the Free Software
14	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
15
16	scope "/pliant/language/" "/pliant/install/"
17	module "/pliant/install/ring3.pli"
18	module "queue.pli"
19
20
21	gvar Int queue_default_threads := 2
22	gvar Int queue_default_mini := 4
23	gvar Int queue_default_maxi := 8
24	gvar CBool queue_default_active := false
25
26
27	meta task e
28	if e:size<>1 and (e:size<>3 or e:1:ident<>"post")
29	return
30	e set_void_result
31	var Pointer:Module module :> e module
32	var Pointer:Arrow r :> module first "pliant queue"
33	if r=null
34	return
35	var Pointer:Argument queue :> r map Argument
36	var Link:List expressions :> new List
37	var Link:List byaddress :> new List
38	expressions append (addressof e:0)
39	var Pointer:Expression post :> null map Expression
40	if e:size=3
41	post :> e 2
42	expressions append addressof:post
43	var Address mark := module mark
44	module define "pliant shared" addressof:byaddress
45	module define "share" addressof:(the_meta 'pliant share arguments')
46	var List functions ; var Link:Type type
47	e freeze expressions byaddress functions type
48	module rewind mark ?
49	var Link:Argument drop
50	if addressof:post=null
51	drop :> argument indirect DelayedAction (argument constant Address null) 0
52	else
53	drop :> post result
54	e add (instruction (the_function '. append' Queue DelayedAction DelayedAction) queue e:0:result drop)
55	e set_void_result
56
57
58	meta parallel e
59	if e:size=0
60	return
61	var Int i := 0
62	var Link:Argument nthreads :> argument indirect Int (argument constant Address addressof:queue_default_threads) 0
63	var Link:Argument mini :> argument indirect Int (argument constant Address addressof:queue_default_mini) 0
64	var Link:Argument maxi :> argument indirect Int (argument constant Address addressof:queue_default_maxi) 0
65	var Link:Argument active :> argument indirect CBool (argument constant Address addressof:queue_default_active) 0
66	var Link:Argument shy :> argument constant CBool false
67	while i<e:size-1
68	if e:i:ident="threads" and i+1<e:size-1 and (e:(i+1) cast Int)
69	e suckup e:(i+1)
70	nthreads :> e:(i+1) result
71	i := i+2
72	eif e:i:ident="mini" and i+1<e:size-1 and (e:(i+1) cast Int)
73	e suckup e:(i+1)
74	mini :> e:(i+1) result
75	i := i+2
76	eif e:i:ident="maxi" and i+1<e:size-1 and (e:(i+1) cast Int)
77	e suckup e:(i+1)
78	maxi :> e:(i+1) result
79	i := i+2
80	eif e:i:ident="active"
81	active :> argument constant CBool true
82	i := i+1
83	eif e:i:ident="shy"
84	shy :> argument constant CBool true
85	i := i+1
86	else
87	return
88	var Pointer:Module module :> e module ; var Address mark := module mark
89	var Link:Argument queue :> argument local Queue
90	module define "pliant queue" addressof:queue
91	module define "task" addressof:(the_meta task)
92	var Pointer:Expression body :> e e:size-1
93	body compile
94	e add (instruction (the_function '. start' Queue Int Int Int CBool CBool) queue nthreads mini maxi active shy)
95	e suckup body
96	e add (instruction (the_function '. stop' Queue) queue)
97	module rewind mark
98	e set_void_result
99
100	export parallel
101
102	dual_keyword task 1 1 post 1 1