1{- 
2  UMP.hs: Flounder stub generator for cross-core shared memory message passing.
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 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 p n = ump_ifscope p n "init"
23
24params = template_params {
25    ump_payload = 56, -- msg payload in bytes
26    ump_drv = "ump",
27    ump_arch = undefined,
28
29    ump_extra_protos = \ifn -> [init_fn_proto params ifn],
30    ump_extra_fns = \ifn -> [init_fn params ifn],
31
32    ump_register_recv = ump_chan_register_recv,
33    ump_deregister_recv = ump_chan_deregister_recv
34}
35
36header = UMPCommon.header params
37stub a = UMPCommon.stub (params { ump_arch = a })
38
39bind_type ifn = UMPCommon.my_bind_type params ifn
40bind_fn_name ifn = UMPCommon.bind_fn_name params ifn
41
42-- generate the code to register for receive notification
43ump_chan_register_recv :: String -> [C.Stmt]
44ump_chan_register_recv ifn = [
45    C.Ex $ C.Assignment errvar $ C.Call "ump_chan_register_recv"
46        [C.AddressOf $ my_bindvar `C.DerefField` "ump_state" `C.FieldOf` "chan",
47         bindvar `C.DerefField` "waitset",
48         C.StructConstant "event_closure"
49            [("handler", C.Variable $ rx_handler_name params ifn), ("arg", bindvar)]]
50    ]
51
52ump_chan_deregister_recv :: String -> [C.Stmt]
53ump_chan_deregister_recv ifn = [
54    C.Ex $ C.Assignment errvar $ C.Call "ump_chan_deregister_recv"
55        [C.AddressOf $ my_bindvar `C.DerefField` "ump_state" `C.FieldOf` "chan"]]
56
57init_fn_proto :: UMPParams -> String -> C.Unit
58init_fn_proto p n =
59    C.GVarDecl C.Extern C.NonConst
60         (C.Function C.NoScope (C.TypeName "errval_t") (init_params p n)) name Nothing
61    where
62      name = init_fn_name p n
63
64init_params p n = [
65    C.Param (C.Ptr $ C.Struct (my_bind_type p n)) "b",
66    C.Param (C.Ptr $ C.Struct "waitset") "waitset",
67    C.Param (C.Volatile $ C.Ptr C.Void) "inbuf",
68    C.Param (C.TypeName "size_t") "inbufsize",
69    C.Param (C.Volatile $ C.Ptr C.Void) "outbuf",
70    C.Param (C.TypeName "size_t") "outbufsize"]
71
72init_fn :: UMPParams -> String -> C.Unit
73init_fn p ifn =
74    C.FunctionDef C.NoScope (C.TypeName "errval_t") (init_fn_name p ifn) (init_params p ifn)
75       [localvar (C.TypeName "errval_t") "err" Nothing,
76        localvar (C.Ptr $ C.Struct $ intf_bind_type ifn)
77            intf_bind_var (Just $ C.AddressOf $ my_bindvar `C.DerefField` "b"),
78        C.StmtList common_init,
79        C.Ex $ C.Call "flounder_stub_ump_state_init" [C.AddressOf statevar, my_bindvar],
80
81        C.Ex $ C.Assignment errvar $ C.Call "ump_chan_init"
82            [C.AddressOf $ statevar `C.FieldOf` "chan",
83            C.Variable "inbuf", C.Variable "inbufsize",
84            C.Variable "outbuf", C.Variable "outbufsize"],
85        C.If (C.Call "err_is_fail" [errvar])
86            [C.Ex $ C.Call (destroy_fn_name p ifn) [my_bindvar],
87             C.Return $
88                C.Call "err_push" [errvar, C.Variable "LIB_ERR_UMP_CHAN_INIT"]]
89            [],
90        C.SBlank,
91
92        C.Ex $ C.Assignment (common_field "change_waitset") (C.Variable $ change_waitset_fn_name p ifn),
93        C.Ex $ C.Assignment (common_field "control") (C.Variable $ generic_control_fn_name (ump_drv p) ifn),
94
95        C.StmtList $ register_recv p ifn,
96        C.SBlank,
97
98        C.Return errvar]
99    where
100        statevar = C.DerefField my_bindvar "ump_state"
101        common_field f = my_bindvar `C.DerefField` "b" `C.FieldOf` f
102        common_init = binding_struct_init (ump_drv p) ifn
103                        (C.DerefField my_bindvar "b")
104                        (C.Variable "waitset")
105                        (C.Variable $ tx_vtbl_name p ifn)
106