1{- 2 THCBackend: generate interface to Flounder THC stubs 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 THCStubsBackend where 15 16import Data.List 17 18import qualified CAbsSyntax as C 19import qualified BackendCommon as BC 20import qualified THCBackend as THC 21import Syntax 22import Backend 23 24------------------------------------------------------------------------ 25-- Language mapping: C identifier names 26------------------------------------------------------------------------ 27 28-- Scope a list of strings 29ifscope :: String -> String -> String 30ifscope ifn s = ifn ++ "_" ++ s 31 32idscope :: String -> String -> String -> String 33idscope ifn s suffix = ifscope ifn (s ++ "__" ++ suffix) 34 35-- Name of the binding struct for an interface type 36intf_bind_type :: String -> String -> String 37intf_bind_type ifn sender = ifscope ifn $ "thc_" ++ sender ++ "_binding_t" 38 39-- Variable used to refer to a THC binding in the generated code 40intf_bind_var = "_thc_binding" 41 42-- Variable used to refer to the underlying IDC binding in the generated code 43intf_c2s_idc_bind_var = "_idc_binding" 44intf_s2c_idc_bind_var = "_idc_binding" 45intf_init_c2s_idc_bind_var = "_c2s_idc_binding" 46intf_init_s2c_idc_bind_var = "_s2c_idc_binding" 47intf_bh_idc_bind_var = "_idc_binding" 48 49-- Name of the functions to call at start/end of send/receive functions 50thc_await_send_fn_name = "thc_await_send" 51thc_await_send_fn_name_x = "thc_await_send_x" 52thc_init_per_binding_state = "thc_init_per_binding_state" 53thc_init_per_recv_state = "thc_init_per_recv_state" 54thc_complete_send_fn_name = "thc_complete_send" 55 56thc_start_bh = "thc_start_bh" 57thc_start_demuxable_bh = "thc_start_demuxable_bh" 58thc_end_bh = "thc_end_bh" 59 60start_send_fn_name = "thc_start_send" 61end_send_fn_name = "thc_end_send" 62 63receive_fn_name = "thc_receive" 64receive_fn_name_x = "thc_receive_x" 65 66start_receive_demux_fn_name = "thc_start_receive_demux" 67cancel_receive_demux_fn_name = "thc_cancel_receive_demux" 68receive_demux_fn_name = "thc_receive_demux" 69receive_demux_fn_name_x = "thc_receive_demux_x" 70 71start_receive_any_fn_name = "thc_start_receive_any" 72start_receive_case_fn_name = "thc_start_receiving" 73start_receive_ooo_fn_name = "thc_start_receive_ooo_rpc" 74receive_any_wait_fn_name = "thc_wait_receive_any" 75receive_any_wait_fn_name_x = "thc_wait_receive_any_x" 76end_receive_case_fn_name = "thc_stop_receiving" 77end_receive_any_fn_name = "thc_end_receive_any" 78end_receive_ooo_fn_name = "thc_end_receive_ooo_rpc" 79 80thc_receiver_info = "thc_receiver_info" 81 82-- Name of the type of a receive-any function 83rx_any_sig_type :: String -> String -> String 84rx_any_sig_type ifn receiver = idscope ifn "recv_any" "thc_" ++ receiver ++ "_t" 85 86rx_any_fn_name ifn receiver = idscope ifn "recv_any" "thc_" ++ receiver ++ "_fn" 87rx_any_fn_name_x ifn receiver = idscope ifn "recv_any" "thc_" ++ receiver ++ "_fn_x" 88 89-- Name of the concrete send/receive functions 90send_fn_name :: Side -> String -> String -> String 91send_fn_name ClientSide ifn mn = idscope ifn ("client_" ++ mn) "send" 92send_fn_name ServerSide ifn mn = idscope ifn ("service_" ++ mn) "send" 93send_fn_name_x :: Side -> String -> String -> String 94send_fn_name_x ClientSide ifn mn = idscope ifn ("client_" ++ mn) "send_x" 95send_fn_name_x ServerSide ifn mn = idscope ifn ("service_" ++ mn) "send_x" 96 97bh_recv_fn_name :: Side -> String -> String -> String 98bh_recv_fn_name ClientSide ifn mn = idscope ifn ("client_" ++ mn) "bh_recv" 99bh_recv_fn_name ServerSide ifn mn = idscope ifn ("service_" ++ mn) "bh_recv" 100 101recv_fn_name :: Side -> String -> String -> String 102recv_fn_name ClientSide ifn mn = idscope ifn ("client_" ++ mn) "recv" 103recv_fn_name ServerSide ifn mn = idscope ifn ("service_" ++ mn) "recv" 104recv_fn_name_x :: Side -> String -> String -> String 105recv_fn_name_x ClientSide ifn mn = idscope ifn ("client_" ++ mn) "recv_x" 106recv_fn_name_x ServerSide ifn mn = idscope ifn ("service_" ++ mn) "recv_x" 107 108-- Name of the funtcion to call to initialize client/service bindings 109thc_init_bindings_name = "thc_init_binding_states" 110 111-- Send continuation 112send_cont_ex = (C.Variable "(MKCONT(thc_complete_send_cb, _idc_binding))") 113 114-- Tx-busy error 115err_tx_busy_ex = C.Variable "FLOUNDER_ERR_TX_BUSY" 116 117-- Name of the struct holding message args for SAR 118ptr_msg_argstruct_name :: String -> String -> String 119ptr_msg_argstruct_name ifn n = idscope ifn n "ptr_args_t" 120 121ptr_rpc_argstruct_name :: String -> String -> String -> String 122ptr_rpc_argstruct_name ifn n inout = idscope ifn n (inout ++ "_ptr_args_t") 123 124ptr_rpc_union_name :: String -> String -> String 125ptr_rpc_union_name ifn n = idscope ifn n "_ptr_union_t" 126 127-- Name of the struct type holding all the arguments for recv any 128ptr_binding_arg_struct_type :: String -> String 129ptr_binding_arg_struct_type ifn = ifscope ifn "thc_ptr_arg_struct" 130 131-- Names for the RPC layer functinos 132call_seq_fn_name :: String -> String -> String 133call_seq_fn_name ifn mn = idscope ifn mn "call_seq" 134 135call_seq_fn_name_x :: String -> String -> String 136call_seq_fn_name_x ifn mn = idscope ifn mn "call_seq_x" 137 138call_fifo_fn_name :: String -> String -> String 139call_fifo_fn_name ifn mn = idscope ifn mn "call_fifo" 140 141call_fifo_fn_name_x :: String -> String -> String 142call_fifo_fn_name_x ifn mn = idscope ifn mn "call_fifo_x" 143 144call_ooo_fn_name :: String -> String -> String 145call_ooo_fn_name ifn mn = idscope ifn mn "call_ooo" 146 147call_ooo_fn_name_x :: String -> String -> String 148call_ooo_fn_name_x ifn mn = idscope ifn mn "call_ooo_x" 149 150data IDCChannel = C2S | S2C; 151 152data Cancelable = CANCELABLE | NONCANCELABLE; 153 154select_idc :: Side -> BC.Direction -> IDCChannel 155select_idc ClientSide BC.TX = C2S 156select_idc ClientSide BC.RX = S2C 157select_idc ServerSide BC.TX = S2C 158select_idc ServerSide BC.RX = C2S 159 160intf_idc_bind_var :: Side -> BC.Direction -> String 161intf_idc_bind_var ClientSide BC.TX = intf_c2s_idc_bind_var 162intf_idc_bind_var ClientSide BC.RX = intf_s2c_idc_bind_var 163intf_idc_bind_var ServerSide BC.TX = intf_s2c_idc_bind_var 164intf_idc_bind_var ServerSide BC.RX = intf_c2s_idc_bind_var 165 166intf_init_idc_bind_var :: Side -> BC.Direction -> String 167intf_init_idc_bind_var ClientSide BC.TX = intf_init_c2s_idc_bind_var 168intf_init_idc_bind_var ClientSide BC.RX = intf_init_s2c_idc_bind_var 169intf_init_idc_bind_var ServerSide BC.TX = intf_init_s2c_idc_bind_var 170intf_init_idc_bind_var ServerSide BC.RX = intf_init_c2s_idc_bind_var 171 172------------------------------------------------------------------------ 173-- Language mapping: Create the THC dummy stubs implementation 174------------------------------------------------------------------------ 175 176compile :: String -> String -> Interface -> String 177compile infile outfile interface = 178 unlines $ C.pp_unit $ C.UnitList $ intf_thc_stubs_file infile interface 179 180intf_thc_stubs_file :: String -> Interface -> [ C.Unit ] 181intf_thc_stubs_file infile interface@(Interface name descr decls) = 182 let (types, messages) = partitionTypesMessages decls 183 nmessages = length messages 184 in [ 185 intf_thc_stubs_preamble infile name descr, 186 C.Blank, 187 C.Include C.Standard "stddef.h", 188 C.IfDef "BARRELFISH" [ C.Include C.Standard "barrelfish/barrelfish.h", 189 C.Include C.Standard "barrelfish/nameservice_client.h", 190 C.Include C.Local ("if/" ++ name ++ "_thc.h"), 191 C.Include C.Local "thc/thc.h" ] 192 [ C.Include C.Local (name ++ "_thc.h"), 193 C.Include C.Local "thc.h" ], 194 C.Blank, 195 196 C.MultiComment [ "Send functions" ], 197 C.UnitList [ send_function NONCANCELABLE ClientSide name m | m <- messages, isForward m ], 198 C.UnitList [ send_function NONCANCELABLE ServerSide name m | m <- messages, isBackward m ], 199 C.UnitList [ send_function CANCELABLE ClientSide name m | m <- messages, isForward m ], 200 C.UnitList [ send_function CANCELABLE ServerSide name m | m <- messages, isBackward m ], 201 C.Blank, 202 203 C.Blank, 204 C.MultiComment [ "Struct type for holding pointers to the args for each msg" ], 205 C.UnitList [ msg_argstruct name m | m <- messages ], 206 C.Blank, 207 208 C.MultiComment [ "Struct type for Receive-any and Bottom-half receive functions to hold pointers-to-message-argument structs" ], 209 intf_struct name messages, 210 C.Blank, 211 212 C.MultiComment [ "Receive functions" ], 213 C.UnitList [ recv_function NONCANCELABLE ClientSide name m | m <- messages, isBackward m ], 214 C.UnitList [ recv_function NONCANCELABLE ServerSide name m | m <- messages, isForward m ], 215 C.UnitList [ recv_function CANCELABLE ClientSide name m | m <- messages, isBackward m ], 216 C.UnitList [ recv_function CANCELABLE ServerSide name m | m <- messages, isForward m ], 217 C.Blank, 218 219 C.MultiComment [ "Receive-any functions" ], 220 gen_receive_any_fn NONCANCELABLE ClientSide name [ m | m <- messages, isBackward m], 221 gen_receive_any_fn NONCANCELABLE ServerSide name [ m | m <- messages, isForward m], 222 gen_receive_any_fn CANCELABLE ClientSide name [ m | m <- messages, isBackward m], 223 gen_receive_any_fn CANCELABLE ServerSide name [ m | m <- messages, isForward m], 224 225 C.MultiComment [ "Bottom-half receive functions" ], 226 C.UnitList [ bh_recv_function ClientSide name m | m <- messages, isBackward m ], 227 C.UnitList [ bh_recv_function ServerSide name m | m <- messages, isForward m ], 228 C.Blank, 229 230 C.MultiComment [ "RPC-layer functions" ], 231 C.UnitList [ gen_call_seq NONCANCELABLE name m | m <- messages, THC.isRPC m ], 232 C.UnitList [ gen_call_fifo NONCANCELABLE name m | m <- messages, THC.isRPC m ], 233 C.UnitList [ gen_call_ooo NONCANCELABLE name m | m <- messages, THC.isOOORPC m ], 234 C.UnitList [ gen_call_seq CANCELABLE name m | m <- messages, THC.isRPC m ], 235 C.UnitList [ gen_call_fifo CANCELABLE name m | m <- messages, THC.isRPC m ], 236 C.UnitList [ gen_call_ooo CANCELABLE name m | m <- messages, THC.isOOORPC m ], 237 238 C.MultiComment [ "Initialization functions" ], 239 init_function ClientSide name messages, 240 init_function ServerSide name messages, 241 242 C.Blank, 243 C.MultiComment [ "Connection-management functions" ], 244 export_cb_function name, 245 connect_cb_function name, 246 export_function name, 247 accept_function name, 248 bind_cb_function name, 249 connect_function name, 250 connect_by_name_function name, 251 252 C.Blank 253 254 255 ] 256 257intf_thc_stubs_preamble :: String -> String -> Maybe String -> C.Unit 258intf_thc_stubs_preamble infile name descr = 259 let dstr = case descr of 260 Nothing -> "not specified" 261 Just s -> s 262 in 263 C.MultiComment [ 264 "Copyright (c) 2010, ETH Zurich.", 265 "All rights reserved.", 266 "", 267 "INTERFACE NAME: " ++ name, 268 "INTEFACE FILE: " ++ infile, 269 "INTERFACE DESCRIPTION: " ++ dstr, 270 "", 271 "This file is distributed under the terms in the attached LICENSE", 272 "file. If you do not find this file, copies can be found by", 273 "writing to:", 274 "ETH Zurich D-INFK, Universitaetstr.6, CH-8092 Zurich.", 275 "Attn: Systems Group.", 276 "", 277 "THIS FILE IS AUTOMATICALLY GENERATED BY FLOUNDER: DO NOT EDIT!" ] 278 279msg_argname :: MessageArgument -> [C.Expr] 280msg_argname (Arg tr (Name n)) = 281 [ C.Variable n ] 282msg_argname (Arg tr (StringArray n l)) = 283 [ C.Variable n ] 284msg_argname (Arg tr (DynamicArray n l _)) = 285 [ C.Variable n, 286 C.Variable l ] 287 288rpc_argdecl :: BC.Direction -> Side -> String -> RPCArgument -> [C.Param] 289rpc_argdecl dir ClientSide ifn (RPCArgIn tr v) = BC.msg_argdecl dir ifn (Arg tr v) 290rpc_argdecl dir ClientSide ifn (RPCArgOut _ _ ) = [] 291rpc_argdecl dir ServerSide ifn (RPCArgOut tr v) = BC.msg_argdecl dir ifn (Arg tr v) 292rpc_argdecl dir ServerSide ifn (RPCArgIn _ _ ) = [] 293 294rpc_argname :: Side -> RPCArgument -> [C.Expr] 295rpc_argname ClientSide (RPCArgIn tr v) = msg_argname (Arg tr v) 296rpc_argname ServerSide (RPCArgOut tr v) = msg_argname (Arg tr v) 297rpc_argname ClientSide (RPCArgOut _ _ ) = [] 298rpc_argname ServerSide (RPCArgIn _ _ ) = [] 299 300rx_rpc_argdecl :: Side -> String -> RPCArgument -> [C.Param] 301rx_rpc_argdecl ServerSide ifn (RPCArgIn tr v) = BC.msg_argdecl BC.RX ifn (Arg tr v) 302rx_rpc_argdecl ServerSide ifn (RPCArgOut _ _ ) = [] 303rx_rpc_argdecl ClientSide ifn (RPCArgOut tr v) = BC.msg_argdecl BC.RX ifn (Arg tr v) 304rx_rpc_argdecl ClientSide ifn (RPCArgIn _ _ ) = [] 305 306receive_rpc_argdecl :: Side -> String -> RPCArgument -> [C.Param] 307receive_rpc_argdecl ClientSide ifn (RPCArgOut tr v) = THC.receive_msg_argdecl ifn (Arg tr v) 308receive_rpc_argdecl ClientSide ifn (RPCArgIn _ _ ) = [] 309receive_rpc_argdecl ServerSide ifn (RPCArgIn tr v) = THC.receive_msg_argdecl ifn (Arg tr v) 310receive_rpc_argdecl ServerSide ifn (RPCArgOut _ _ ) = [] 311 312call_rpc_argdecl :: String -> RPCArgument -> [C.Param] 313call_rpc_argdecl ifn (RPCArgIn tr v) = BC.msg_argdecl BC.TX ifn (Arg tr v) 314call_rpc_argdecl ifn (RPCArgOut tr v) = THC.receive_msg_argdecl ifn (Arg tr v) 315 316startend_call :: String -> String -> String -> C.Stmt 317startend_call fn ifn mn = 318 C.Ex $ C.Call fn [ 319 C.Variable intf_bind_var 320 ] 321 322-- struct foo_binding *_idc_binding = 323-- (struct foo_binding *)((_thc_binding) -> st) 324 325init_idc_binding_var :: IDCChannel -> String -> C.Stmt 326init_idc_binding_var C2S ifn = 327 C.VarDecl C.NoScope C.NonConst idc_binding_type intf_c2s_idc_bind_var (Just initializer) 328 where 329 idc_binding_type = C.Ptr $ C.Struct $ BC.intf_bind_type ifn 330 initializer = C.Cast (idc_binding_type) (C.DerefField (C.Variable intf_bind_var) "_c2s_st") 331init_idc_binding_var S2C ifn = 332 C.VarDecl C.NoScope C.NonConst idc_binding_type intf_s2c_idc_bind_var (Just initializer) 333 where 334 idc_binding_type = C.Ptr $ C.Struct $ BC.intf_bind_type ifn 335 initializer = C.Cast (idc_binding_type) (C.DerefField (C.Variable intf_bind_var) "_s2c_st") 336 337 338init_thc_binding_var :: Side -> String -> C.Stmt 339init_thc_binding_var side ifn = 340 C.VarDecl C.NoScope C.NonConst thc_binding_type intf_bind_var (Just initializer) 341 where 342 thc_binding_type = C.Ptr $ C.Struct $ THC.intf_bind_type ifn (show side) 343 initializer = C.Cast (thc_binding_type) (C.DerefField (C.Variable intf_bh_idc_bind_var) "st") 344 345 346-- Generate palceholder-receive functions for each message. 347-- These are installed in the rx_vtbl to collect messages when 348-- no THC sender is presend. 349-- 350-- 351-- static void bh_recv_foo_t(struct foo_binding *binding, 352-- uint64_t arg1) { 353-- struct foo_binding_thc *thc; 354-- foo_rx_method_fn *fn; 355-- fn = thc_start_bh(thc, binding); 356-- fn(binding, arg1); 357-- thc_end_bh(thc, binding); 358-- } 359 360bh_recv_function :: Side -> String -> MessageDef -> C.Unit 361bh_recv_function side ifn m@(Message _ n args _) = 362 let pb = C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name 363 perrx_ nm = C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ nm) 364 perrx m@(Message _ n args _) = perrx_ $ recvEnum side ifn n 365 perrx m@(RPC n args _) = perrx_ $ recvEnum side ifn n 366 recvEnum ClientSide = THC.resp_msg_enum_elem_name 367 recvEnum ServerSide = THC.call_msg_enum_elem_name 368 common = C.Variable intf_bh_idc_bind_var 369 sidename = show side 370 recv_function_args = 371 concat [ 372 [C.Param (C.Ptr $ C.Struct $ BC.intf_bind_type ifn) intf_bh_idc_bind_var], 373 (concat [ BC.msg_argdecl BC.RX ifn a | a <- args ]) ] 374 decl_fn_var x = 375 C.VarDecl C.NoScope C.NonConst (C.Ptr $ C.Struct thc_receiver_info) "rxi" (Just x) 376 decl_args_var = 377 C.VarDecl C.NoScope C.NonConst (C.Ptr $ C.Struct $ ptr_binding_arg_struct_type ifn) "__attribute__((unused)) _args" (Just (C.DerefField (C.Variable "rxi") "args")) 378 assignment (Arg _ (Name an)) = 379 [ C.If (C.FieldOf ((C.DerefField (C.Variable "_args") n)) an) [ 380 C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf ((C.DerefField (C.Variable "_args") n)) an))) (C.Variable an) 381 ][]] 382 assignment (Arg _ (StringArray an l)) = 383 [ C.If (C.FieldOf ((C.DerefField (C.Variable "_args") n)) an) [ 384 C.Ex $ C.Call "strncpy" [ 385 (((C.FieldOf ((C.DerefField (C.Variable "_args") n)) an))), 386 (C.Variable an), 387 C.NumConstant l 388 ] 389 ][] ] 390 assignment (Arg _ (DynamicArray an al _)) = 391 [ C.If (C.FieldOf ((C.DerefField (C.Variable "_args") n)) an) [ 392 C.Ex $ C.Call "memcpy" [ 393 (((C.FieldOf ((C.DerefField (C.Variable "_args") n)) an))), 394 (C.Variable an), 395 C.Variable al 396 ] 397 ][], 398 C.If (C.FieldOf ((C.DerefField (C.Variable "_args") n)) al) [ 399 C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf ((C.DerefField (C.Variable "_args") n)) al))) (C.Variable al) 400 ][] ] 401 recv_function_body = [ 402 init_thc_binding_var side ifn, 403 decl_fn_var (C.Call thc_start_bh [ pb, common, ( perrx m ) ]), 404 C.If (C.Binary C.Equals (C.Variable "rxi") (C.Variable "NULL")) 405 [ C.ReturnVoid ] 406 [ ], 407 decl_args_var, 408 C.Ex $ C.Assignment (C.DerefPtr ((C.DerefField (C.Variable "rxi") "msg"))) (C.Cast (C.TypeName "int") (C.Variable $ THC.msg_enum_elem_name ifn n)) ] 409 ++ concat [ assignment a | a <- args ] 410 ++ [ C.Ex $ C.Call thc_end_bh [ pb, common, ( perrx m ), (C.Variable "rxi") ] 411 ] 412 in 413 C.FunctionDef C.Static (C.Void) (bh_recv_fn_name side ifn n) 414 recv_function_args 415 recv_function_body; 416 417 418bh_recv_function side ifn m@(RPC n args _) = 419 let pb = C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name 420 perrx_ nm = C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ nm) 421 perrx m@(Message _ n args _) = perrx_ $ recvEnum side ifn n 422 perrx m@(RPC n args _) = perrx_ $ recvEnum side ifn n 423 recvEnum ClientSide = THC.resp_msg_enum_elem_name 424 recvEnum ServerSide = THC.call_msg_enum_elem_name 425 common = C.Variable intf_bh_idc_bind_var 426 sidename = show side 427 recv_function_args = 428 concat [ 429 [C.Param (C.Ptr $ C.Struct $ BC.intf_bind_type ifn) intf_bh_idc_bind_var], 430 (concat [ rx_rpc_argdecl side ifn a | a <- args ]) ] 431 opname ClientSide n = n ++ "_response" 432 opname ServerSide n = n ++ "_call" 433 assignment (RPCArgIn _ (Name an)) = 434 [ C.If ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) an)) [ 435 C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) an))) (C.Variable an) 436 ][] ] 437 assignment (RPCArgIn _ (StringArray an l)) = 438 [ C.If ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) an)) [ 439 C.Ex $ C.Call "strncpy" [ 440 (((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) an))), 441 (C.Variable an), C.NumConstant l 442 ] 443 ][]] 444 assignment (RPCArgIn _ (DynamicArray an al _)) = 445 [ C.If (((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) an))) [ 446 C.Ex $ C.Call "memcpy" [ 447 (((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) an))), 448 (C.Variable an), C.Variable al 449 ] 450 ][], 451 C.If (C.DerefPtr ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) al))) [ 452 C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) al))) (C.Variable al) 453 ][] ] 454 assignment (RPCArgOut _ (Name an)) = 455 [ C.If ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) an)) [ 456 C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) an))) (C.Variable an) 457 ][] ] 458 assignment (RPCArgOut _ (StringArray an l)) = 459 [ C.If ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) an)) [ 460 C.Ex $ C.Call "strncpy" [ 461 (((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) an))), 462 (C.Variable an), C.NumConstant l ] 463 ][] ] 464 assignment (RPCArgOut _ (DynamicArray an al _)) = 465 [ C.If (C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) an) [ 466 C.Ex $ C.Call "memcpy" [ 467 (((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) an))), 468 (C.Variable an), C.Variable al 469 ] 470 ][], 471 C.If ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) al)) [ 472 C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) al))) (C.Variable al) 473 ][]] 474 decl_fn_var x = 475 C.VarDecl C.NoScope C.NonConst (C.Ptr $ C.Struct thc_receiver_info) "rxi" (Just x) 476 decl_args_var = 477 C.VarDecl C.NoScope C.NonConst (C.Ptr $ C.Struct $ ptr_binding_arg_struct_type ifn) "__attribute__((unused)) args" (Just (C.DerefField (C.Variable "rxi") "args")) 478 idc_rx_args ClientSide = idc_rx_args_out 479 idc_rx_args ServerSide = idc_rx_args_in 480 idc_rx_args_in = concat [rpc_argname ClientSide a | a <- args] 481 idc_rx_args_out = concat [rpc_argname ServerSide a | a <- args] 482 dir_args ServerSide = [ a | a@(RPCArgIn _ _) <- args ] 483 dir_args ClientSide = [ a | a@(RPCArgOut _ _) <- args ] 484 start_fn ClientSide m = if (THC.isOOORPC m) then thc_start_demuxable_bh else thc_start_bh 485 start_fn ServerSide _ = thc_start_bh 486 demux_args ClientSide m = if (THC.isOOORPC m) then [ C.Variable "seq_out" ] else [] 487 demux_args ServerSide _ = [] 488 recv_function_body = [ 489 init_thc_binding_var side ifn, 490 decl_fn_var (C.Call (start_fn side m) (concat [[ pb, common, ( perrx m ) ], (demux_args side m)])), 491 C.If (C.Binary C.Equals (C.Variable "rxi") (C.Variable "NULL")) 492 [ C.ReturnVoid ] 493 [ ], 494 decl_args_var, 495 C.Ex $ C.Assignment (C.DerefPtr ((C.DerefField (C.Variable "rxi") "msg"))) (C.Cast (C.TypeName "int") (C.Variable $ THC.msg_enum_elem_name ifn n)) ] 496 ++ concat [ assignment a | a <- dir_args side ] 497 ++ [C.Ex $ C.Call thc_end_bh [ pb, common, ( perrx m ), (C.Variable "rxi") ] 498 ] 499 in 500 C.FunctionDef C.Static (C.Void) (bh_recv_fn_name side ifn n) 501 recv_function_args 502 recv_function_body; 503 504 505 506-- Generate send functions for each message 507-- 508-- 509-- static errval_t send_foo_t(struct ...binding_thc *thc, 510-- uint64_t id, 511-- uint64_t value1, 512-- uint64_t value2) { 513-- ...binding b = (...) (thc->st); 514-- do { 515-- errval_t r = b->tx_vtbl.foo(b, id, value1, value2); 516-- if (r != FLOUNDER_ERR_TX_BUSY) { 517-- return r; 518-- } 519-- thc_await_send(thc, b); 520-- } while (true); 521-- } 522 523send_function :: Cancelable -> Side -> String -> MessageDef -> C.Unit 524send_function cb side ifn m@(Message _ n args _) = 525 let fn_name CANCELABLE = send_fn_name_x side ifn n 526 fn_name NONCANCELABLE = send_fn_name side ifn n 527 sidename = show side 528 sem_p CANCELABLE = C.If (C.Binary C.Equals (C.Call "thc_sem_p_x" [ C.AddressOf $ C.FieldOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name) "thc_next_sender" ]) (C.Variable "THC_CANCELED")) [ C.Return $ C.Variable "THC_CANCELED" ] [] 529 sem_p NONCANCELABLE = C.Ex $ C.Call "thc_sem_p" [ C.AddressOf $ C.FieldOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name) "thc_next_sender" ] 530 await_send_branch CANCELABLE = 531 [ C.If (C.Binary C.Equals (C.Call thc_await_send_fn_name_x [ C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name, 532 C.AddressOf $ C.DerefField (C.Variable (intf_idc_bind_var side BC.TX)) "st" ]) (C.Variable "THC_CANCELED")) 533 [ C.Ex $ C.Call "thc_sem_v" [ C.AddressOf $ C.FieldOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name) "thc_next_sender" ], 534 C.Return $ C.Variable "THC_CANCELED" ] [ ] ] 535 await_send_branch NONCANCELABLE = 536 [ C.Ex $ C.Call thc_await_send_fn_name [ C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name, 537 C.AddressOf $ C.DerefField (C.Variable (intf_idc_bind_var side BC.TX)) "st" ] ] 538 send_function_args = 539 concat [ 540 [C.Param (C.Ptr $ C.Struct $ THC.intf_bind_type ifn sidename) intf_bind_var], 541 (concat [ BC.msg_argdecl BC.TX ifn a | a <- args ]) ] 542 send_function_body = [ 543 init_idc_binding_var (select_idc side BC.TX) ifn, 544 sem_p cb, 545 C.Ex $ C.Assignment ( C.FieldOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name) "thc_send_complete" ) ( C.NumConstant 0 ), 546 C.Ex $ C.Call "THCIncSendCount" [], 547 C.DoWhile (C.NumConstant 1) [ 548 C.VarDecl C.NoScope C.NonConst (C.TypeName "errval_t") "_r" 549 (Just $ C.CallInd idc_tx_fn idc_tx_args), 550 C.If (C.Binary C.Equals (C.Variable "_r") err_tx_busy_ex) 551 ( await_send_branch cb ) 552 [ C.Ex $ C.Call thc_complete_send_fn_name [ C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name, 553 C.AddressOf $ C.DerefField (C.Variable (intf_idc_bind_var side BC.TX)) "st" ], 554 C.Ex $ C.Call "thc_sem_v" [ C.AddressOf $ C.FieldOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name) "thc_next_sender" ], 555 C.Return $ C.Variable "_r" ] 556 ] 557 ] 558 idc_binding = C.Variable (intf_idc_bind_var side BC.TX) 559 idc_tx_vtbl = C.DerefField idc_binding "tx_vtbl" 560 idc_tx_fn = C.FieldOf idc_tx_vtbl n 561 idc_tx_args = [ idc_binding, send_cont_ex ] 562 ++ 563 (concat [ msg_argname a | a <- args]) 564 in 565 C.FunctionDef C.Static (C.TypeName "errval_t") (fn_name cb) 566 send_function_args 567 send_function_body; 568 569send_function cb side ifn m@(RPC n args _) = 570 let fn_name = (case cb of 571 CANCELABLE -> send_fn_name_x side ifn n 572 NONCANCELABLE -> send_fn_name side ifn n) 573 sidename = show side 574 sem_p CANCELABLE = C.If (C.Binary C.Equals (C.Call "thc_sem_p_x" [ C.AddressOf $ C.FieldOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name) "thc_next_sender" ]) (C.Variable "THC_CANCELED")) [ C.Return $ C.Variable "THC_CANCELED" ] [] 575 sem_p NONCANCELABLE = C.Ex $ C.Call "thc_sem_p" [ C.AddressOf $ C.FieldOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name) "thc_next_sender" ] 576 await_send_branch CANCELABLE = 577 [ C.If (C.Binary C.Equals (C.Call thc_await_send_fn_name_x [ C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name, 578 C.AddressOf $ C.DerefField (C.Variable (intf_idc_bind_var side BC.TX)) "st" ]) (C.Variable "THC_CANCELED")) 579 [ C.Ex $ C.Call "thc_sem_v" [ C.AddressOf $ C.FieldOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name) "thc_next_sender" ], 580 C.Return $ C.Variable "THC_CANCELED" ] [ ] ] 581 await_send_branch NONCANCELABLE = 582 [ C.Ex $ C.Call thc_await_send_fn_name [ C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name, 583 C.AddressOf $ C.DerefField (C.Variable (intf_idc_bind_var side BC.TX)) "st" ] ] 584 send_function_args = 585 concat [ 586 [C.Param (C.Ptr $ C.Struct $ THC.intf_bind_type ifn sidename) intf_bind_var], 587 (concat [ rpc_argdecl BC.TX side ifn a | a <- args ]) ] 588 send_function_body = [ 589 init_idc_binding_var (select_idc side BC.TX) ifn, 590 sem_p cb, 591 C.Ex $ C.Assignment ( C.FieldOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name) "thc_send_complete" ) ( C.NumConstant 0 ), 592 C.Ex $ C.Call "THCIncSendCount" [], 593 C.DoWhile (C.NumConstant 1) [ 594 C.VarDecl C.NoScope C.NonConst (C.TypeName "errval_t") "_r" 595 (Just $ C.CallInd idc_tx_fn (idc_tx_args side)), 596 C.If (C.Binary C.Equals (C.Variable "_r") err_tx_busy_ex) 597 ( await_send_branch cb ) 598 [ C.Ex $ C.Call thc_complete_send_fn_name [ C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name, 599 C.AddressOf $ C.DerefField (C.Variable (intf_idc_bind_var side BC.TX)) "st" ], 600 C.Ex $ C.Call "thc_sem_v" [ C.AddressOf $ C.FieldOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name) "thc_next_sender" ], 601 C.Return $ C.Variable "_r" ] 602 ] 603 ] 604 rpc_name ClientSide n = BC.rpc_call_name n 605 rpc_name ServerSide n = BC.rpc_resp_name n 606 idc_binding = C.Variable (intf_idc_bind_var side BC.TX) 607 idc_tx_vtbl = C.DerefField idc_binding "tx_vtbl" 608 idc_tx_fn = C.FieldOf idc_tx_vtbl (rpc_name side n) 609 idc_tx_args ClientSide = idc_tx_args_in 610 idc_tx_args ServerSide = idc_tx_args_out 611 idc_tx_args_in = [ idc_binding, send_cont_ex ] 612 ++ 613 (concat [ rpc_argname ClientSide a | a <- args ]) 614 idc_tx_args_out = [ idc_binding, send_cont_ex ] 615 ++ 616 (concat [ rpc_argname ServerSide a | a <- args ]) 617 in 618 C.FunctionDef C.Static (C.TypeName "errval_t") fn_name 619 send_function_args 620 send_function_body; 621 622-- Initialization functions 623 624init_function :: Side -> String -> [MessageDef] -> C.Unit 625init_function side ifn messages = 626 let init_name_for ClientSide = THC.init_client_name ifn 627 init_name_for ServerSide = THC.init_service_name ifn 628 init_name = init_name_for side 629 rpc_name ClientSide n = BC.rpc_call_name n 630 rpc_name ServerSide n = BC.rpc_resp_name n 631 filterSend ClientSide = isForward 632 filterSend ServerSide = isBackward 633 filterRecv ClientSide = isBackward 634 filterRecv ServerSide = isForward 635 recvEnum ClientSide = THC.resp_msg_enum_elem_name 636 recvEnum ServerSide = THC.call_msg_enum_elem_name 637 opname ClientSide n = n ++ "_response" 638 opname ServerSide n = n ++ "_call" 639 init_args = [ 640 C.Param (C.Ptr $ C.TypeName $ intf_bind_type ifn (show side)) intf_bind_var, 641 C.Param (C.Ptr $ C.Struct $ BC.intf_bind_type ifn) intf_init_c2s_idc_bind_var, 642 C.Param (C.Ptr $ C.Struct $ BC.intf_bind_type ifn) intf_init_s2c_idc_bind_var ] 643 init_send_fn CANCELABLE m@(Message _ n args _) = 644 C.Ex $ C.Assignment (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "send_x") n) (C.AddressOf $ C.Variable $ send_fn_name_x side ifn n) 645 init_send_fn CANCELABLE m@(RPC n args _) = 646 C.Ex $ C.Assignment (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "send_x") n) (C.AddressOf $ C.Variable $ send_fn_name_x side ifn n) 647 init_send_fn NONCANCELABLE m@(Message _ n args _) = 648 C.Ex $ C.Assignment (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "send") n) (C.AddressOf $ C.Variable $ send_fn_name side ifn n) 649 init_send_fn NONCANCELABLE m@(RPC n args _) = 650 C.Ex $ C.Assignment (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "send") n) (C.AddressOf $ C.Variable $ send_fn_name side ifn n) 651 init_recv_ n = C.Ex $ C.Call thc_init_per_recv_state [ C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ n) ] 652 init_recv m@(Message _ n args _) = init_recv_ $ recvEnum side ifn n 653 init_recv m@(RPC n args _) = init_recv_ $ recvEnum side ifn n 654 init_bh m@(Message _ n args _) = 655 C.Ex $ C.Assignment (C.FieldOf (C.DerefField (C.Variable (intf_init_idc_bind_var side BC.RX)) "rx_vtbl") n) (C.AddressOf $ C.Variable $ bh_recv_fn_name side ifn n) 656 init_bh m@(RPC n args _) = 657 C.Ex $ C.Assignment (C.FieldOf (C.DerefField (C.Variable (intf_init_idc_bind_var side BC.RX)) "rx_vtbl") (opname side n)) (C.AddressOf $ C.Variable $ bh_recv_fn_name side ifn n) 658 init_recv_fn NONCANCELABLE m@(Message _ n args _) = 659 C.Ex $ C.Assignment (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "recv") n) (C.AddressOf $ C.Variable $ recv_fn_name side ifn n) 660 init_recv_fn NONCANCELABLE m@(RPC n args _) = 661 C.Ex $ C.Assignment (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "recv") n) (C.AddressOf $ C.Variable $ recv_fn_name side ifn n) 662 init_recv_fn CANCELABLE m@(Message _ n args _) = 663 C.Ex $ C.Assignment (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "recv_x") n) (C.AddressOf $ C.Variable $ recv_fn_name_x side ifn n) 664 init_recv_fn CANCELABLE m@(RPC n args _) = 665 C.Ex $ C.Assignment (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "recv_x") n) (C.AddressOf $ C.Variable $ recv_fn_name_x side ifn n) 666 init_rpc_seq _ ServerSide _ = [] 667 init_rpc_seq NONCANCELABLE ClientSide m@(RPC n _ _) = 668 [ C.Ex $ C.Assignment (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "call_seq") n) (C.Variable $ call_seq_fn_name ifn n) ] 669 init_rpc_seq CANCELABLE ClientSide m@(RPC n _ _) = 670 [ C.Ex $ C.Assignment (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "call_seq_x") n) (C.Variable $ call_seq_fn_name_x ifn n) ] 671 init_rpc_fifo _ ServerSide _ = [] 672 init_rpc_fifo NONCANCELABLE ClientSide m@(RPC n _ _) = 673 [ C.Ex $ C.Assignment (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "call_fifo") n) (C.Variable $ call_fifo_fn_name ifn n) ] 674 init_rpc_fifo CANCELABLE ClientSide m@(RPC n _ _) = 675 [ C.Ex $ C.Assignment (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "call_fifo_x") n) (C.Variable $ call_fifo_fn_name_x ifn n) ] 676 init_rpc_ooo _ ServerSide _ = [] 677 init_rpc_ooo NONCANCELABLE ClientSide m@(RPC n (_:_:args) _) = 678 [ C.Ex $ C.Assignment (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "call") n) (C.Variable $ call_ooo_fn_name ifn n) ] 679 init_rpc_ooo CANCELABLE ClientSide m@(RPC n (_:_:args) _) = 680 [ C.Ex $ C.Assignment (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "call_x") n) (C.Variable $ call_ooo_fn_name_x ifn n) ] 681 client_only ServerSide _ = [] 682 client_only ClientSide x = [x] 683 check_field fn = C.Ex $ C.Call "CHECK_FIELD" [ C.Variable ("struct " ++ (BC.intf_bind_type ifn)), C.Variable fn ] 684 init_stmts = [ check_field "st", 685 check_field "waitset", 686 check_field "mutex", 687 check_field "can_send", 688 check_field "register_send", 689 check_field "change_waitset", 690 check_field "control", 691 check_field "error_handler", 692 C.Ex $ C.Assignment (C.DerefField (C.Variable intf_bind_var) "_c2s_st") (C.Variable intf_init_c2s_idc_bind_var), 693 C.Ex $ C.Assignment (C.DerefField (C.Variable intf_bind_var) "_s2c_st") (C.Variable intf_init_s2c_idc_bind_var) ] 694 ++ [ C.Ex $ C.Assignment ((C.DerefField (C.Variable intf_init_c2s_idc_bind_var)) "st") (C.Variable intf_bind_var) ] 695 ++ [ C.Ex $ C.Assignment ((C.DerefField (C.Variable intf_init_s2c_idc_bind_var)) "st") (C.Variable intf_bind_var) ] 696 ++ concat [ client_only side $ C.Ex $ C.Call "thc_seq_init" [ C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.ooo_rpc_seq_name ] ] 697 ++ [ C.Ex $ C.Call thc_init_per_binding_state [ C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name] ] 698 ++ [ init_send_fn NONCANCELABLE m | m <- messages, (filterSend side) m ] 699 ++ [ init_send_fn CANCELABLE m | m <- messages, (filterSend side) m ] 700 ++ [ init_recv m | m <- messages, (filterRecv side) m ] 701 ++ [ init_bh m | m <- messages, (filterRecv side) m ] 702 ++ [ init_recv_fn NONCANCELABLE m | m <- messages, (filterRecv side) m ] 703 ++ [ init_recv_fn CANCELABLE m | m <- messages, (filterRecv side) m ] 704 ++ [ C.Ex $ C.Assignment (C.DerefField (C.Variable intf_bind_var) "recv_any") (C.Variable $ rx_any_fn_name ifn (show side)) ] 705 ++ [ C.Ex $ C.Assignment (C.DerefField (C.Variable intf_bind_var) "recv_any_x") (C.Variable $ rx_any_fn_name_x ifn (show side)) ] 706 ++ concat [ init_rpc_seq NONCANCELABLE side m | m <- messages, THC.isRPC m ] 707 ++ concat [ init_rpc_fifo NONCANCELABLE side m | m <- messages, THC.isRPC m ] 708 ++ concat [ init_rpc_ooo NONCANCELABLE side m | m <- messages, THC.isOOORPC m ] 709 ++ concat [ init_rpc_seq CANCELABLE side m | m <- messages, THC.isRPC m ] 710 ++ concat [ init_rpc_fifo CANCELABLE side m | m <- messages, THC.isRPC m ] 711 ++ concat [ init_rpc_ooo CANCELABLE side m | m <- messages, THC.isOOORPC m ] 712 ++ [ C.Return $ C.NumConstant 0 ] 713 714 in 715 C.FunctionDef C.NoScope (C.TypeName "errval_t") init_name init_args init_stmts 716 717 718-- 719-- Generate a struct to hold the arguments of a message while it's being sent. 720-- 721msg_argstruct :: String -> MessageDef -> C.Unit 722msg_argstruct ifname m@(Message _ n [] _) = C.NoOp 723msg_argstruct ifname m@(Message _ n args _) = 724 let tn = ptr_msg_argstruct_name ifname n 725 in 726 C.StructDecl tn (concat [ ptr_msg_argdecl ifname a | a <- args ]) 727msg_argstruct ifname m@(RPC n args _) = 728 C.UnitList [ 729 C.StructDecl (ptr_rpc_argstruct_name ifname n "in") 730 (concat [ ptr_rpc_argdecl ClientSide ifname a | a <- args ]), 731 C.StructDecl (ptr_rpc_argstruct_name ifname n "out") 732 (concat [ ptr_rpc_argdecl ServerSide ifname a | a <- args ]), 733 C.UnionDecl (ptr_rpc_union_name ifname n) [ 734 C.Param (C.Struct $ ptr_rpc_argstruct_name ifname n "in") "in", 735 C.Param (C.Struct $ ptr_rpc_argstruct_name ifname n "out") "out" 736 ] 737 ] 738 739-- 740-- Generate a union of all the above 741-- 742intf_struct :: String -> [MessageDef] -> C.Unit 743intf_struct ifn msgs = 744 C.StructDecl (ptr_binding_arg_struct_type ifn) 745 ([ C.Param (C.Struct $ ptr_msg_argstruct_name ifn n) n 746 | m@(Message _ n a _) <- msgs, 0 /= length a ] 747 ++ 748 [ C.Param (C.Union $ ptr_rpc_union_name ifn n) n 749 | m@(RPC n a _) <- msgs, 0 /= length a ]) 750 751ptr_msg_argdecl :: String -> MessageArgument -> [C.Param] 752ptr_msg_argdecl ifn (Arg tr (Name n)) = 753 [ C.Param (C.Ptr $ BC.type_c_type ifn tr) n ] 754ptr_msg_argdecl ifn (Arg tr (StringArray n l)) = 755 [ C.Param (BC.type_c_type ifn tr) n ] 756ptr_msg_argdecl ifn (Arg tr (DynamicArray n l _)) = 757 [ C.Param (C.Ptr $ BC.type_c_type ifn tr) n, 758 C.Param (C.Ptr $ BC.type_c_type ifn size) l ] 759 760ptr_rpc_argdecl :: Side -> String -> RPCArgument -> [C.Param] 761ptr_rpc_argdecl ClientSide ifn (RPCArgIn tr v) = ptr_msg_argdecl ifn (Arg tr v) 762ptr_rpc_argdecl ClientSide ifn (RPCArgOut _ _) = [] 763ptr_rpc_argdecl ServerSide ifn (RPCArgOut tr v) = ptr_msg_argdecl ifn (Arg tr v) 764ptr_rpc_argdecl ServerSide ifn (RPCArgIn _ _) = [] 765 766-- Generate recv functions 767 768recv_function_rpc_body assign cb side std_receive_fn ifn m@(RPC n args _) = 769 let pb = C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name 770 sidename = show side 771 recvEnum ClientSide = THC.resp_msg_enum_elem_name 772 recvEnum ServerSide = THC.call_msg_enum_elem_name 773 assignment (RPCArgIn _ (Name an)) = 774 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) (C.Variable an) ] 775 assignment (RPCArgIn _ (StringArray an l)) = 776 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) (C.Variable an) ] 777 assignment (RPCArgIn _ (DynamicArray an al _)) = 778 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) (C.Variable an), 779 C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") al))) (C.Variable al) ] 780 assignment (RPCArgOut _ (Name an)) = 781 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) (C.Variable an) ] 782 assignment (RPCArgOut _ (StringArray an l)) = 783 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) (C.Variable an) ] 784 assignment (RPCArgOut _ (DynamicArray an al _)) = 785 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) (C.Variable an), 786 C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") al))) (C.Variable al) ] 787 dir_args ServerSide = [ a | a@(RPCArgIn _ _) <- args ] 788 dir_args ClientSide = [ a | a@(RPCArgOut _ _) <- args ] 789 in [ 790 C.VarDecl C.NoScope C.NonConst (C.Struct $ ptr_binding_arg_struct_type ifn) "_args" Nothing, 791 C.VarDecl C.NoScope C.NonConst (C.Struct thc_receiver_info) "_rxi" Nothing, 792 C.VarDecl C.NoScope C.NonConst (C.TypeName "int") "_msg" Nothing ] 793 ++ concat [ assignment a | a <- dir_args side ] 794 ++ [ C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "waiter") $ C.Variable "NULL", 795 C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "args") $ C.AddressOf $ C.Variable "_args", 796 C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "msg") $ C.AddressOf $ C.Variable "_msg", 797 C.Ex $ C.Assignment (C.Variable assign) $ C.Call std_receive_fn [ 798 pb, 799 C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ recvEnum side ifn n), 800 C.AddressOf $ C.Variable "_rxi" 801 ] 802 ] 803 804recv_function :: Cancelable -> Side -> String -> MessageDef -> C.Unit 805recv_function cb side ifn m@(Message _ n args _) = 806 let fn_name CANCELABLE = recv_fn_name_x side ifn n 807 fn_name NONCANCELABLE = recv_fn_name side ifn n 808 std_receive_fn_name CANCELABLE = receive_fn_name_x 809 std_receive_fn_name NONCANCELABLE = receive_fn_name 810 pb = C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name 811 sidename = show side 812 recvEnum ClientSide = THC.resp_msg_enum_elem_name 813 recvEnum ServerSide = THC.call_msg_enum_elem_name 814 recv_function_args = 815 concat [ 816 [C.Param (C.Ptr $ C.Struct $ THC.intf_bind_type ifn sidename) intf_bind_var], 817 (concat [ THC.receive_msg_argdecl ifn a | a <- args ]) ] 818 assignment (Arg _ (Name an)) = 819 [ C.Ex $ C.Assignment (((C.FieldOf ((C.FieldOf (C.Variable "_args") n)) an))) (C.Variable an) ] 820 assignment (Arg _ (StringArray an l)) = 821 [ C.Ex $ C.Assignment (((C.FieldOf ((C.FieldOf (C.Variable "_args") n)) an))) (C.Variable an) ] 822 assignment (Arg _ (DynamicArray an al _)) = 823 [ C.Ex $ C.Assignment (((C.FieldOf ((C.FieldOf (C.Variable "_args") n)) an))) (C.Variable an), 824 C.Ex $ C.Assignment (((C.FieldOf ((C.FieldOf (C.Variable "_args") n)) al))) (C.Variable al) ] 825 recv_function_body = [ 826 C.VarDecl C.NoScope C.NonConst (C.Struct $ ptr_binding_arg_struct_type ifn) "_args" Nothing, 827 C.VarDecl C.NoScope C.NonConst (C.Struct thc_receiver_info) "_rxi" Nothing, 828 C.VarDecl C.NoScope C.NonConst (C.TypeName "int") "_msg" Nothing ] 829 ++ concat [ assignment a | a <- args ] 830 ++ [ C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "waiter") $ C.Variable "NULL", 831 C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "args") $ C.AddressOf $ C.Variable "_args", 832 C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "msg") $ C.AddressOf $ C.Variable "_msg", 833 C.Return $ C.Call (std_receive_fn_name cb) [ 834 pb, 835 C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ recvEnum side ifn n), 836 C.AddressOf $ C.Variable "_rxi" 837 ] 838 ] 839 in 840 C.FunctionDef C.Static (C.TypeName "errval_t") (fn_name cb) 841 recv_function_args 842 recv_function_body; 843 844recv_function cb side ifn m@(RPC n args _) = 845 let fn_name CANCELABLE = recv_fn_name_x side ifn n 846 fn_name NONCANCELABLE = recv_fn_name side ifn n 847 std_receive_fn_name CANCELABLE = receive_fn_name_x 848 std_receive_fn_name NONCANCELABLE = receive_fn_name 849 pb = C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name 850 sidename = show side 851 recvEnum ClientSide = THC.resp_msg_enum_elem_name 852 recvEnum ServerSide = THC.call_msg_enum_elem_name 853 recv_function_args = 854 concat [ 855 [C.Param (C.Ptr $ C.Struct $ THC.intf_bind_type ifn sidename) intf_bind_var], 856 (concat [ receive_rpc_argdecl side ifn a | a <- args ]) ] 857 assignment (RPCArgIn _ (Name an)) = 858 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) (C.Variable an) ] 859 assignment (RPCArgIn _ (DynamicArray an al _)) = 860 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) (C.Variable an), 861 C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") al))) (C.Variable al) ] 862 assignment (RPCArgOut _ (Name an)) = 863 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) (C.Variable an) ] 864 assignment (RPCArgOut _ (DynamicArray an al _)) = 865 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) (C.Variable an), 866 C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") al))) (C.Variable al) ] 867 dir_args ServerSide = [ a | a@(RPCArgIn _ _) <- args ] 868 dir_args ClientSide = [ a | a@(RPCArgOut _ _) <- args ] 869 recv_function_body = [ 870 C.VarDecl C.NoScope C.NonConst (C.Struct $ ptr_binding_arg_struct_type ifn) "_args" Nothing, 871 C.VarDecl C.NoScope C.NonConst (C.Struct thc_receiver_info) "_rxi" Nothing, 872 C.VarDecl C.NoScope C.NonConst (C.TypeName "int") "_msg" Nothing ] 873 ++ concat [ assignment a | a <- dir_args side ] 874 ++ [ C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "waiter") $ C.Variable "NULL", 875 C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "args") $ C.AddressOf $ C.Variable "_args", 876 C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "msg") $ C.AddressOf $ C.Variable "_msg", 877 C.Return $ C.Call (std_receive_fn_name cb) [ 878 pb, 879 C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ recvEnum side ifn n), 880 C.AddressOf $ C.Variable "_rxi" 881 ] 882 ] 883 in 884 C.FunctionDef C.Static (C.TypeName "errval_t") (fn_name cb) 885 recv_function_args 886 ([ C.VarDecl C.NoScope C.NonConst (C.TypeName "errval_t") "_result" Nothing ] ++ 887 (recv_function_rpc_body "_result" cb side (std_receive_fn_name cb) ifn m) ++ 888 [ C.Return $ C.Variable "_result" ]); 889 890-- Generate receive-any functions 891 892gen_receive_any_fn :: Cancelable -> Side -> String -> [MessageDef] -> C.Unit 893gen_receive_any_fn cb side ifn ms = 894 let fn_name CANCELABLE = rx_any_fn_name_x ifn end 895 fn_name NONCANCELABLE = rx_any_fn_name ifn end 896 wait_call CANCELABLE = 897 C.Ex $ C.Assignment (C.Variable "_r") (C.Call (receive_any_wait_fn_name_x) [ pb, C.AddressOf $ C.Variable "_rxi" ]) 898 wait_call NONCANCELABLE = 899 C.Ex $ C.Call (receive_any_wait_fn_name) [ pb, C.AddressOf $ C.Variable "_rxi" ] 900 end = show side 901 pb = C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name 902 interested m@(Message _ mn _ _) stmts = 903 C.If (C.Binary C.NotEquals (C.FieldOf (C.Variable "ops") mn) (C.NumConstant 0) ) stmts [] 904 interested m@(RPC mn _ _) stmts = 905 C.If (C.Binary C.NotEquals (C.FieldOf (C.Variable "ops") mn) (C.NumConstant 0) ) stmts [] 906 recvEnum ClientSide = THC.resp_msg_enum_elem_name 907 recvEnum ServerSide = THC.call_msg_enum_elem_name 908 receive_any_fn_args = [ 909 C.Param (C.Ptr $ C.TypeName $ intf_bind_type ifn end) intf_bind_var, 910 C.Param (C.Ptr $ C.Struct $ THC.rx_any_struct_name ifn end) "msg", 911 C.Param (C.Struct $ THC.intf_selector_type ifn end) "ops" 912 ] 913 per_rx_state m@(RPC n args _) = C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ recvEnum side ifn n) 914 per_rx_state m@(Message _ n args _) = C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ recvEnum side ifn n) 915 p_rxi = C.AddressOf $ C.Variable "_rxi" 916 rpc_assignment n (RPCArgIn _ (Name an)) = 917 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) $ C.AddressOf (C.FieldOf (C.FieldOf (C.FieldOf (C.DerefField (C.Variable "msg") "args") n) "in") an) ] 918 rpc_assignment n (RPCArgIn _ (StringArray an l)) = 919 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) $ (C.FieldOf (C.FieldOf (C.FieldOf (C.DerefField (C.Variable "msg") "args") n) "in") an) ] 920 rpc_assignment n (RPCArgIn _ (DynamicArray an al _)) = 921 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) $ (C.FieldOf (C.FieldOf (C.FieldOf (C.DerefField (C.Variable "msg") "args") n) "in") an), 922 C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") al))) $ C.AddressOf (C.FieldOf (C.FieldOf (C.FieldOf (C.DerefField (C.Variable "msg") "args") n) "in") al) ] 923 rpc_assignment n (RPCArgOut _ (Name an)) = 924 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) $ C.AddressOf (C.FieldOf (C.FieldOf (C.FieldOf (C.DerefField (C.Variable "msg") "args") n) "out") an) ] 925 rpc_assignment n (RPCArgOut _ (StringArray an l)) = 926 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) $ (C.FieldOf (C.FieldOf (C.FieldOf (C.DerefField (C.Variable "msg") "args") n) "out") an) ] 927 rpc_assignment n (RPCArgOut _ (DynamicArray an al _)) = 928 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) $ (C.FieldOf (C.FieldOf (C.FieldOf (C.DerefField (C.Variable "msg") "args") n) "out") an), 929 C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") al))) $ C.AddressOf (C.FieldOf (C.FieldOf (C.FieldOf (C.DerefField (C.Variable "msg") "args") n) "out") al) ] 930 message_assignment n (Arg _ (Name an)) = 931 [ C.Ex $ C.Assignment (((C.FieldOf ((C.FieldOf (C.Variable "_args") n)) an))) $ C.AddressOf (C.FieldOf (C.FieldOf (C.DerefField (C.Variable "msg") "args") n) an) ] 932 message_assignment n (Arg _ (StringArray an l)) = 933 [ C.Ex $ C.Assignment (((C.FieldOf ((C.FieldOf (C.Variable "_args") n)) an))) $ (C.FieldOf (C.FieldOf (C.DerefField (C.Variable "msg") "args") n) an) ] 934 message_assignment n (Arg _ (DynamicArray an al _)) = 935 [ C.Ex $ C.Assignment (((C.FieldOf ((C.FieldOf (C.Variable "_args") n)) an))) $ (C.FieldOf (C.FieldOf (C.DerefField (C.Variable "msg") "args") n) an), 936 C.Ex $ C.Assignment (((C.FieldOf ((C.FieldOf (C.Variable "_args") n)) al))) $ C.AddressOf (C.FieldOf (C.FieldOf (C.DerefField (C.Variable "msg") "args") n) al) ] 937 dir_args ServerSide args = [ a | a@(RPCArgIn _ _) <- args ] 938 dir_args ClientSide args = [ a | a@(RPCArgOut _ _) <- args ] 939 assignments m@(RPC n args _) = concat [ rpc_assignment n a | a <- dir_args side args ] 940 assignments m@(Message _ n args _) = concat [ message_assignment n a | a <- args ] 941 start_receiving m = (assignments m) ++ [ 942 C.Ex $ C.Call start_receive_case_fn_name [ pb, per_rx_state m, p_rxi ] 943 ] 944 receive_any_fn_body = [ 945 C.VarDecl C.NoScope C.NonConst (C.Struct $ ptr_binding_arg_struct_type ifn) "_args" Nothing, 946 C.VarDecl C.NoScope C.NonConst (C.Struct thc_receiver_info) "_rxi" Nothing, 947 C.VarDecl C.NoScope C.NonConst (C.TypeName "errval_t") "_r" (Just (C.NumConstant 0)), 948 C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "waiter") $ C.Variable "NULL", 949 C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "args") $ C.AddressOf $ C.Variable "_args", 950 C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "msg") $ C.Cast (C.Ptr $ C.TypeName "int") (C.AddressOf $ C.DerefField (C.Variable "msg") "msg"), 951 C.Ex $ C.Call (start_receive_any_fn_name) [ pb ] ] 952 ++ [ interested m $ start_receiving m | m <- ms ] 953 ++ [ wait_call cb ] 954 ++ [ interested m [ C.Ex $ C.Call end_receive_case_fn_name [ pb, per_rx_state m, p_rxi ] ] | m <- ms ] 955 ++ [ 956 C.Ex $ C.Call (end_receive_any_fn_name) [ pb ], 957 C.Return $ C.Variable "_r" 958 ] 959 in C.FunctionDef C.Static (C.TypeName "errval_t") (fn_name cb) 960 receive_any_fn_args 961 receive_any_fn_body; 962 963-- RPC layer 964 965gen_call_seq cb ifn m@(RPC n args _) = 966 let fn_name CANCELABLE = call_seq_fn_name_x ifn n 967 fn_name NONCANCELABLE = call_seq_fn_name ifn n 968 call_function_args = 969 concat [ 970 [C.Param (C.Ptr $ C.TypeName $ intf_bind_type ifn "client") intf_bind_var], 971 (concat [ call_rpc_argdecl ifn a | a <- args ]) ] 972 pb = C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name 973 call_function_body CANCELABLE = [ 974 C.VarDecl C.NoScope C.NonConst (C.TypeName "errval_t") "_result" Nothing, 975 C.Ex $ C.Assignment (C.Variable "_result") (C.CallInd (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "send_x") n) $ concat [ 976 [ C.Variable intf_bind_var ], 977 concat [ send_arg a | a <- args ] 978 ] ), 979 C.If (C.Binary C.Equals (C.Variable "_result") (C.Variable "THC_CANCELED")) 980 [ C.Return (C.Variable "THC_CANCELED") ] 981 ((recv_function_rpc_body "_result" cb ClientSide receive_fn_name_x ifn m) ++ 982 [ C.If (C.Binary C.Equals (C.Variable "_result") (C.Variable "THC_CANCELED")) 983 [ C.Ex $ C.Call "thc_discard" [ 984 pb, 985 C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ THC.resp_msg_enum_elem_name ifn n), 986 C.NumConstant 1 ] ] 987 [], 988 C.Return $ C.Variable "_result" ]) 989 990 ] 991 call_function_body NONCANCELABLE = [ 992 C.Ex $ C.CallInd (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "send") n) $ concat [ 993 [ C.Variable intf_bind_var ], 994 concat [ send_arg a | a <- args ] 995 ], 996 C.Return $ C.CallInd (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "recv") n) $ concat [ 997 [ C.Variable intf_bind_var ], 998 concat [ receive_arg a | a <- args ] 999 ] 1000 ] 1001 send_arg (RPCArgIn tr (Name an)) = [ C.Variable an ] 1002 send_arg (RPCArgIn tr (StringArray an l)) = [ C.Variable an ] 1003 send_arg (RPCArgIn tr (DynamicArray an al _)) = [ C.Variable an, C.Variable al ] 1004 send_arg (RPCArgOut _ _ ) = [ ] 1005 receive_arg (RPCArgOut tr (Name an)) = [ C.Variable an ] 1006 receive_arg (RPCArgOut tr (StringArray an l)) = [ C.Variable an ] 1007 receive_arg (RPCArgOut tr (DynamicArray an al _)) = [ C.Variable an, C.Variable al ] 1008 receive_arg (RPCArgIn _ _ ) = [ ] 1009 in 1010 C.FunctionDef C.Static (C.TypeName "errval_t") (fn_name cb) 1011 call_function_args 1012 ( call_function_body cb ) 1013 1014 1015gen_call_fifo cb ifn m@(RPC n args _) = 1016 let fn_name CANCELABLE = call_fifo_fn_name_x ifn n 1017 fn_name NONCANCELABLE = call_fifo_fn_name ifn n 1018 call_function_args = 1019 concat [ 1020 [C.Param (C.Ptr $ C.TypeName $ intf_bind_type ifn "client") intf_bind_var], 1021 (concat [ call_rpc_argdecl ifn a | a <- args ]) ] 1022 pb = C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name 1023 perrx_ nm = C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ nm) 1024 perrx m@(RPC n args _) = perrx_ $ recvEnum ClientSide ifn n 1025 recvEnum ClientSide = THC.resp_msg_enum_elem_name 1026 call_function_body CANCELABLE = [ 1027 C.VarDecl C.NoScope C.NonConst (C.TypeName "uint64_t") "_bailed" Nothing, 1028 C.VarDecl C.NoScope C.NonConst (C.TypeName "errval_t") "_result" Nothing, 1029 C.VarDecl C.NoScope C.NonConst (C.TypeName "thc_queue_entry_t") "_q" Nothing, 1030 C.Ex $ C.Call "thc_lock_acquire" [C.AddressOf $ C.DerefField (perrx m) "fifo_rpc_lock" ], 1031 C.Ex $ C.Assignment (C.Variable "_result") $ C.CallInd (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "send_x") n) $ concat [ 1032 [ C.Variable intf_bind_var ], 1033 concat [ send_arg a | a <- args ] 1034 ], 1035 C.If (C.Binary C.Equals (C.Variable "_result") (C.Variable "THC_CANCELED")) 1036 [ C.Ex $ C.Call "thc_lock_release" [C.AddressOf $ C.DerefField (perrx m) "fifo_rpc_lock" ], 1037 C.Return (C.Variable "THC_CANCELED") ] 1038 [ ], 1039 C.Ex $ C.Call "thc_queue_enter" [C.AddressOf $ C.DerefField (perrx m) "fifo_rpc_q", C.AddressOf $ C.Variable "_q" ], 1040 C.Ex $ C.Call "thc_lock_release" [C.AddressOf $ C.DerefField (perrx m) "fifo_rpc_lock" ], 1041 C.Ex $ C.Assignment (C.Variable "_result") $ C.Call "thc_queue_await_turn_x" [C.AddressOf $ C.DerefField (perrx m) "fifo_rpc_q", C.AddressOf $ C.Variable "_q" ], 1042 C.If (C.Binary C.Equals (C.Variable "_result") (C.Variable "THC_CANCELED")) 1043 [ C.Ex $ C.Assignment (C.Variable "_bailed") $ C.Call "thc_queue_leave" [C.AddressOf $ C.DerefField (perrx m) "fifo_rpc_q", C.AddressOf $ C.Variable "_q" ], 1044 C.Ex $ C.Call "thc_discard" [ 1045 pb, 1046 C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ THC.resp_msg_enum_elem_name ifn n), 1047 C.Variable "_bailed" ], 1048 C.Return (C.Variable "THC_CANCELED") ] 1049 [ ] 1050 ] ++ (recv_function_rpc_body "_result" cb ClientSide receive_fn_name_x ifn m) ++ [ 1051 C.Ex $ C.Assignment (C.Variable "_bailed") $ C.Call "thc_queue_leave" [C.AddressOf $ C.DerefField (perrx m) "fifo_rpc_q", C.AddressOf $ C.Variable "_q" ], 1052 C.Ex $ C.Call "thc_discard" [ 1053 pb, 1054 C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ THC.resp_msg_enum_elem_name ifn n), 1055 C.Variable "_bailed" ], 1056 C.Return $ C.Variable "_result" 1057 ] 1058 call_function_body NONCANCELABLE = [ 1059 C.VarDecl C.NoScope C.NonConst (C.TypeName "uint64_t") "_bailed" Nothing, 1060 C.VarDecl C.NoScope C.NonConst (C.TypeName "errval_t") "_result" Nothing, 1061 C.VarDecl C.NoScope C.NonConst (C.TypeName "thc_queue_entry_t") "_q" Nothing, 1062 C.Ex $ C.Call "thc_lock_acquire" [C.AddressOf $ C.DerefField (perrx m) "fifo_rpc_lock" ], 1063 C.Ex $ C.CallInd (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "send") n) $ concat [ 1064 [ C.Variable intf_bind_var ], 1065 concat [ send_arg a | a <- args ] 1066 ], 1067 C.Ex $ C.Call "thc_queue_enter" [C.AddressOf $ C.DerefField (perrx m) "fifo_rpc_q", C.AddressOf $ C.Variable "_q" ], 1068 C.Ex $ C.Call "thc_lock_release" [C.AddressOf $ C.DerefField (perrx m) "fifo_rpc_lock" ], 1069 C.Ex $ C.Call "thc_queue_await_turn" [C.AddressOf $ C.DerefField (perrx m) "fifo_rpc_q", C.AddressOf $ C.Variable "_q" ], 1070 C.Ex $ C.Assignment (C.Variable "_result") $ C.CallInd (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "recv") n) $ concat [ 1071 [ C.Variable intf_bind_var ], 1072 concat [ receive_arg a | a <- args ] 1073 ], 1074 C.Ex $ C.Assignment (C.Variable "_bailed") $ C.Call "thc_queue_leave" [C.AddressOf $ C.DerefField (perrx m) "fifo_rpc_q", C.AddressOf $ C.Variable "_q" ], 1075 C.Ex $ C.Call "thc_discard" [ 1076 pb, 1077 C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ THC.resp_msg_enum_elem_name ifn n), 1078 C.Variable "_bailed" ], 1079 C.Return $ C.Variable "_result" 1080 ] 1081 send_arg (RPCArgIn tr (Name an)) = [ C.Variable an ] 1082 send_arg (RPCArgIn tr (StringArray an _)) = [ C.Variable an ] 1083 send_arg (RPCArgIn tr (DynamicArray an al _)) = [ C.Variable an, C.Variable al ] 1084 send_arg (RPCArgOut _ _ ) = [ ] 1085 receive_arg (RPCArgOut tr (Name an)) = [ C.Variable an ] 1086 receive_arg (RPCArgOut tr (StringArray an _)) = [ C.Variable an ] 1087 receive_arg (RPCArgOut tr (DynamicArray an al _)) = [ C.Variable an, C.Variable al ] 1088 receive_arg (RPCArgIn _ _ ) = [ ] 1089 in 1090 C.FunctionDef C.Static (C.TypeName "errval_t") (fn_name cb) 1091 call_function_args 1092 ( call_function_body cb ) 1093 1094 1095gen_call_ooo cb ifn m@(RPC n (_:_:args) _) = 1096 let fn_name CANCELABLE = call_ooo_fn_name_x ifn n 1097 fn_name NONCANCELABLE = call_ooo_fn_name ifn n 1098 pb = C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.thc_per_binding_state_name 1099 call_function_args = 1100 concat [ 1101 [C.Param (C.Ptr $ C.TypeName $ intf_bind_type ifn "client") intf_bind_var], 1102 (concat [ call_rpc_argdecl ifn a | a <- args ]) ] 1103 assignment (RPCArgIn _ (Name an)) = 1104 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) (C.Variable an) ] 1105 assignment (RPCArgIn _ (StringArray an _)) = 1106 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) (C.Variable an) ] 1107 assignment (RPCArgIn _ (DynamicArray an al _)) = 1108 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) (C.Variable an), 1109 C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") al))) (C.Variable al) ] 1110 assignment (RPCArgOut _ (Name an)) = 1111 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) (C.Variable an) ] 1112 assignment (RPCArgOut _ (StringArray an _)) = 1113 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) (C.Variable an) ] 1114 assignment (RPCArgOut _ (DynamicArray an al _)) = 1115 [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) (C.Variable an), 1116 C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") al))) (C.Variable al) ] 1117 call_function_body CANCELABLE = [ 1118 C.VarDecl C.NoScope C.NonConst (C.TypeName "errval_t") "_result" Nothing, 1119 C.VarDecl C.NoScope C.NonConst (C.Struct $ ptr_binding_arg_struct_type ifn) "_args" Nothing, 1120 C.VarDecl C.NoScope C.NonConst (C.Struct thc_receiver_info) "_rxi" Nothing, 1121 C.VarDecl C.NoScope C.NonConst (C.TypeName "int") "_msg" Nothing, 1122 C.VarDecl C.NoScope C.NonConst (C.TypeName "uint64_t") "_seq" Nothing ] 1123 ++ concat [ assignment a | a@(RPCArgOut _ _) <- args ] 1124 ++ [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") "seq_out"))) (C.AddressOf $ C.Variable "_seq") ] 1125 ++ [ 1126 C.Ex $ C.Assignment (C.Variable "_seq") (C.Call "thc_seq_ticket" [C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.ooo_rpc_seq_name ]), 1127 C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "waiter") $ C.Variable "NULL", 1128 C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "args") $ C.AddressOf $ C.Variable "_args", 1129 C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "msg") $ C.AddressOf $ C.Variable "_msg", 1130 C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "demux") $ C.Variable "_seq", 1131 C.Ex $ C.Call start_receive_demux_fn_name [ 1132 pb, 1133 C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ THC.resp_msg_enum_elem_name ifn n), 1134 C.AddressOf $ C.Variable "_rxi" 1135 ], 1136 C.Ex $ C.Assignment (C.Variable "_result") $ C.CallInd (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "send_x") n) $ concat [ 1137 [ C.Variable intf_bind_var, 1138 C.Variable "_seq" ], 1139 concat [ send_arg a | a <- args ] 1140 ], 1141 C.If (C.Binary C.Equals (C.Variable "_result") (C.Variable "THC_CANCELED")) 1142 [ C.Return $ C.Call cancel_receive_demux_fn_name [ 1143 pb, 1144 C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ THC.resp_msg_enum_elem_name ifn n), 1145 C.AddressOf $ C.Variable "_rxi" 1146 ] 1147 ] 1148 [ C.Return $ C.Call receive_demux_fn_name_x [ 1149 pb, 1150 C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ THC.resp_msg_enum_elem_name ifn n), 1151 C.AddressOf $ C.Variable "_rxi" 1152 ] 1153 ] 1154 ] 1155 call_function_body NONCANCELABLE = [ 1156 C.VarDecl C.NoScope C.NonConst (C.Struct $ ptr_binding_arg_struct_type ifn) "_args" Nothing, 1157 C.VarDecl C.NoScope C.NonConst (C.Struct thc_receiver_info) "_rxi" Nothing, 1158 C.VarDecl C.NoScope C.NonConst (C.TypeName "int") "_msg" Nothing, 1159 C.VarDecl C.NoScope C.NonConst (C.TypeName "uint64_t") "_seq" Nothing ] 1160 ++ concat [ assignment a | a@(RPCArgOut _ _) <- args ] 1161 ++ [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") "seq_out"))) (C.AddressOf $ C.Variable "_seq") ] 1162 ++ [ 1163 C.Ex $ C.Assignment (C.Variable "_seq") (C.Call "thc_seq_ticket" [C.AddressOf $ C.DerefField (C.Variable intf_bind_var) THC.ooo_rpc_seq_name ]), 1164 C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "waiter") $ C.Variable "NULL", 1165 C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "args") $ C.AddressOf $ C.Variable "_args", 1166 C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "msg") $ C.AddressOf $ C.Variable "_msg", 1167 C.Ex $ C.Assignment (C.FieldOf (C.Variable "_rxi") "demux") $ C.Variable "_seq", 1168 C.Ex $ C.Call start_receive_demux_fn_name [ 1169 pb, 1170 C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ THC.resp_msg_enum_elem_name ifn n), 1171 C.AddressOf $ C.Variable "_rxi" 1172 ], 1173 C.Ex $ C.CallInd (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "send") n) $ concat [ 1174 [ C.Variable intf_bind_var, 1175 C.Variable "_seq" ], 1176 concat [ send_arg a | a <- args ] 1177 ], 1178 C.Return $ C.Call receive_demux_fn_name [ 1179 pb, 1180 C.AddressOf $ C.SubscriptOf (C.DerefField (C.Variable intf_bind_var) THC.thc_per_recv_state_name) (C.Variable $ THC.resp_msg_enum_elem_name ifn n), 1181 C.AddressOf $ C.Variable "_rxi" 1182 ] 1183 ] 1184 send_arg (RPCArgIn tr (Name an)) = [ C.Variable an ] 1185 send_arg (RPCArgIn tr (StringArray an _)) = [ C.Variable an ] 1186 send_arg (RPCArgIn tr (DynamicArray an al _)) = [ C.Variable an, C.Variable al ] 1187 send_arg (RPCArgOut _ _ ) = [ ] 1188 receive_arg (RPCArgOut tr (Name an)) = [ C.Variable an ] 1189 receive_arg (RPCArgOut tr (StringArray an _)) = [ C.Variable an ] 1190 receive_arg (RPCArgOut tr (DynamicArray an al _)) = [ C.Variable an, C.Variable al ] 1191 receive_arg (RPCArgIn _ _ ) = [ ] 1192 in 1193 C.FunctionDef C.Static (C.TypeName "errval_t") (fn_name cb) 1194 call_function_args 1195 (call_function_body cb) 1196 1197-- static void ping_pong_thc_export_export_cb(void *st, 1198-- errval_t err, 1199-- iref_t iref) { 1200-- struct ping_pong_thc_export_info *info; 1201-- info = (struct ping_pong_thc_export_info*) st; 1202-- thc_lock_acquire(&info->info_lock); 1203-- if (err_is_fail(err)) { 1204-- info->err = err; 1205-- } else { 1206-- if (info->service_name != NULL) { 1207-- info->err = nameservice_register(info->service_name, 1208-- iref); 1209-- } 1210-- if (info->iref_ptr != NULL) { 1211-- *(info->iref_ptr) = iref; 1212-- } 1213-- } 1214-- thc_sem_v(&info->export_cb_done_sem); 1215-- } 1216 1217export_cb_function :: String -> C.Unit 1218export_cb_function ifn = 1219 let info_ptr_t = C.Ptr $ THC.thc_export_info_t ifn 1220 info_err = C.DerefField (C.Variable "info") "err" 1221 info_service_name = C.DerefField (C.Variable "info") "service_name" 1222 info_iref_ptr = C.DerefField (C.Variable "info") "iref_ptr" 1223 ptr_info_info_lock = C.AddressOf $ C.DerefField (C.Variable "info") "info_lock" 1224 var_st = C.Variable "st" 1225 var_err = C.Variable "err" 1226 var_iref = C.Variable "iref" 1227 in 1228 C.FunctionDef C.Static (C.TypeName "void") (ifscope ifn "thc_export_cb") 1229 [ C.Param (C.Ptr $ C.TypeName "void") "st", 1230 C.Param (C.TypeName "errval_t") "err", 1231 C.Param (C.TypeName "iref_t") "iref" ] 1232 [ 1233 C.VarDecl C.NoScope C.NonConst info_ptr_t "info" Nothing, 1234 C.Ex $ C.Assignment (C.Variable "info") (C.Cast info_ptr_t var_st), 1235 C.Ex $ C.Call "thc_lock_acquire" [ptr_info_info_lock], 1236 C.If (C.Call "err_is_fail" [ var_err ]) 1237 -- Error passed in to us 1238 [C.Ex $ C.Assignment info_err var_err ] 1239 -- OK so far 1240 [ C.If (C.Binary C.NotEquals info_service_name (C.Variable "NULL")) 1241 [ C.Ex $ C.Assignment info_err (C.Call "nameservice_register" [ info_service_name, var_iref]) ] [ ], 1242 C.If (C.Binary C.NotEquals info_iref_ptr (C.Variable "NULL")) 1243 [ C.Ex $ C.Assignment (C.DerefPtr info_iref_ptr) var_iref ] [ ] 1244 ], 1245 -- Wake THC export call 1246 C.Ex $ C.Call "thc_sem_v" [ C.AddressOf $ C.DerefField (C.Variable "info") "export_cb_done_sem"] 1247 ] 1248 1249-- static errval_t ping_pong_thc_export_connect_cb(void *st, 1250-- struct ping_pong_binding *b) { 1251-- struct ping_pong_thc_export_info *info; 1252-- info = (struct ping_pong_thc_export_info*) st; 1253-- 1254-- // Wait for top-half accept call to be present 1255-- thc_sem_p(&info->accept_call_present_sem); 1256-- 1257-- // Transfer information to top-half 1258-- thc_lock_acquire(&info->info_lock); 1259-- *(info->b) = b; 1260-- 1261-- // Signal that information has arrived 1262-- thc_sem_v(&info->connect_cb_done_sem); 1263-- return SYS_ERR_OK; 1264-- } 1265 1266connect_cb_function :: String -> C.Unit 1267connect_cb_function ifn = 1268 let info_ptr_t = C.Ptr $ THC.thc_export_info_t ifn 1269 info_b = C.DerefField (C.Variable "info") "b" 1270 ptr_info_accept_call_present_sem = C.AddressOf $ C.DerefField (C.Variable "info") "accept_call_present_sem" 1271 ptr_info_connect_cb_done_sem = C.AddressOf $ C.DerefField (C.Variable "info") "connect_cb_done_sem" 1272 ptr_info_info_lock = C.AddressOf $ C.DerefField (C.Variable "info") "info_lock" 1273 var_st = C.Variable "st" 1274 var_b = C.Variable "b" 1275 in 1276 C.FunctionDef C.Static (C.TypeName "errval_t") (ifscope ifn "thc_connect_cb") 1277 [ C.Param (C.Ptr $ C.TypeName "void") "st", 1278 C.Param (C.Ptr $ C.Struct $ BC.intf_bind_type ifn) "b" ] 1279 [ 1280 C.VarDecl C.NoScope C.NonConst info_ptr_t "info" Nothing, 1281 C.Ex $ C.Assignment (C.Variable "info") (C.Cast info_ptr_t var_st), 1282 C.Ex $ C.Call "thc_sem_p" [ptr_info_accept_call_present_sem], 1283 C.Ex $ C.Call "thc_lock_acquire" [ptr_info_info_lock], 1284 C.Ex $ C.Assignment (C.DerefPtr info_b) var_b, 1285 C.Ex $ C.Call "thc_sem_v" [ptr_info_connect_cb_done_sem], 1286 C.Return $ C.Variable "SYS_ERR_OK" 1287 ] 1288 1289-- errval_t ping_pong_thc_export(struct ping_pong_thc_export_info *info, 1290-- const char *service_name, 1291-- struct waitset *ws, 1292-- idc_export_flags_t flags, 1293-- iref_t iref_ptr) { 1294-- errval_t err; 1295-- 1296-- thc_sem_init(&info->export_cb_done_sem, 0); 1297-- thc_sem_init(&info->connect_cb_done_sem, 0); 1298-- thc_sem_init(&info->accept_call_present_sem, 0); 1299-- thc_lock_init(&info->info_lock); 1300-- thc_lock_init(&info->next_accept_lock); 1301-- info->service_name = service_name; 1302-- info->err = SYS_ERR_OK; 1303-- info->iref_ptr = iref_ptr; 1304-- err = ping_pong_export(info, 1305-- ping_pong_thc_export_export_cb, 1306-- ping_pong_thc_export_connect_cb, 1307-- ws, 1308-- flags); 1309-- if (err_is_ok(err)) { 1310-- thc_sem_p(&info->export_cb_done_sem); 1311-- err = info->err; 1312-- thc_lock_release(&info->info_lock); 1313-- } 1314-- 1315-- return err; 1316-- } 1317 1318export_function :: String -> C.Unit 1319export_function ifn = 1320 let info_ptr_t = C.Ptr $ THC.thc_export_info_t ifn 1321 info_service_name = C.DerefField (C.Variable "info") "service_name" 1322 info_err = C.DerefField (C.Variable "info") "err" 1323 info_iref_ptr = C.DerefField (C.Variable "info") "iref_ptr" 1324 ptr_info_export_cb_done_sem = C.AddressOf $ C.DerefField (C.Variable "info") "export_cb_done_sem" 1325 ptr_info_connect_cb_done_sem = C.AddressOf $ C.DerefField (C.Variable "info") "connect_cb_done_sem" 1326 ptr_info_accept_call_present_sem = C.AddressOf $ C.DerefField (C.Variable "info") "accept_call_present_sem" 1327 ptr_info_info_lock = C.AddressOf $ C.DerefField (C.Variable "info") "info_lock" 1328 ptr_info_next_accept_lock = C.AddressOf $ C.DerefField (C.Variable "info") "next_accept_lock" 1329 var_err = C.Variable "err" 1330 var_info = C.Variable "info" 1331 var_ws = C.Variable "ws" 1332 var_flags = C.Variable "flags" 1333 var_service_name = C.Variable "service_name" 1334 var_iref_ptr = C.Variable "iref_ptr" 1335 in 1336 C.FunctionDef C.NoScope (C.TypeName "errval_t") (THC.thc_export_fn_name ifn) 1337 [ C.Param (C.Ptr $ THC.thc_export_info_t ifn) "info", 1338 C.Param (C.ConstT $ C.Ptr $ C.TypeName "char") "service_name", 1339 C.Param (C.Ptr $ C.Struct "waitset") "ws", 1340 C.Param (C.TypeName "idc_export_flags_t") "flags", 1341 C.Param (C.Ptr $ C.TypeName "iref_t") "iref_ptr" ] 1342 [ 1343 C.VarDecl C.NoScope C.NonConst (C.TypeName "errval_t") "err" Nothing, 1344 C.Ex $ C.Call "thc_sem_init" [ptr_info_export_cb_done_sem, C.NumConstant 0], 1345 C.Ex $ C.Call "thc_sem_init" [ptr_info_connect_cb_done_sem, C.NumConstant 0], 1346 C.Ex $ C.Call "thc_sem_init" [ptr_info_accept_call_present_sem, C.NumConstant 0], 1347 C.Ex $ C.Call "thc_lock_init" [ptr_info_info_lock], 1348 C.Ex $ C.Call "thc_lock_init" [ptr_info_next_accept_lock], 1349 C.Ex $ C.Assignment info_service_name var_service_name, 1350 C.Ex $ C.Assignment info_err (C.Variable "SYS_ERR_OK"), 1351 C.Ex $ C.Assignment info_iref_ptr var_iref_ptr, 1352 C.Ex $ C.Assignment var_err (C.Call (ifn ++ "_export") 1353 [ var_info, 1354 C.Variable $ ifscope ifn "thc_export_cb", 1355 C.Variable $ ifscope ifn "thc_connect_cb", 1356 var_ws, 1357 var_flags ]), 1358 C.If ( C.Call "err_is_ok" [ var_err ]) 1359 -- No error on export, wait for callback to finish 1360 [ C.Ex $ C.Call "thc_sem_p" [ ptr_info_export_cb_done_sem ], 1361 C.Ex $ C.Assignment var_err info_err, 1362 C.Ex $ C.Call "thc_lock_release" [ ptr_info_info_lock ] 1363 ] 1364 -- Error on export 1365 [ ], 1366 C.Return var_err 1367 ] 1368 1369 1370-- errval_t ping_pong_thc_accept(struct ping_pong_thc_export_info *info, 1371-- struct ping_pong_binding **b) { 1372-- struct ping_pong_binding *priv_b; 1373-- 1374-- // Wait to be the next accepter 1375-- thc_lock_acquire(&info->next_accept_lock); 1376-- info->b = &priv_b; 1377-- 1378-- // Signal to the bottom half that we are present 1379-- thc_sem_v(&info->accept_call_present_sem); 1380-- 1381-- // Wait for the bottom half to fill in the results 1382-- thc_sem_p(&info->connect_cb_done_sem); 1383-- errval_t err = info->err; 1384-- thc_lock_release(&info->info_lock); 1385-- thc_lock_release(&info->next_accept_lock); 1386-- 1387-- if (err_is_ok(err)) { 1388-- if (b != NULL) { 1389-- *b = priv_b; 1390-- } 1391-- } 1392-- 1393-- return err; 1394-- } 1395-- 1396 1397accept_function :: String -> C.Unit 1398accept_function ifn = 1399 let info_service_name = C.DerefField (C.Variable "info") "service_name" 1400 info_err = C.DerefField (C.Variable "info") "err" 1401 info_b = C.DerefField (C.Variable "info") "b" 1402 ptr_info_export_cb_done_sem = C.AddressOf $ C.DerefField (C.Variable "info") "export_cb_done_sem" 1403 ptr_info_connect_cb_done_sem = C.AddressOf $ C.DerefField (C.Variable "info") "connect_cb_done_sem" 1404 ptr_info_accept_call_present_sem = C.AddressOf $ C.DerefField (C.Variable "info") "accept_call_present_sem" 1405 ptr_info_info_lock = C.AddressOf $ C.DerefField (C.Variable "info") "info_lock" 1406 ptr_info_next_accept_lock = C.AddressOf $ C.DerefField (C.Variable "info") "next_accept_lock" 1407 var_priv_b = C.Variable "priv_b" 1408 var_err = C.Variable "err" 1409 var_b = C.Variable "b" 1410 var_sv = C.Variable "sv" 1411 var_info = C.Variable "info" 1412 var_ws = C.Variable "ws" 1413 var_flags = C.Variable "flags" 1414 var_service_name = C.Variable "service_name" 1415 in 1416 C.FunctionDef C.NoScope (C.TypeName "errval_t") (THC.thc_accept_fn_name ifn) 1417 [ C.Param (C.Ptr $ THC.thc_export_info_t ifn) "info", 1418 C.Param (C.Ptr $ C.Ptr $ C.Struct $ BC.intf_bind_type ifn) "b" ] 1419 [ 1420 C.VarDecl C.NoScope C.NonConst (C.Ptr $ C.Struct $ BC.intf_bind_type ifn) "priv_b" Nothing, 1421 -- Wait to be the next accepter 1422 C.Ex $ C.Call "thc_lock_acquire" [ ptr_info_next_accept_lock ], 1423 C.Ex $ C.Assignment info_b $ C.AddressOf var_priv_b, 1424 -- Signal to the bottom half that we are present 1425 C.Ex $ C.Call "thc_sem_v" [ ptr_info_accept_call_present_sem ], 1426 -- Wait for the bottom half to fill in the results 1427 C.Ex $ C.Call "thc_sem_p" [ ptr_info_connect_cb_done_sem ], 1428 C.VarDecl C.NoScope C.NonConst (C.TypeName "errval_t") "err" (Just info_err), 1429 C.Ex $ C.Call "thc_lock_release" [ ptr_info_info_lock ], 1430 C.Ex $ C.Call "thc_lock_release" [ ptr_info_next_accept_lock ], 1431 -- If we're OK so far... 1432 C.If ( C.Call "err_is_ok" [ var_err ]) 1433 [ 1434 -- Return "b" if requested 1435 C.If ( C.Binary C.NotEquals var_b (C.Variable "NULL")) 1436 [ C.Ex $ C.Assignment (C.DerefPtr var_b) var_priv_b 1437 ] [ ] 1438 ] [ ], 1439 -- Done 1440 C.Return var_err 1441 ] 1442 1443-- static void ping_pong_thc_bind_cb(void *st, 1444-- errval_t err, 1445-- struct ping_pong_binding *b) { 1446-- struct ping_pong_thc_connect_info *info; 1447-- info = (struct ping_pong_thc_connect_info *) st; 1448-- info->err = err; 1449-- if (err_is_ok(err)) { 1450-- info->b = b; 1451-- } 1452-- thc_sem_v(&info->bind_cb_done_sem); 1453-- } 1454 1455bind_cb_function :: String -> C.Unit 1456bind_cb_function ifn = 1457 let info_ptr_t = C.Ptr $ THC.thc_connect_info_t ifn 1458 info_err = C.DerefField (C.Variable "info") "err" 1459 info_b = C.DerefField (C.Variable "info") "b" 1460 ptr_info_bind_cb_done_sem = C.AddressOf $ C.DerefField (C.Variable "info") "bind_cb_done_sem" 1461 var_st = C.Variable "st" 1462 var_err = C.Variable "err" 1463 var_b = C.Variable "b" 1464 in 1465 C.FunctionDef C.Static (C.TypeName "void") (ifscope ifn "thc_bind_cb") 1466 [ C.Param (C.Ptr $ C.TypeName "void") "st", 1467 C.Param (C.TypeName "errval_t") "err", 1468 C.Param (C.Ptr $ C.Struct $ BC.intf_bind_type ifn) "b" ] 1469 [ 1470 C.VarDecl C.NoScope C.NonConst info_ptr_t "info" Nothing, 1471 C.Ex $ C.Assignment (C.Variable "info") (C.Cast info_ptr_t var_st), 1472 C.Ex $ C.Assignment info_err var_err, 1473 C.If (C.Call "err_is_ok" [ var_err ]) 1474 [ -- No error passed to us 1475 C.Ex $ C.Assignment info_b var_b 1476 ] [], 1477 C.Ex $ C.Call "thc_sem_v" [ ptr_info_bind_cb_done_sem ] 1478 ] 1479 1480-- static errval_t ping_pong_thc_bind(const char *service_name, 1481-- struct waitset *ws, 1482-- int flags, 1483-- struct ping_pong_binding **b) { 1484-- struct ping_pong_thc_connect_info info; 1485-- errval_t err; 1486-- iref_t iref; 1487-- thc_sem_init(&info.bind_cb_done_sem, 0); 1488-- info.err = SYS_ERR_OK; 1489-- info.b = NULL; 1490-- err = nameservice_blocking_lookup(service_name, &iref); 1491-- if (err_is_ok(err)) { 1492-- err = ping_pong_bind(iref, 1493-- ping_pong_thc_bind_cb, 1494-- &info, 1495-- ws, 1496-- flags); 1497-- if (err_is_ok(err)) { 1498-- thc_sem_p(&info.bind_cb_done_sem); 1499-- err = info.err; 1500-- if (err_is_ok(err)) { 1501-- if (b != NULL) { 1502-- *b = info.b; 1503-- } 1504-- } 1505-- } 1506-- } 1507-- return err; 1508-- } 1509 1510connect_by_name_function :: String -> C.Unit 1511connect_by_name_function ifn = 1512 let var_err = C.Variable "err" 1513 var_service_name = C.Variable "service_name" 1514 var_ws = C.Variable "ws" 1515 var_b = C.Variable "b" 1516 var_flags = C.Variable "flags" 1517 var_iref = C.Variable "iref" 1518 ptr_iref = C.AddressOf var_iref 1519 in 1520 C.FunctionDef C.NoScope (C.TypeName "errval_t") (THC.thc_connect_by_name_fn_name ifn) 1521 [ C.Param (C.ConstT $ C.Ptr $ C.TypeName "char") "service_name", 1522 C.Param (C.Ptr $ C.Struct "waitset") "ws", 1523 C.Param (C.TypeName "idc_bind_flags_t") "flags", 1524 C.Param (C.Ptr $ C.Ptr $ C.Struct $ BC.intf_bind_type ifn) "b" ] 1525 [ 1526 C.VarDecl C.NoScope C.NonConst (C.TypeName "errval_t") "err" Nothing, 1527 C.VarDecl C.NoScope C.NonConst (C.TypeName "iref_t") "iref" Nothing, 1528 -- Name service lookup 1529 C.Ex $ C.Assignment var_err 1530 (C.Call "nameservice_blocking_lookup" 1531 [ var_service_name, ptr_iref ]), 1532 C.If (C.Call "err_is_ok" [ var_err ] ) 1533 [ -- Name service lookup OK 1534 C.Ex $ C.Assignment var_err 1535 (C.Call (THC.thc_connect_fn_name ifn) 1536 [ var_iref, var_ws, var_flags, var_b ]) 1537 ] [ ], 1538 C.Return var_err ] 1539 1540connect_function :: String -> C.Unit 1541connect_function ifn = 1542 let var_err = C.Variable "err" 1543 var_service_name = C.Variable "service_name" 1544 var_ws = C.Variable "ws" 1545 var_b = C.Variable "b" 1546 var_flags = C.Variable "flags" 1547 var_iref = C.Variable "iref" 1548 var_info = C.Variable "info" 1549 var_cl = C.Variable "cl" 1550 ptr_info_bind_cb_done_sem = C.AddressOf $ C.FieldOf (C.Variable "info") "bind_cb_done_sem" 1551 ptr_info = C.AddressOf var_info 1552 info_err = C.FieldOf (C.Variable "info") "err" 1553 info_b = C.FieldOf (C.Variable "info") "b" 1554 in 1555 C.FunctionDef C.NoScope (C.TypeName "errval_t") (THC.thc_connect_fn_name ifn) 1556 [ C.Param (C.TypeName "iref_t") "iref", 1557 C.Param (C.Ptr $ C.Struct "waitset") "ws", 1558 C.Param (C.TypeName "idc_bind_flags_t") "flags", 1559 C.Param (C.Ptr $ C.Ptr $ C.Struct $ BC.intf_bind_type ifn) "b" ] 1560 [ 1561 C.VarDecl C.NoScope C.NonConst (THC.thc_connect_info_t ifn) "info" Nothing, 1562 C.VarDecl C.NoScope C.NonConst (C.TypeName "errval_t") "err" Nothing, 1563 C.Ex $ C.Call "thc_sem_init" [ ptr_info_bind_cb_done_sem, 1564 (C.NumConstant 0) ], 1565 C.Ex $ C.Assignment info_err (C.Variable "SYS_ERR_OK"), 1566 C.Ex $ C.Assignment info_b (C.Variable "NULL"), 1567 C.Ex $ C.Assignment var_err 1568 (C.Call (ifn ++ "_bind") 1569 [ var_iref, (C.Variable $ ifscope ifn "thc_bind_cb"), ptr_info, var_ws, var_flags ]), 1570 C.If (C.Call "err_is_ok" [ var_err ]) 1571 [ -- Bind call OK 1572 C.Ex $ C.Call "thc_sem_p" [ptr_info_bind_cb_done_sem], 1573 C.Ex $ C.Assignment var_err info_err, 1574 C.If (C.Call "err_is_ok" [ var_err ]) 1575 [ -- Bind callback OK 1576 -- Return "b" if requested 1577 C.If ( C.Binary C.NotEquals var_b (C.Variable "NULL")) 1578 [ C.Ex $ C.Assignment (C.DerefPtr var_b) info_b ] [ ] 1579 ] [ ] 1580 ] [ ], 1581 C.Return var_err ] 1582