1{- 
2  UMP_IPI.hs: Flounder stub generator for cross-core message passing using IPIs.
3
4  Part of Flounder: a message passing IDL for Barrelfish
5
6  Copyright (c) 2007-2010, ETH Zurich.
7  All rights reserved.
8
9  This file is distributed under the terms in the attached LICENSE file.
10  If you do not find this file, copies can be found by writing to:
11  ETH Zurich D-INFK, Universit\"atstr. 6, CH-8092 Zurich. Attn: Systems Group.
12-}
13
14module UMP_IPI where
15
16import CAbsSyntax as C
17import qualified UMPCommon
18import UMPCommon hiding (header, stub)
19import BackendCommon
20
21-- Name of the init function
22init_fn_name n = ifscope n "ump_ipi_init"
23
24uparams = template_params {
25    ump_payload = 28, -- bytes
26    ump_drv = "ump_ipi",
27
28    ump_binding_extra_fields =
29        [ C.Param (C.Struct "ipi_notify") "ipi_notify",
30          C.Param (C.TypeName "bool") "no_notify"
31        ],
32    ump_extra_includes = ["arch/x86/barrelfish/ipi_notify.h"],
33
34    ump_extra_protos = \ifn -> [init_fn_proto ifn],
35    ump_extra_fns = \ifn -> [accept_alloc_notify_cont_fn ifn,
36                             bind_alloc_notify_cont_fn ifn,
37                             init_fn ifn],
38
39    ump_register_recv = ump_ipi_register_recv,
40    ump_deregister_recv = ump_ipi_deregister_recv,
41    ump_accept_alloc_notify = Just accept_alloc_notify,
42    ump_bind_alloc_notify = Just bind_alloc_notify,
43    ump_store_notify_cap = store_notify_cap,
44    ump_notify = do_notify,
45    ump_binding_extra_fields_init = ump_ipi_binding_extra_fields_init,
46    ump_connect_extra_fields_init = ump_ipi_connect_extra_fields_init
47}
48
49header = UMPCommon.header uparams
50stub a = UMPCommon.stub (uparams { ump_arch = a })
51
52bind_type ifn = UMPCommon.my_bind_type uparams ifn
53bind_fn_name ifn = UMPCommon.bind_fn_name uparams ifn
54
55accept_alloc_notify_cont_name ifn = ifscope ifn "ump_ipi_accept_alloc_notify_cont"
56bind_alloc_notify_cont_name ifn = ifscope ifn "ump_ipi_bind_alloc_notify_cont"
57
58ump_ipi_binding_extra_fields_init :: [C.Stmt]
59ump_ipi_binding_extra_fields_init =
60    [ C.Ex $ C.Assignment (my_bindvar `C.DerefField` "no_notify") $
61           C.Ternary (C.Binary C.BitwiseAnd (C.Variable "flags") (C.Variable "IDC_BIND_FLAG_NO_NOTIFY")) (C.Variable "true") (C.Variable "false")
62    ]
63
64ump_ipi_connect_extra_fields_init :: [C.Stmt]
65ump_ipi_connect_extra_fields_init =
66    [ C.Ex $ C.Assignment (my_bindvar `C.DerefField` "no_notify") $
67           C.Ternary (C.Binary C.BitwiseAnd ((C.DerefField exportvar "common") `C.FieldOf` "flags") (C.Variable "IDC_EXPORT_FLAG_NO_NOTIFY")) (C.Variable "true") (C.Variable "false")
68    ]
69    where
70      exportvar = C.Variable "e"
71
72-- generate the code to register for receive notification
73ump_ipi_register_recv :: String -> [C.Stmt]
74ump_ipi_register_recv ifn =
75    [ C.If (C.Call "capref_is_null" [notifyvar `C.FieldOf` "my_notify_cap"])
76      [ C.Ex $ C.Assignment errvar $ C.Call "ump_chan_register_recv"
77        [C.AddressOf $ my_bindvar `C.DerefField` "ump_state" `C.FieldOf` "chan",
78         bindvar `C.DerefField` "waitset", C.StructConstant "event_closure"
79         [("handler", C.Variable $ rx_handler_name uparams ifn), ("arg", bindvar)]]
80      ]
81      [ C.Ex $ C.Assignment errvar $ C.Call "ipi_notify_register"
82        [notifyaddr, bindvar `C.DerefField` "waitset",
83         C.StructConstant "event_closure"
84         [("handler", C.Variable $ rx_handler_name uparams ifn), ("arg", bindvar)]]
85      ]
86    ]
87
88ump_ipi_deregister_recv :: String -> [C.Stmt]
89ump_ipi_deregister_recv ifn =
90    [ C.If (C.Call "capref_is_null" [notifyvar `C.FieldOf` "my_notify_cap"])
91      [C.Ex $ C.Assignment errvar $ C.Call "ump_chan_deregister_recv"
92       [C.AddressOf $ my_bindvar `C.DerefField` "ump_state" `C.FieldOf` "chan"]]
93      [C.Ex $ C.Assignment errvar $ C.Call "ipi_notify_deregister" [notifyaddr]]
94    ]
95
96alloc_notify :: String -> [C.Stmt]
97alloc_notify handler =
98    [ C.If (my_bindvar `C.DerefField` "no_notify")
99      [ C.Ex $ C.Assignment errvar $ C.Call "ipi_notify_init"
100        [ notifyaddr, C.Variable "NULL_CAP", C.Variable "NULL_CAP",
101          C.Variable "NULL_CAP", C.Variable "NULL" ],
102
103        C.Ex $ C.Call handler [my_bindvar, errvar, C.Variable "NULL"],
104        C.Ex $ (C.Assignment errvar (C.Variable "SYS_ERR_OK"))
105      ]
106      [ C.Ex $ C.Assignment errvar $ C.Call "ipi_notify_alloc"
107        [notifyaddr, C.StructConstant "ipi_alloc_continuation"
108         [("handler", C.Variable handler), ("st", my_bindvar)]]
109      ]
110    ]
111    where
112        chanvar = my_bindvar `C.DerefField` "ump_state" `C.FieldOf` "chan"
113
114accept_alloc_notify ifn = alloc_notify $ accept_alloc_notify_cont_name ifn
115
116bind_alloc_notify ifn =
117    [ C.If (my_bindvar `C.DerefField` "no_notify")
118      [ C.Ex $ C.Assignment errvar $ C.Call "ipi_notify_init"
119        [ notifyaddr, C.Variable "NULL_CAP", C.Variable "NULL_CAP",
120          C.Variable "NULL_CAP", C.Variable "NULL" ],
121        C.If (C.Call "err_is_ok" [errvar])
122         [ C.Ex $ C.Assignment errvar $ C.Call "ump_chan_bind"
123           [C.AddressOf $ chanvar,
124            C.StructConstant "ump_bind_continuation"
125            [("handler", C.Variable (bind_cont_fn_name uparams ifn)),
126             ("st", my_bindvar)],
127            C.AddressOf $ intf_bind_var `C.FieldOf` "event_qnode",
128             my_bindvar `C.DerefField` "iref",
129             chanvar `C.FieldOf` "monitor_binding",
130             my_bindvar `C.DerefField` "inchanlen",
131             my_bindvar `C.DerefField` "outchanlen",
132             C.Variable "NULL_CAP" ] ] []
133      ]
134      [ C.Ex $ C.Assignment errvar $ C.Call "ipi_notify_alloc"
135        [notifyaddr, C.StructConstant "ipi_alloc_continuation"
136         [("handler", C.Variable handler), ("st", my_bindvar)]]
137      ]
138    ]
139    where
140      statevar = C.DerefField my_bindvar "ump_state"
141      chanvar = my_bindvar `C.DerefField` "ump_state" `C.FieldOf` "chan"
142      handler = bind_alloc_notify_cont_name ifn
143      intf_bind_var = C.DerefField my_bindvar "b"
144
145accept_alloc_notify_cont_fn :: String -> C.Unit
146accept_alloc_notify_cont_fn ifn =
147    C.FunctionDef C.Static C.Void (accept_alloc_notify_cont_name ifn) params [
148        localvar (C.Ptr $ C.Struct $ intf_bind_type ifn)
149                intf_bind_var (Just $ C.Variable "st"),
150        localvar (C.Ptr $ C.Struct $ my_bind_type uparams ifn)
151                my_bind_var_name (Just $ C.Variable "st"),
152        C.SBlank,
153
154        C.If (C.Call "err_is_fail" [errvar])
155            [report_user_err errvar] [],
156        C.SBlank,
157
158        C.StmtList $ ump_ipi_register_recv ifn,
159        C.SBlank,
160
161        C.SComment "send back bind reply",
162        C.Ex $ C.Call "ump_chan_send_bind_reply"
163            [chanvar `C.FieldOf` "monitor_binding",
164             C.AddressOf chanvar,
165             errvar,
166             chanvar `C.FieldOf` "monitor_id",
167             notifyvar `C.FieldOf` "my_notify_cap"]
168    ]
169    where
170        params = [C.Param (C.Ptr C.Void) "st",
171                  C.Param (C.TypeName "errval_t") "err",
172                  C.Param (C.Ptr $ C.Struct "ipi_notify") "notify"]
173        chanvar = my_bindvar `C.DerefField` "ump_state" `C.FieldOf` "chan"
174
175
176bind_alloc_notify_cont_fn :: String -> C.Unit
177bind_alloc_notify_cont_fn ifn =
178    C.FunctionDef C.Static C.Void (bind_alloc_notify_cont_name ifn) params [
179        localvar (C.Ptr $ C.Struct $ intf_bind_type ifn)
180                intf_bind_var (Just $ C.Variable "st"),
181        localvar (C.Ptr $ C.Struct $ my_bind_type uparams ifn)
182                my_bind_var_name (Just $ C.Variable "st"),
183        C.SBlank,
184
185        C.If (C.Call "err_is_fail" [errvar])
186            [C.Ex $ C.CallInd (bindvar `C.DerefField` "bind_cont")
187                [bindvar `C.DerefField` "st", errvar, bindvar],
188             C.Ex $ C.Call (destroy_fn_name uparams ifn) [my_bindvar],
189             C.ReturnVoid] [],
190        C.SBlank,
191
192        C.Ex $ C.Assignment errvar $ C.Call "ump_chan_bind"
193            [C.AddressOf $ chanvar,
194             C.StructConstant "ump_bind_continuation"
195                [("handler", C.Variable (bind_cont_fn_name uparams ifn)),
196                 ("st", my_bindvar)],
197             C.AddressOf $ bindvar `C.DerefField` "event_qnode",
198             my_bindvar `C.DerefField` "iref",
199             chanvar `C.FieldOf` "monitor_binding",
200             my_bindvar `C.DerefField` "inchanlen",
201             my_bindvar `C.DerefField` "outchanlen",
202             notifyvar `C.FieldOf` "my_notify_cap"],
203        C.If (C.Call "err_is_fail" [errvar])
204            [C.Ex $ C.CallInd (bindvar `C.DerefField` "bind_cont")
205                [bindvar `C.DerefField` "st", errvar, bindvar],
206             C.Ex $ C.Call (destroy_fn_name uparams ifn) [my_bindvar]] []
207    ]
208    where
209        params = [C.Param (C.Ptr C.Void) "st",
210                  C.Param (C.TypeName "errval_t") "err",
211                  C.Param (C.Ptr $ C.Struct "ipi_notify") "notify"]
212        chanvar = my_bindvar `C.DerefField` "ump_state" `C.FieldOf` "chan"
213
214store_notify_cap :: String -> C.Expr -> [C.Stmt]
215store_notify_cap ifn capex
216    = [C.Ex $ C.Call "ipi_notify_set" [notifyaddr, capex]]
217
218do_notify :: [C.Stmt]
219do_notify =
220    [ C.If (C.Unary C.Not $ C.Call "capref_is_null" [notifyvar `C.FieldOf` "rmt_notify_cap"])
221      [ C.Ex $ C.Assignment errvar $ C.Call "ipi_notify_raise" [notifyaddr],
222        C.If (C.Call "err_is_fail" [errvar])
223             [report_user_tx_err $
224              C.Call "err_push" [errvar, C.Variable "LIB_ERR_IPI_NOTIFY"]] []] []
225    ]
226
227notifyvar = my_bindvar `C.DerefField` "ipi_notify"
228notifyaddr = C.AddressOf $ notifyvar
229
230
231init_fn_proto :: String -> C.Unit
232init_fn_proto n =
233    C.GVarDecl C.Extern C.NonConst
234         (C.Function C.NoScope (C.TypeName "errval_t") (init_params n)) name Nothing
235    where
236      name = init_fn_name n
237
238init_params n = [
239    C.Param (C.Ptr $ C.Struct (my_bind_type uparams n)) "b",
240    C.Param (C.Ptr $ C.Struct "waitset") "waitset",
241    C.Param (C.Volatile $ C.Ptr C.Void) "inbuf",
242    C.Param (C.TypeName "size_t") "inbufsize",
243    C.Param (C.Volatile $ C.Ptr C.Void) "outbuf",
244    C.Param (C.TypeName "size_t") "outbufsize",
245    C.Param (C.Struct "capref") "rmt_notify_cap",
246    C.Param (C.Struct "capref") "my_notify_cap",
247    C.Param (C.Struct "capref") "notify_ep_cap",
248    C.Param (C.Ptr $ C.Struct "lmp_endpoint") "notify_ep"]
249
250init_fn :: String -> C.Unit
251init_fn ifn =
252    C.FunctionDef C.NoScope (C.TypeName "errval_t") (init_fn_name ifn) (init_params ifn)
253       [localvar (C.TypeName "errval_t") "err" Nothing,
254        localvar (C.Ptr $ C.Struct $ intf_bind_type ifn)
255            intf_bind_var (Just $ C.AddressOf $ my_bindvar `C.DerefField` "b"),
256        C.StmtList common_init,
257        C.Ex $ C.Call "flounder_stub_ump_state_init" [C.AddressOf statevar, my_bindvar],
258
259        C.Ex $ C.Assignment errvar $ C.Call "ump_chan_init"
260            [C.AddressOf $ statevar `C.FieldOf` "chan",
261            C.Variable "inbuf", C.Variable "inbufsize",
262            C.Variable "outbuf", C.Variable "outbufsize"],
263        C.If (C.Call "err_is_fail" [errvar])
264            [C.Ex $ C.Call (destroy_fn_name uparams ifn) [my_bindvar],
265             C.Return $
266                C.Call "err_push" [errvar, C.Variable "LIB_ERR_UMP_CHAN_INIT"]]
267            [],
268        C.SBlank,
269
270        C.Ex $ C.Call "ipi_notify_init"
271            [C.AddressOf $ my_bindvar `C.DerefField` "ipi_notify",
272             C.Variable "rmt_notify_cap", C.Variable "my_notify_cap",
273             C.Variable "notify_ep_cap", C.Variable "notify_ep"],
274        C.SBlank,
275
276        C.Ex $ C.Assignment (common_field "change_waitset") (C.Variable $ change_waitset_fn_name uparams ifn),
277        C.Ex $ C.Assignment (common_field "control") (C.Variable $ generic_control_fn_name (ump_drv uparams) ifn),
278
279        C.StmtList $ register_recv uparams ifn,
280        C.SBlank,
281
282        C.Return errvar]
283    where
284        statevar = C.DerefField my_bindvar "ump_state"
285        common_field f = my_bindvar `C.DerefField` "b" `C.FieldOf` f
286        common_init = binding_struct_init (ump_drv uparams) ifn
287                        (C.DerefField my_bindvar "b")
288                        (C.Variable "waitset")
289                        (C.Variable $ tx_vtbl_name uparams ifn)
290