content: {- 
    UMP_IPI.hs: Flounder stub generator for cross-core message passing using IPIs.
  
    Part of Flounder: a message passing IDL for Barrelfish
     
    Copyright (c) 2007-2010, ETH Zurich.
    All rights reserved.
    
    This file is distributed under the terms in the attached LICENSE file.
    If you do not find this file, copies can be found by writing to:
    ETH Zurich D-INFK, Universit\"atstr. 6, CH-8092 Zurich. Attn: Systems Group.
  -}  
  
  module UMP_IPI where
  
  import CAbsSyntax as C
  import qualified UMPCommon
  import UMPCommon hiding (header, stub)
  import BackendCommon
  
  -- Name of the init function
  init_fn_name n = ifscope n "ump_ipi_init"
  
  uparams = template_params {
      ump_payload = 28, -- bytes
      ump_drv = "ump_ipi",
  
      ump_binding_extra_fields =
          [ C.Param (C.Struct "ipi_notify") "ipi_notify",
            C.Param (C.TypeName "bool") "no_notify"
          ],
      ump_extra_includes = ["arch/x86/barrelfish/ipi_notify.h"],
  
      ump_extra_protos = \ifn -> [init_fn_proto ifn],
      ump_extra_fns = \ifn -> [accept_alloc_notify_cont_fn ifn,
                               bind_alloc_notify_cont_fn ifn,
                               init_fn ifn],
  
      ump_register_recv = ump_ipi_register_recv,
      ump_deregister_recv = ump_ipi_deregister_recv,
      ump_accept_alloc_notify = Just accept_alloc_notify,
      ump_bind_alloc_notify = Just bind_alloc_notify,
      ump_store_notify_cap = store_notify_cap,
      ump_notify = do_notify,
      ump_binding_extra_fields_init = ump_ipi_binding_extra_fields_init,
      ump_connect_extra_fields_init = ump_ipi_connect_extra_fields_init
  }
  
  header = UMPCommon.header uparams
  stub a = UMPCommon.stub (uparams { ump_arch = a })
  
  bind_type ifn = UMPCommon.my_bind_type uparams ifn
  bind_fn_name ifn = UMPCommon.bind_fn_name uparams ifn
  
  accept_alloc_notify_cont_name ifn = ifscope ifn "ump_ipi_accept_alloc_notify_cont"
  bind_alloc_notify_cont_name ifn = ifscope ifn "ump_ipi_bind_alloc_notify_cont"
  
  ump_ipi_binding_extra_fields_init :: [C.Stmt]
  ump_ipi_binding_extra_fields_init =
      [ C.Ex $ C.Assignment (my_bindvar `C.DerefField` "no_notify") $
             C.Ternary (C.Binary C.BitwiseAnd (C.Variable "flags") (C.Variable "IDC_BIND_FLAG_NO_NOTIFY")) (C.Variable "true") (C.Variable "false")
      ]
  
  ump_ipi_connect_extra_fields_init :: [C.Stmt]
  ump_ipi_connect_extra_fields_init =
      [ C.Ex $ C.Assignment (my_bindvar `C.DerefField` "no_notify") $
             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")
      ]
      where
        exportvar = C.Variable "e"
  
  -- generate the code to register for receive notification
  ump_ipi_register_recv :: String -> [C.Stmt]
  ump_ipi_register_recv ifn =
      [ C.If (C.Call "capref_is_null" [notifyvar `C.FieldOf` "my_notify_cap"])
        [ C.Ex $ C.Assignment errvar $ C.Call "ump_chan_register_recv"
          [C.AddressOf $ my_bindvar `C.DerefField` "ump_state" `C.FieldOf` "chan",
           bindvar `C.DerefField` "waitset", C.StructConstant "event_closure"
           [("handler", C.Variable $ rx_handler_name uparams ifn), ("arg", bindvar)]]
        ]
        [ C.Ex $ C.Assignment errvar $ C.Call "ipi_notify_register"
          [notifyaddr, bindvar `C.DerefField` "waitset",
           C.StructConstant "event_closure"
           [("handler", C.Variable $ rx_handler_name uparams ifn), ("arg", bindvar)]]
        ]
      ]
  
  ump_ipi_deregister_recv :: String -> [C.Stmt]
  ump_ipi_deregister_recv ifn =
      [ C.If (C.Call "capref_is_null" [notifyvar `C.FieldOf` "my_notify_cap"])
        [C.Ex $ C.Assignment errvar $ C.Call "ump_chan_deregister_recv"
         [C.AddressOf $ my_bindvar `C.DerefField` "ump_state" `C.FieldOf` "chan"]]
        [C.Ex $ C.Assignment errvar $ C.Call "ipi_notify_deregister" [notifyaddr]]
      ]
  
  alloc_notify :: String -> [C.Stmt]
  alloc_notify handler =
      [ C.If (my_bindvar `C.DerefField` "no_notify")
        [ C.Ex $ C.Assignment errvar $ C.Call "ipi_notify_init"
          [ notifyaddr, C.Variable "NULL_CAP", C.Variable "NULL_CAP",
            C.Variable "NULL_CAP", C.Variable "NULL" ],
  
          C.Ex $ C.Call handler [my_bindvar, errvar, C.Variable "NULL"],
          C.Ex $ (C.Assignment errvar (C.Variable "SYS_ERR_OK"))
        ]
        [ C.Ex $ C.Assignment errvar $ C.Call "ipi_notify_alloc"
          [notifyaddr, C.StructConstant "ipi_alloc_continuation"
           [("handler", C.Variable handler), ("st", my_bindvar)]]
        ]
      ]
      where
          chanvar = my_bindvar `C.DerefField` "ump_state" `C.FieldOf` "chan"
  
  accept_alloc_notify ifn = alloc_notify $ accept_alloc_notify_cont_name ifn
  
  bind_alloc_notify ifn =
      [ C.If (my_bindvar `C.DerefField` "no_notify")
        [ C.Ex $ C.Assignment errvar $ C.Call "ipi_notify_init"
          [ notifyaddr, C.Variable "NULL_CAP", C.Variable "NULL_CAP",
            C.Variable "NULL_CAP", C.Variable "NULL" ],
          C.If (C.Call "err_is_ok" [errvar])
           [ C.Ex $ C.Assignment errvar $ C.Call "ump_chan_bind"
             [C.AddressOf $ chanvar,
              C.StructConstant "ump_bind_continuation"
              [("handler", C.Variable (bind_cont_fn_name uparams ifn)),
               ("st", my_bindvar)],
              C.AddressOf $ intf_bind_var `C.FieldOf` "event_qnode",
               my_bindvar `C.DerefField` "iref",
               chanvar `C.FieldOf` "monitor_binding",
               my_bindvar `C.DerefField` "inchanlen",
               my_bindvar `C.DerefField` "outchanlen",
               C.Variable "NULL_CAP" ] ] []
        ]
        [ C.Ex $ C.Assignment errvar $ C.Call "ipi_notify_alloc"
          [notifyaddr, C.StructConstant "ipi_alloc_continuation"
           [("handler", C.Variable handler), ("st", my_bindvar)]]
        ]
      ]
      where
        statevar = C.DerefField my_bindvar "ump_state"
        chanvar = my_bindvar `C.DerefField` "ump_state" `C.FieldOf` "chan"
        handler = bind_alloc_notify_cont_name ifn
        intf_bind_var = C.DerefField my_bindvar "b"
  
  accept_alloc_notify_cont_fn :: String -> C.Unit
  accept_alloc_notify_cont_fn ifn = 
      C.FunctionDef C.Static C.Void (accept_alloc_notify_cont_name ifn) params [
          localvar (C.Ptr $ C.Struct $ intf_bind_type ifn)
                  intf_bind_var (Just $ C.Variable "st"),
          localvar (C.Ptr $ C.Struct $ my_bind_type uparams ifn)
                  my_bind_var_name (Just $ C.Variable "st"),
          C.SBlank,
  
          C.If (C.Call "err_is_fail" [errvar])
              [report_user_err errvar] [],
          C.SBlank,
  
          C.StmtList $ ump_ipi_register_recv ifn,
          C.SBlank,
  
          C.SComment "send back bind reply",
          C.Ex $ C.Call "ump_chan_send_bind_reply"
              [chanvar `C.FieldOf` "monitor_binding",
               C.AddressOf chanvar,
               errvar,
               chanvar `C.FieldOf` "monitor_id",
               notifyvar `C.FieldOf` "my_notify_cap"]
      ]
      where
          params = [C.Param (C.Ptr C.Void) "st",
                    C.Param (C.TypeName "errval_t") "err",
                    C.Param (C.Ptr $ C.Struct "ipi_notify") "notify"]
          chanvar = my_bindvar `C.DerefField` "ump_state" `C.FieldOf` "chan"
  
  
  bind_alloc_notify_cont_fn :: String -> C.Unit
  bind_alloc_notify_cont_fn ifn = 
      C.FunctionDef C.Static C.Void (bind_alloc_notify_cont_name ifn) params [
          localvar (C.Ptr $ C.Struct $ intf_bind_type ifn)
                  intf_bind_var (Just $ C.Variable "st"),
          localvar (C.Ptr $ C.Struct $ my_bind_type uparams ifn)
                  my_bind_var_name (Just $ C.Variable "st"),
          C.SBlank,
  
          C.If (C.Call "err_is_fail" [errvar])
              [C.Ex $ C.CallInd (bindvar `C.DerefField` "bind_cont")
                  [bindvar `C.DerefField` "st", errvar, bindvar],
               C.Ex $ C.Call (destroy_fn_name uparams ifn) [my_bindvar],
               C.ReturnVoid] [],
          C.SBlank,
  
          C.Ex $ C.Assignment errvar $ C.Call "ump_chan_bind"
              [C.AddressOf $ chanvar,
               C.StructConstant "ump_bind_continuation"
                  [("handler", C.Variable (bind_cont_fn_name uparams ifn)),
                   ("st", my_bindvar)],
               C.AddressOf $ bindvar `C.DerefField` "event_qnode",
               my_bindvar `C.DerefField` "iref",
               chanvar `C.FieldOf` "monitor_binding",
               my_bindvar `C.DerefField` "inchanlen",
               my_bindvar `C.DerefField` "outchanlen",
               notifyvar `C.FieldOf` "my_notify_cap"],
          C.If (C.Call "err_is_fail" [errvar])
              [C.Ex $ C.CallInd (bindvar `C.DerefField` "bind_cont")
                  [bindvar `C.DerefField` "st", errvar, bindvar],
               C.Ex $ C.Call (destroy_fn_name uparams ifn) [my_bindvar]] []
      ]
      where
          params = [C.Param (C.Ptr C.Void) "st",
                    C.Param (C.TypeName "errval_t") "err",
                    C.Param (C.Ptr $ C.Struct "ipi_notify") "notify"]
          chanvar = my_bindvar `C.DerefField` "ump_state" `C.FieldOf` "chan"
  
  store_notify_cap :: String -> C.Expr -> [C.Stmt]
  store_notify_cap ifn capex
      = [C.Ex $ C.Call "ipi_notify_set" [notifyaddr, capex]]
  
  do_notify :: [C.Stmt]
  do_notify =
      [ C.If (C.Unary C.Not $ C.Call "capref_is_null" [notifyvar `C.FieldOf` "rmt_notify_cap"])
        [ C.Ex $ C.Assignment errvar $ C.Call "ipi_notify_raise" [notifyaddr],
          C.If (C.Call "err_is_fail" [errvar])
               [report_user_tx_err $
                C.Call "err_push" [errvar, C.Variable "LIB_ERR_IPI_NOTIFY"]] []] []
      ]
  
  notifyvar = my_bindvar `C.DerefField` "ipi_notify"
  notifyaddr = C.AddressOf $ notifyvar
  
  
  init_fn_proto :: String -> C.Unit
  init_fn_proto n = 
      C.GVarDecl C.Extern C.NonConst 
           (C.Function C.NoScope (C.TypeName "errval_t") (init_params n)) name Nothing
      where 
        name = init_fn_name n
  
  init_params n = [
      C.Param (C.Ptr $ C.Struct (my_bind_type uparams n)) "b",
      C.Param (C.Ptr $ C.Struct "waitset") "waitset",
      C.Param (C.Volatile $ C.Ptr C.Void) "inbuf",
      C.Param (C.TypeName "size_t") "inbufsize",
      C.Param (C.Volatile $ C.Ptr C.Void) "outbuf",
      C.Param (C.TypeName "size_t") "outbufsize",
      C.Param (C.Struct "capref") "rmt_notify_cap",
      C.Param (C.Struct "capref") "my_notify_cap",
      C.Param (C.Struct "capref") "notify_ep_cap",
      C.Param (C.Ptr $ C.Struct "lmp_endpoint") "notify_ep"]
  
  init_fn :: String -> C.Unit
  init_fn ifn =
      C.FunctionDef C.NoScope (C.TypeName "errval_t") (init_fn_name ifn) (init_params ifn)
         [localvar (C.TypeName "errval_t") "err" Nothing,
          localvar (C.Ptr $ C.Struct $ intf_bind_type ifn)
              intf_bind_var (Just $ C.AddressOf $ my_bindvar `C.DerefField` "b"),
          C.StmtList common_init,
          C.Ex $ C.Call "flounder_stub_ump_state_init" [C.AddressOf statevar, my_bindvar],
  
          C.Ex $ C.Assignment errvar $ C.Call "ump_chan_init"
              [C.AddressOf $ statevar `C.FieldOf` "chan",
              C.Variable "inbuf", C.Variable "inbufsize",
              C.Variable "outbuf", C.Variable "outbufsize"],
          C.If (C.Call "err_is_fail" [errvar])
              [C.Ex $ C.Call (destroy_fn_name uparams ifn) [my_bindvar],
               C.Return $
                  C.Call "err_push" [errvar, C.Variable "LIB_ERR_UMP_CHAN_INIT"]]
              [],
          C.SBlank,
  
          C.Ex $ C.Call "ipi_notify_init"
              [C.AddressOf $ my_bindvar `C.DerefField` "ipi_notify",
               C.Variable "rmt_notify_cap", C.Variable "my_notify_cap",
               C.Variable "notify_ep_cap", C.Variable "notify_ep"],
          C.SBlank,
  
          C.Ex $ C.Assignment (common_field "change_waitset") (C.Variable $ change_waitset_fn_name uparams ifn),
          C.Ex $ C.Assignment (common_field "control") (C.Variable $ generic_control_fn_name (ump_drv uparams) ifn),
  
          C.StmtList $ register_recv uparams ifn,
          C.SBlank,
  
          C.Return errvar]
      where
          statevar = C.DerefField my_bindvar "ump_state"
          common_field f = my_bindvar `C.DerefField` "b" `C.FieldOf` f
          common_init = binding_struct_init (ump_drv uparams) ifn
                          (C.DerefField my_bindvar "b")
                          (C.Variable "waitset")
                          (C.Variable $ tx_vtbl_name uparams ifn)
  