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