Flounder support for tokens in messages, removing dynamic allocation of
authorAdam Turowski <adam.turowski@inf.ethz.ch>
Tue, 26 Jul 2016 09:00:16 +0000 (11:00 +0200)
committerAdam Turowski <adam.turowski@inf.ethz.ch>
Tue, 26 Jul 2016 09:00:16 +0000 (11:00 +0200)
variable arrays, adding maximum size of variable arrays, event channels
for messages, multi-threaded RPC's, new RPC calling convention.

Signed-off-by: Adam Turowski <adam.turowski@inf.ethz.ch>

19 files changed:
errors/errno.fugu
tools/flounder/AHCI.hs
tools/flounder/Backend.lhs
tools/flounder/BackendCommon.hs
tools/flounder/CAbsSyntax.hs
tools/flounder/GCBackend.hs
tools/flounder/GHBackend.hs
tools/flounder/LMP.hs
tools/flounder/Loopback.hs
tools/flounder/Main.lhs
tools/flounder/MsgBuf.hs
tools/flounder/MsgFragments.hs
tools/flounder/Multihop.hs
tools/flounder/Parser.hs
tools/flounder/RPCClient.hs
tools/flounder/Syntax.lhs
tools/flounder/THCBackend.hs
tools/flounder/THCStubsBackend.hs
tools/flounder/UMPCommon.hs

index 320fe97..f731e04 100755 (executable)
@@ -405,6 +405,7 @@ errors libbarrelfish LIB_ERR_ {
 errors flounder FLOUNDER_ERR_ {
     failure INVALID_STATE       "Invalid/corrupt state in binding structure",
     failure TX_BUSY             "Cannot queue message for transmit: queue is full",
+    failure TX_MSG_SIZE         "Trying to send a message which is larger than declared",
     failure RX_EMPTY_MSG        "Incoming message invalid: empty payload",
     failure RX_INVALID_MSGNUM   "Incoming message invalid: unknown message code",
     failure RX_INVALID_LENGTH   "Incoming message has invalid length",
index 68878fb..4edd309 100644 (file)
@@ -330,7 +330,7 @@ rpc_arg rpcargs n = listToMaybe $ filter ((== n) . rpc_arg_var_name . rpc_arg_va
     where rpc_arg_var (RPCArgIn _ v) = v
           rpc_arg_var (RPCArgOut _ v) = v
           rpc_arg_var_name (Name n) = n
-          rpc_arg_var_name (DynamicArray n _) = n
+          rpc_arg_var_name (DynamicArray n _ _) = n
 
 get_meta_arg :: String -> String -> [(String, [(String, MetaArgument)])] -> Maybe MetaArgument
 get_meta_arg nspc n metaargs = (lookup nspc metaargs) >>= (lookup n)
@@ -373,7 +373,7 @@ rpc_dma_args types rpc@(RPC name rpcargs metaargs) =
               meta_arg_dma_size
               ]
           dma_dyn_arg_size = case rpc_arg rpcargs $ rpc_dma_arg_name rpc of
-              Just (RPCArgIn (Builtin UInt8) (DynamicArray _ l)) -> Just $ C.Variable l
+              Just (RPCArgIn (Builtin UInt8) (DynamicArray _ l _)) -> Just $ C.Variable l
               _                                                  -> Nothing
           dma_arg_type_size = case lookup_typeref types $ rpc_arg_type $ fromJust $ rpc_arg rpcargs $ rpc_dma_arg_name rpc of
               TArray (Builtin UInt8) _ length -> Just $ C.NumConstant length
@@ -440,7 +440,7 @@ cc_rx_fn ifn types msg@(RPC name rpcargs metaargs) =
         pr_region_var = C.Variable "completed_st" `C.DerefField` "dma_region"
         output_arg_expr :: Maybe Direction -> MessageArgument -> [C.Expr]
         output_arg_expr _ (Arg (Builtin ErrVal) (Name "status")) = [C.Variable "SYS_ERR_OK"]
-        output_arg_expr (Just RX) (Arg (Builtin UInt8) (DynamicArray _ _)) = [C.Variable dma_data_name, dma_size]
+        output_arg_expr (Just RX) (Arg (Builtin UInt8) (DynamicArray _ _ _)) = [C.Variable dma_data_name, dma_size]
         output_arg_expr _ arg = error ("unrecoginized output argument " ++ (show arg))
 
         dma_args = rpc_dma_args types msg
index 41e3fbc..d14ec0c 100644 (file)
@@ -177,7 +177,7 @@ array, without its associated length bound.
 
 > nameOf :: Variable -> String
 > nameOf (Name s) = s
-> nameOf (DynamicArray s _) = s
+> nameOf (DynamicArray s _ _) = s
 
 
 Conversely, when marshaling or unmarshaling dynamic arrays, we need to
@@ -185,7 +185,7 @@ pass the @length@ parameter.
 
 > listOfArgs :: String -> Variable -> String
 > listOfArgs dereference (Name s) = dereference ++ s
-> listOfArgs dereference (DynamicArray name length) = dereference ++ name ++ ", " ++ length
+> listOfArgs dereference (DynamicArray name length _) = dereference ++ name ++ ", " ++ length
 
 
 > callNameOf :: MessageDef -> String
index b6a37f9..f2e4b47 100644 (file)
@@ -1,4 +1,4 @@
-{- 
+{-
    BackendCommon: Common code used by most backends
 
   Part of Flounder: a message passing IDL for Barrelfish
@@ -48,7 +48,12 @@ intf_frameinfo_type ifn = ifscope ifn "frameinfo"
 -- Variable used to refer to a continuation
 intf_frameinfo_var = "_frameinfo"
 
+-- name of the maximum message size define
+msg_arg_size_name :: String -> String
+msg_arg_size_name ifname = ifscope ifname "_MAX_MESSAGE_SIZE"
 
+arg_size_name :: String -> String -> String -> String
+arg_size_name ifname fname argn= ifscope ifname ("_" ++ fname ++ "_" ++ argn ++ "_MAX_ARGUMENT_SIZE")
 
 -- Name of the bind continuation function type for an interface type
 intf_bind_cont_type :: String -> String
@@ -74,6 +79,9 @@ msg_sig_type ifn m@(RPC _ _ _) _ = idscope ifn (msg_name m) "rpc_method_fn"
 msg_sig_type ifn m TX = idscope ifn (msg_name m) "tx_method_fn"
 msg_sig_type ifn m RX =  idscope ifn (msg_name m) "rx_method_fn"
 
+msg_sig_type_rpc_rx :: String -> MessageDef -> String
+msg_sig_type_rpc_rx ifn m@(RPC _ _ _) = idscope ifn (msg_name m) "rpc_rx_method_fn"
+
 -- Name of a given message definition
 msg_name :: MessageDef -> String
 msg_name (Message _ n _ _) = n
@@ -88,12 +96,14 @@ rpc_call_name n = n ++ "_call"
 rpc_resp_name n = n ++ "_response"
 
 -- Name of the struct holding message args for SAR
-msg_argstruct_name :: String -> String -> String
-msg_argstruct_name ifn n = idscope ifn n "args"
+msg_argstruct_name :: Direction -> String -> String -> String
+msg_argstruct_name TX ifn n = idscope ifn n "tx_args"
+msg_argstruct_name RX ifn n = idscope ifn n "rx_args"
 
 -- Name of the union type holding all the arguments for a message
-binding_arg_union_type :: String -> String
-binding_arg_union_type ifn = ifscope ifn "arg_union"
+binding_arg_union_type :: Direction -> String -> String
+binding_arg_union_type TX ifn = ifscope ifn "tx_arg_union"
+binding_arg_union_type RX ifn = ifscope ifn "rx_arg_union"
 
 -- Name of the C type for a concrete flounder type, struct, or enum
 type_c_struct, type_c_enum :: String -> String -> String
@@ -127,11 +137,14 @@ type_c_type_dir TX ifn tr = case type_c_type ifn tr of
 type_c_type_dir RX ifn tr = type_c_type ifn tr
 
 -- Array types in the msg args struct should only be pointers to the storage
-type_c_type_msgstruct :: String -> [TypeDef] -> TypeRef -> C.TypeSpec
-type_c_type_msgstruct ifn typedefs t
+type_c_type_msgstruct :: Direction -> String -> [TypeDef] -> TypeRef -> C.TypeSpec
+type_c_type_msgstruct TX ifn typedefs t
     = case lookup_typeref typedefs t of
         TArray tr n _ -> C.Ptr $ type_c_type ifn t
         _ -> type_c_type ifn t
+type_c_type_msgstruct RX ifn typedefs t
+    = case lookup_typeref typedefs t of
+        _ -> type_c_type ifn t
 
 -- Name of the struct type for the method vtable
 intf_vtbl_type :: String -> Direction -> String
@@ -152,6 +165,13 @@ register_send_fn_type ifn = ifscope ifn "register_send_fn"
 change_waitset_fn_type ifn = ifscope ifn "change_waitset_fn"
 control_fn_type ifn = ifscope ifn "control_fn"
 error_handler_fn_type ifn = ifscope ifn "error_handler_fn"
+receive_next_fn_type ifn = ifscope ifn "receive_next_fn"
+get_receiving_chanstate_fn_type ifn = ifscope ifn "get_receiving_chanstate_fn"
+
+-- Name of the type of a message handler
+msg_handler_fn_name :: String -> MessageDef -> String
+msg_handler_fn_name ifn m = idscope ifn (msg_name m) "handler_fn"
+
 
 
 ------------------------------------------------------------------------
@@ -206,35 +226,50 @@ partition_rpc_args (first:rest) = case first of
 msg_argdecl :: Direction -> String -> MessageArgument -> [C.Param]
 msg_argdecl dir ifn (Arg tr (Name n)) =
     [ C.Param (type_c_type_dir dir ifn tr) n ]
-msg_argdecl RX ifn (Arg tr (DynamicArray n l)) =
+msg_argdecl dir ifn (Arg tr (StringArray n l)) =
+    [ C.Param (type_c_type_dir dir ifn tr) n ]
+msg_argdecl RX ifn (Arg tr (DynamicArray n l _)) =
     [ C.Param (C.Ptr $ type_c_type_dir RX ifn tr) n,
       C.Param (type_c_type_dir RX ifn size) l ]
-msg_argdecl TX ifn (Arg tr (DynamicArray n l)) =
+msg_argdecl TX ifn (Arg tr (DynamicArray n l _)) =
     [ C.Param (C.Ptr $ C.ConstT $ type_c_type_dir TX ifn tr) n,
       C.Param (type_c_type_dir TX ifn size) l ]
 
-msg_argstructdecl :: String -> [TypeDef] -> MessageArgument -> [C.Param]
-msg_argstructdecl ifn typedefs (Arg tr (Name n)) =
-    [ C.Param (type_c_type_msgstruct ifn typedefs tr) n ]
-msg_argstructdecl ifn typedefs a = msg_argdecl RX ifn a
 
-rpc_argdecl :: String -> RPCArgument -> [C.Param]
-rpc_argdecl ifn (RPCArgIn tr v) = msg_argdecl TX ifn (Arg tr v)
-rpc_argdecl ifn (RPCArgOut tr (Name n)) = [ C.Param (C.Ptr $ type_c_type ifn tr) n ]
-rpc_argdecl ifn (RPCArgOut tr (DynamicArray n l)) =
-    [ C.Param (C.Ptr $ C.Ptr $ type_c_type ifn tr) n,
+msg_argstructdecl :: Direction -> String -> [TypeDef] -> MessageArgument -> [C.Param]
+msg_argstructdecl dir ifn typedefs (Arg tr (Name n)) =
+    [ C.Param (type_c_type_msgstruct dir ifn typedefs tr) n ]
+msg_argstructdecl RX ifn typedefs (Arg tr (StringArray n maxlen)) =
+    [ C.Param (C.Array maxlen $ C.TypeName "char") (n)]
+msg_argstructdecl TX ifn typedefs (Arg tr (StringArray n maxlen)) =
+    [ C.Param (type_c_type_dir TX ifn tr) n ]
+msg_argstructdecl RX ifn typedefs (Arg tr (DynamicArray n l maxlen)) =
+    [ C.Param (C.Array maxlen $ type_c_type ifn tr) (n),
+      C.Param (type_c_type ifn size) l ]
+msg_argstructdecl TX ifn typedefs (Arg tr (DynamicArray n l maxlen)) =
+    [ C.Param (C.Ptr $ C.ConstT $ type_c_type_dir TX ifn tr) n,
+      C.Param (type_c_type ifn size) l ]
+
+
+rpc_argdecl :: Direction -> String -> RPCArgument -> [C.Param]
+rpc_argdecl dir ifn (RPCArgIn tr v) = msg_argdecl dir ifn (Arg tr v)
+rpc_argdecl dir ifn (RPCArgOut tr (Name n)) = [ C.Param (C.Ptr $ type_c_type ifn tr) n ]
+rpc_argdecl dir ifn (RPCArgOut tr (StringArray n _)) = [ C.Param (type_c_type ifn tr) n ]
+rpc_argdecl dir ifn (RPCArgOut tr (DynamicArray n l _)) =
+    [ C.Param (C.Ptr $ type_c_type ifn tr) n,
       C.Param (C.Ptr $ type_c_type ifn size) l ]
 
 -- XXX: kludge wrapper to pass array types by reference in RPC
-rpc_argdecl2 :: String -> [TypeDef] -> RPCArgument -> [C.Param]
-rpc_argdecl2 ifn typedefs arg@(RPCArgOut tr (Name n))
+rpc_argdecl2 :: Direction -> String -> [TypeDef] -> RPCArgument -> [C.Param]
+rpc_argdecl2 dir ifn typedefs arg@(RPCArgOut tr (Name n))
     = case lookup_typeref typedefs tr of
-      TArray _ _ _ -> [ C.Param (C.Ptr $ C.Ptr $ type_c_type ifn tr) n ]
-      _ -> rpc_argdecl ifn arg
-rpc_argdecl2 ifn _ arg = rpc_argdecl ifn arg
+      TArray _ _ _ -> [ C.Param (type_c_type ifn tr) n ]
+      _ -> rpc_argdecl dir ifn arg
+rpc_argdecl2 dir ifn _ arg = rpc_argdecl dir ifn arg
 
 -- binding parameter for a function
 binding_param ifname = C.Param (C.Ptr $ C.Struct $ intf_bind_type ifname) intf_bind_var
+binding_param2 ifname = C.Param (C.Ptr $ C.Struct $ intf_bind_type ifname) (intf_bind_var ++ "_")
 
 
 --
@@ -244,7 +279,10 @@ binding_struct_init :: String -> String -> C.Expr -> C.Expr ->  C.Expr -> [C.Stm
 binding_struct_init drv ifn binding_var waitset_ex tx_vtbl_ex = [
     C.Ex $ C.Assignment (C.FieldOf binding_var "st") (C.Variable "NULL"),
     C.Ex $ C.Assignment (C.FieldOf binding_var "waitset") waitset_ex,
+    C.Ex $ C.Assignment (C.FieldOf binding_var "send_waitset") (C.Variable "NULL"),
     C.Ex $ C.Call "event_mutex_init" [C.AddressOf $ C.FieldOf binding_var "mutex", waitset_ex],
+    C.Ex $ C.Call "thread_mutex_init" [C.AddressOf $ C.FieldOf binding_var "rxtx_mutex"],
+    C.Ex $ C.Call "thread_mutex_init" [C.AddressOf $ C.FieldOf binding_var "send_mutex"],
     C.Ex $ C.Assignment (C.FieldOf binding_var "can_send")
                                 (C.Variable $ can_send_fn_name drv ifn),
     C.Ex $ C.Assignment (C.FieldOf binding_var "register_send")
@@ -255,6 +293,12 @@ binding_struct_init drv ifn binding_var waitset_ex tx_vtbl_ex = [
     C.Ex $ C.Call "memset" [C.AddressOf $ C.FieldOf binding_var "rx_vtbl",
                             C.NumConstant 0,
                             C.Call "sizeof" [C.FieldOf binding_var "rx_vtbl"]],
+    C.Ex $ C.Call "memset" [C.AddressOf $ C.FieldOf binding_var "message_rx_vtbl",
+                            C.NumConstant 0,
+                            C.Call "sizeof" [C.FieldOf binding_var "message_rx_vtbl"]],
+    C.Ex $ C.Call "memset" [C.AddressOf $ C.FieldOf binding_var "rpc_rx_vtbl",
+                            C.NumConstant 0,
+                            C.Call "sizeof" [C.FieldOf binding_var "rpc_rx_vtbl"]],
     C.Ex $ C.Call "flounder_support_waitset_chanstate_init"
             [C.AddressOf $ C.FieldOf binding_var "register_chanstate"],
     C.Ex $ C.Call "flounder_support_waitset_chanstate_init"
@@ -263,7 +307,8 @@ binding_struct_init drv ifn binding_var waitset_ex tx_vtbl_ex = [
         [C.Ex $ C.Assignment (C.FieldOf binding_var f) (C.NumConstant 0)
          | f <- ["tx_msgnum", "rx_msgnum", "tx_msg_fragment", "rx_msg_fragment",
                  "tx_str_pos", "rx_str_pos", "tx_str_len", "rx_str_len"]],
-    C.Ex $ C.Assignment (C.FieldOf binding_var "bind_cont") (C.Variable "NULL")]
+    C.Ex $ C.Assignment (C.FieldOf binding_var "incoming_token") (C.NumConstant 0),
+    C.Ex $ C.Assignment (C.FieldOf binding_var "outgoing_token") (C.NumConstant 0)]
 
 binding_struct_destroy :: String -> C.Expr -> [C.Stmt]
 binding_struct_destroy ifn binding_var
@@ -337,7 +382,7 @@ register_txcont cont_ex = [
     C.If (C.Binary C.NotEquals (cont_ex `C.FieldOf` "handler") (C.Variable "NULL"))
         [localvar (C.TypeName "errval_t") "_err" Nothing,
          C.Ex $ C.Assignment errvar $ C.Call "flounder_support_register"
-            [bindvar `C.DerefField` "waitset",
+            [C.Variable "send_waitset",
              C.AddressOf $ bindvar `C.DerefField` "tx_cont_chanstate",
              cont_ex,
              C.Variable "false"],
@@ -345,13 +390,31 @@ register_txcont cont_ex = [
          C.If (C.Call "err_is_fail" [errvar])
             [C.If (C.Binary C.Equals (C.Call "err_no" [errvar])
                                      (C.Variable "LIB_ERR_CHAN_ALREADY_REGISTERED"))
-                [C.Return $ C.Variable "FLOUNDER_ERR_TX_BUSY"]
-                [C.Ex $ C.Call "assert" [C.Unary C.Not $ C.StringConstant "shouldn't happen"],
+                [C.Ex $ C.Call "thread_mutex_unlock" [C.AddressOf $ C.DerefField bindvar "send_mutex"],
+                 C.Ex $ C.Call "assert" [C.Binary C.NotEquals (cont_ex `C.FieldOf` "handler") (C.Variable "blocking_cont")],
+                 C.Return $ C.Variable "FLOUNDER_ERR_TX_BUSY"]
+                [C.Ex $ C.Call "thread_mutex_unlock" [C.AddressOf $ C.DerefField bindvar "send_mutex"],
+                 C.Ex $ C.Call "assert" [C.Unary C.Not $ C.StringConstant "shouldn't happen"],
                  C.Return $ errvar] ] []
          ] []
     ] where
         errvar = C.Variable "_err"
 
+block_sending :: C.Expr -> [C.Stmt]
+block_sending cont_ex = [
+    C.If (C.Binary C.Equals (cont_ex `C.FieldOf` "handler") (C.Variable "blocking_cont"))
+        [C.If (C.Binary C.Equals binding_error (C.Variable "SYS_ERR_OK")) [
+            C.Ex $ C.Assignment binding_error $ C.Call "wait_for_channel"
+                [C.Variable "send_waitset", tx_cont_chanstate, C.AddressOf binding_error]
+            ] [
+            C.Ex $ C.Call "flounder_support_deregister_chan" [tx_cont_chanstate]
+            ]
+        ] []
+    ] where
+        errvar = C.Variable "_err"
+        mask = C.CallInd (C.DerefField bindvar "get_receiving_chanstate") [bindvar]
+        tx_cont_chanstate = C.AddressOf $ bindvar `C.DerefField` "tx_cont_chanstate"
+
 -- starting a send: just a debug hook
 start_send :: String -> String -> String -> [MessageArgument] -> [C.Stmt]
 start_send drvn ifn mn msgargs
@@ -384,13 +447,17 @@ start_recv drvn ifn typedefs mn msgargs
         _ -> False
 
 -- finished recv: debug, run handler and clean up
-finished_recv :: String -> String -> [TypeDef] -> String -> [MessageArgument] -> [C.Stmt]
-finished_recv drvn ifn typedefs mn msgargs
-    = [C.Ex $ C.Call "FL_DEBUG" [C.StringConstant $
+finished_recv :: String -> String -> [TypeDef] ->  MessageType -> String -> [MessageArgument] -> [C.Stmt]
+finished_recv drvn ifn typedefs mtype mn msgargs
+    = [ C.Ex $ C.Call "FL_DEBUG" [C.StringConstant $
                                  drvn ++ " RX " ++ ifn ++ "." ++ mn ++ "\n"],
-       C.Ex $ C.Call "assert" [C.Binary C.NotEquals handler (C.Variable "NULL")],
-       C.Ex $ C.CallInd handler (bindvar:args),
-       C.Ex $ C.Assignment rx_msgnum_field (C.NumConstant 0)]
+        C.If (C.Binary C.NotEquals handler (C.Variable "NULL"))
+            [C.Ex $ C.Assignment (C.FieldOf message_chanstate "token") binding_incoming_token,
+             C.Ex $ C.CallInd handler (bindvar:args)]
+            [C.Ex $ C.Assignment (C.FieldOf message_chanstate "token") binding_incoming_token,
+             C.Ex $ C.Call "flounder_support_trigger_chan" [C.AddressOf message_chanstate],
+             C.Ex $ C.Assignment (C.Variable "no_register") (C.NumConstant 1)],
+        C.Ex $ C.Assignment rx_msgnum_field (C.NumConstant 0)]
     where
         rx_msgnum_field = C.DerefField bindvar "rx_msgnum"
         handler = C.DerefField bindvar "rx_vtbl" `C.FieldOf` mn
@@ -398,12 +465,100 @@ finished_recv drvn ifn typedefs mn msgargs
         mkargs tr (Name n) = case lookup_typeref typedefs tr of
           TArray _ _ _ -> [C.DerefPtr $ rx_union_elem mn n]
           _ -> [rx_union_elem mn n]
-        mkargs _ (DynamicArray n l) = [rx_union_elem mn n, rx_union_elem mn l]
+        mkargs _ (StringArray n l) = [rx_union_elem mn n]
+        mkargs _ (DynamicArray n l _) = [rx_union_elem mn n, rx_union_elem mn l]
+        binding_incoming_token = C.DerefField bindvar "incoming_token"
+        message_chanstate = C.SubscriptOf (C.DerefField bindvar "message_chanstate") (C.Variable $ msg_enum_elem_name ifn mn)
+
+finished_recv_nocall :: String -> String -> [TypeDef] ->  MessageType -> String -> [MessageArgument] -> [C.Stmt]
+finished_recv_nocall drvn ifn typedefs mtype mn msgargs
+    = [ C.Ex $ C.Call "FL_DEBUG" [C.StringConstant $
+                                 drvn ++ " RX " ++ ifn ++ "." ++ mn ++ "\n"],
+        C.If (C.Binary C.NotEquals handler (C.Variable "NULL"))
+            [C.Ex $ C.Assignment (C.Variable "call_msgnum") (C.Variable $ msg_enum_elem_name ifn mn)]
+            [C.Ex $ C.Assignment (C.FieldOf message_chanstate "token") binding_incoming_token,
+             C.Ex $ C.Call "flounder_support_trigger_chan" [C.AddressOf message_chanstate],
+             C.Ex $ C.Assignment (C.Variable "no_register") (C.NumConstant 1)],
+        C.Ex $ C.Assignment rx_msgnum_field (C.NumConstant 0)]
+    where
+        rx_msgnum_field = C.DerefField bindvar "rx_msgnum"
+        handler = C.DerefField bindvar "rx_vtbl" `C.FieldOf` mn
+        binding_incoming_token = C.DerefField bindvar "incoming_token"
+        message_chanstate = C.SubscriptOf (C.DerefField bindvar "message_chanstate") (C.Variable $ msg_enum_elem_name ifn mn)
+
+-- call callback, directly from a receiving handler
+call_handler :: String -> String -> [TypeDef] ->  MessageType -> String -> [MessageArgument] -> [C.Stmt]
+call_handler drvn ifn typedefs mtype mn msgargs
+    =   [C.Ex $ C.CallInd handler (bindvar:args)]
+    where
+        handler = C.DerefField bindvar "rx_vtbl" `C.FieldOf` mn
+        args = concat [mkargs tr a | Arg tr a <- msgargs]
+        mkargs tr (Name n) = case lookup_typeref typedefs tr of
+          TArray _ _ _ -> [C.DerefPtr $ rx_union_elem mn n]
+          _ -> [rx_union_elem mn n]
+        mkargs _ (StringArray n l) = [rx_union_elem mn n]
+        mkargs _ (DynamicArray n l _) = [rx_union_elem mn n, rx_union_elem mn l]
+
+-- call callback, from a message handler
+call_message_handler_msgargs :: String -> String -> [TypeDef] -> [MessageArgument] -> [C.Stmt]
+call_message_handler_msgargs ifn mn typedefs msgargs
+        = [C.Ex $ C.CallInd handler (bindvar:args)]
+    where
+        handler = C.DerefField bindvar "message_rx_vtbl" `C.FieldOf` mn
+        args = concat [mkargs a | Arg tr a <- msgargs]
+        mkargs (Name n) = [local_rx_union_elem mn n]
+        mkargs (StringArray n l) = [local_rx_union_elem mn n]
+        mkargs (DynamicArray n l _) = [local_rx_union_elem mn n, local_rx_union_elem mn l]
+
+-- call callback, from a rpc handler
+call_message_handler_rpcargs :: String -> String -> [TypeDef] -> [RPCArgument] -> [C.Stmt]
+call_message_handler_rpcargs ifn mn typedefs msgargs
+        = [C.Ex $ C.Call "assert" [handler],
+        C.Ex $ C.CallInd handler (bindvar:args)]
+    where
+        handler = C.DerefField bindvar "message_rx_vtbl" `C.FieldOf` (rpc_call_name mn)
+        args = concat [mkargs a | RPCArgIn tr a <- msgargs]
+        mkargs (Name n) = [local_rx_union_elem mn n]
+        mkargs (StringArray n l) = [local_rx_union_elem mn n]
+        mkargs (DynamicArray n l _) = [local_rx_union_elem mn n, local_rx_union_elem mn l]
+
+-- call rpc callback
+call_rpc_handler :: String -> String -> [TypeDef] -> [RPCArgument] -> [C.Stmt]
+call_rpc_handler ifn mn typedefs msgargs
+        = [C.Ex $ C.CallInd handler (bindvar:args)]
+    where
+        handler = C.DerefField bindvar "rpc_rx_vtbl" `C.FieldOf` (rpc_call_name mn)
+        args = concat [mkargs a | a <- msgargs]
+        mkargs (RPCArgIn _ (Name n)) = [local_rx_union_elem mn n]
+        mkargs (RPCArgIn _ (StringArray n l)) = [local_rx_union_elem mn n]
+        mkargs (RPCArgIn _ (DynamicArray n l _)) = [local_rx_union_elem mn n, local_rx_union_elem mn l]
+        mkargs (RPCArgOut tr (Name n)) = case lookup_typeref typedefs tr of
+          TArray _ _ _ -> [C.DerefPtr $ local_tx_union_elem mn n]
+          _ -> [C.AddressOf $ local_tx_union_elem mn n]
+        mkargs (RPCArgOut _ (StringArray n l)) = [local_tx_union_elem mn n]
+        mkargs (RPCArgOut _ (DynamicArray n l _)) = [local_tx_union_elem mn n, C.AddressOf $ local_tx_union_elem mn l]
+
+-- send response
+send_response :: String -> String -> [TypeDef] -> [RPCArgument] -> [C.Stmt]
+send_response ifn mn typedefs msgargs
+        = [C.Ex $ C.Call "assert" [handler],
+        C.Ex $ C.Assignment errvar $ C.CallInd handler (bindvar:cont:args),
+        C.Ex $ C.Call "assert" [C.Call "err_is_ok" [errvar]]]
+    where
+        handler = C.DerefField bindvar "tx_vtbl" `C.FieldOf` (rpc_resp_name mn)
+        args = concat [mkargs tr a | RPCArgOut tr a <- msgargs]
+        mkargs tr (Name n) = case lookup_typeref typedefs tr of
+          TArray _ _ _ -> [C.DerefPtr $ local_tx_union_elem mn n]
+          _ -> [local_tx_union_elem mn n]
+        mkargs _ (StringArray n l) = [local_tx_union_elem mn n]
+        mkargs _ (DynamicArray n l _) = [local_tx_union_elem mn n, local_tx_union_elem mn l]
+        cont = C.Variable "BLOCKING_CONT"
 
 tx_arg_assignment :: String -> [TypeDef] -> String -> MessageArgument -> C.Stmt
 tx_arg_assignment ifn typedefs mn (Arg tr v) = case v of
     Name an -> C.Ex $ C.Assignment (tx_union_elem mn an) (srcarg an)
-    DynamicArray an len -> C.StmtList [
+    StringArray an _ -> C.Ex $ C.Assignment (tx_union_elem mn an) ((C.Variable an))
+    DynamicArray an len _ -> C.StmtList [
         C.Ex $ C.Assignment (tx_union_elem mn an) (C.Cast (C.Ptr typespec) (C.Variable an)),
         C.Ex $ C.Assignment (tx_union_elem mn len) (C.Variable len)]
     where
@@ -418,6 +573,70 @@ tx_arg_assignment ifn typedefs mn (Arg tr v) = case v of
               _ -> C.Variable an
 
 
+-- extracts the size of the arguemnts of a message
+extract_msg_size :: MessageArgument -> Integer
+extract_msg_size (Arg tr (Name an)) = 0
+extract_msg_size (Arg tr (StringArray an maxlen)) = maxlen
+extract_msg_size (Arg tr (DynamicArray an len maxlen)) = maxlen
+
+-- extracts the size of the arguemnts of an RPC (in)
+extract_rpc_size_in :: RPCArgument -> Integer
+extract_rpc_size_in (RPCArgIn tr (Name an)) = 0
+extract_rpc_size_in (RPCArgIn tr (StringArray an maxlen)) = maxlen
+extract_rpc_size_in (RPCArgIn tr (DynamicArray an len maxlen)) = maxlen
+
+-- extracts the size of the arguemnts of an RPC (out)
+extract_rpc_size_out :: RPCArgument -> Integer
+extract_rpc_size_out (RPCArgOut tr (Name an)) = 0
+extract_rpc_size_out (RPCArgOut tr (StringArray an maxlen)) = maxlen
+extract_rpc_size_out (RPCArgOut tr (DynamicArray an len maxlen)) = maxlen
+
+-- extract the size of arguemnts
+msg_arg_extract_length :: MessageDef -> Integer
+msg_arg_extract_length (RPC n [] _) = 0
+msg_arg_extract_length (RPC n args _) = maximum [ sum $ [ extract_rpc_size_in arg | arg <- args], sum $ [ extract_rpc_size_out arg | arg <- args]]
+msg_arg_extract_length (Message mtype n [] _) = 0
+msg_arg_extract_length (Message mtype n args _) = sum $ [ extract_msg_size arg | arg <- args]
+
+
+
+-- checks the size of the MSG arguments
+tx_fn_arg_check_size :: String -> [TypeDef] -> String -> MessageArgument -> C.Stmt
+tx_fn_arg_check_size ifn typedefs mn (Arg tr v) = case v of
+    Name an -> C.SComment (an ++ " has a base type. no length check")
+    StringArray an maxlen -> C.StmtList [
+        C.SComment ("checking datalength of " ++ an),
+        C.If (C.Binary C.And (C.Variable an)
+              (C.Binary C.GreaterThanEq (C.Call "strlen" [C.Variable an]) (C.Binary C.Minus (C.NumConstant maxlen) (C.NumConstant 1)))) [
+            C.Return (C.Variable "FLOUNDER_ERR_TX_MSG_SIZE")
+        ] []
+        ]
+    DynamicArray an len maxlen -> C.StmtList [
+        C.SComment ("checking datalength of " ++ an),
+        C.If (C.Binary C.GreaterThanEq (C.Variable len) (C.NumConstant maxlen)) [
+            C.Return (C.Variable "FLOUNDER_ERR_TX_MSG_SIZE")
+        ] []
+        ]
+
+-- checks the size of the RPC arguments
+tx_fn_arg_check_size_rpc :: String -> [TypeDef] -> String -> RPCArgument -> C.Stmt
+tx_fn_arg_check_size_rpc ifn typedefs mn (RPCArgIn tr v) = case v of
+    Name an -> C.SComment (an ++ " has a base type. no length check")
+    StringArray an maxlen -> C.StmtList [
+        C.SComment ("checking datalength of " ++ an),
+        C.If (C.Binary C.GreaterThanEq (C.Call "strlen" [C.Variable an]) (C.Binary C.Minus (C.NumConstant maxlen) (C.NumConstant 1))) [
+            C.Return (C.Variable "FLOUNDER_ERR_TX_MSG_SIZE")
+        ] []
+        ]
+    DynamicArray an len maxlen -> C.StmtList [
+        C.SComment ("checking datalength of " ++ an),
+        C.If (C.Binary C.GreaterThanEq (C.Variable len) (C.NumConstant maxlen)) [
+            C.Return (C.Variable "FLOUNDER_ERR_TX_MSG_SIZE")
+        ] []
+        ]
+tx_fn_arg_check_size_rpc ifn typedefs mn (RPCArgOut tr v) = C.SComment (" Is out arg")
+
+
 tx_union_elem :: String -> String -> C.Expr
 tx_union_elem mn fn
    = bindvar `C.DerefField` "tx_union" `C.FieldOf` mn `C.FieldOf` fn
@@ -426,11 +645,26 @@ rx_union_elem :: String -> String -> C.Expr
 rx_union_elem mn fn
    = bindvar `C.DerefField` "rx_union" `C.FieldOf` mn `C.FieldOf` fn
 
+local_rx_union_elem :: String -> String -> C.Expr
+local_rx_union_elem mn fn
+   = (C.Variable "arguments") `C.FieldOf` fn
+
+local_tx_union_elem :: String -> String -> C.Expr
+local_tx_union_elem mn fn
+   = (C.Variable "result") `C.FieldOf` fn
+
 -- misc common bits of C
 localvar = C.VarDecl C.NoScope C.NonConst
 errvar = C.Variable "err"
 bindvar = C.Variable intf_bind_var
-report_user_err ex = C.Ex $ C.CallInd (C.DerefField bindvar "error_handler") [bindvar, ex]
+binding_error = C.DerefField bindvar "error"
+clear_error = C.Ex $ C.Assignment binding_error (C.Variable "SYS_ERR_OK")
+report_user_err ex = C.StmtList [
+    C.Ex $ C.Assignment (C.DerefField bindvar "error") ex,
+    C.If (C.DerefField bindvar "error_handler") [
+        C.Ex $ C.CallInd (C.DerefField bindvar "error_handler") [bindvar, ex]
+    ] []]
+
 report_user_tx_err ex = C.StmtList [
     report_user_err ex,
     C.Ex $ C.Assignment tx_msgnum_field (C.NumConstant 0),
index e9f4809..5e28366 100644 (file)
@@ -72,7 +72,7 @@ pp_expr (DerefField e s) = (pp_par_expr e) ++ "->" ++ s
 pp_expr (Assignment e1 e2) = (pp_expr e1) ++ " = " ++ (pp_par_expr e2)
 pp_expr (Unary o e) = (pp_unop o) ++ (pp_par_expr e)
 pp_expr (Binary o e1 e2)
-    = (pp_par_expr e1) ++" " ++ (pp_binop o) ++ " "++(pp_par_expr e2)
+    = "(" ++ (pp_par_expr e1) ++" " ++ (pp_binop o) ++ " "++(pp_par_expr e2) ++ ")"
 pp_expr (Ternary e1 e2 e3)
     = (pp_par_expr e1) ++ " ? " ++ (pp_par_expr e2) ++ " : " ++ (pp_par_expr e3)
 pp_expr (FieldOf e s) = (pp_par_expr e) ++ "." ++ s
index 675cda4..47bf7b7 100644 (file)
@@ -1,4 +1,4 @@
-{- 
+{-
    GCBackend: Flounder stub generator for generic code
 
   Part of Flounder: a message passing IDL for Barrelfish
@@ -16,8 +16,9 @@ module GCBackend where
 import Data.Char
 
 import qualified CAbsSyntax as C
-import Syntax (Interface (Interface))
-import GHBackend (flounder_backends, export_fn_name, bind_fn_name, accept_fn_name, connect_fn_name)
+import Syntax (Interface (Interface), MessageDef(Message, RPC), TypeDef, MessageType(MMessage, MCall, MResponse), RPCArgument(RPCArgIn, RPCArgOut))
+import GHBackend (flounder_backends, export_fn_name, bind_fn_name, accept_fn_name, connect_fn_name, connect_handlers_fn_name, disconnect_handlers_fn_name)
+import qualified Backend
 import BackendCommon
 import LMP (lmp_bind_type, lmp_bind_fn_name)
 import qualified UMP (bind_type, bind_fn_name)
@@ -37,7 +38,7 @@ compile infile outfile interface =
     unlines $ C.pp_unit $ stub_body infile interface
 
 stub_body :: String -> Interface -> C.Unit
-stub_body infile (Interface ifn descr _) = C.UnitList [
+stub_body infile (Interface ifn descr decls) = C.UnitList [
     intf_preamble infile ifn descr,
     C.Blank,
 
@@ -62,6 +63,122 @@ stub_body infile (Interface ifn descr _) = C.UnitList [
     connect_fn_def ifn]
 
 
+compile_message_handlers :: String -> String -> Interface -> String
+compile_message_handlers infile outfile interface =
+    unlines $ C.pp_unit $ stub_body_message_handlers infile interface
+
+stub_body_message_handlers :: String -> Interface -> C.Unit
+stub_body_message_handlers infile (Interface ifn descr decls) = C.UnitList [
+    intf_preamble infile ifn descr,
+    C.Blank,
+
+    C.Include C.Standard "barrelfish/barrelfish.h",
+    C.Include C.Standard "flounder/flounder_support.h",
+    C.Include C.Standard ("if/" ++ ifn ++ "_defs.h"),
+    C.Blank,
+
+    C.MultiComment [ "Message handlers" ],
+    C.UnitList [ msg_handler ifn m types | m@(Message MMessage _ _ _) <- messages ],
+    C.UnitList [ msg_handler ifn m types | m@(Message MResponse _ _ _) <- messages ],
+    C.UnitList [ msg_handler ifn m types | m <- rpcs ],
+    C.Blank,
+
+    C.MultiComment [ "Connect handlers function" ],
+    connect_handlers_fn_def ifn messages,
+    C.Blank,
+
+    C.MultiComment [ "Disconnect handlers function" ],
+    disconnect_handlers_fn_def ifn messages,
+    C.Blank]
+
+    where
+        (types, messagedecls) = Backend.partitionTypesMessages decls
+        messages = rpcs_to_msgs messagedecls
+        rpcs = [m | m@(RPC _ _ _) <- messagedecls]
+
+
+msg_handler :: String -> MessageDef -> [TypeDef] -> C.Unit
+msg_handler ifname msg@(Message _ mn args _) types = C.FunctionDef C.Static (C.TypeName "void") name [C.Param (C.Ptr C.Void) "arg"] [
+    localvar (C.Ptr $ C.Struct $ intf_bind_type ifname)
+        intf_bind_var (Just $ C.Variable "arg"),
+    localvar (C.TypeName "errval_t") "err" Nothing,
+    if null args then C.SBlank else localvar (C.Struct $ msg_argstruct_name RX ifname mn) "arguments" (Just (bindvar `C.DerefField` "rx_union" `C.FieldOf` mn)),
+    C.SBlank,
+
+    C.Ex $ C.Assignment errvar $ C.CallInd receive_next [bindvar],
+    C.Ex $ C.Call "assert" [C.Call "err_is_ok" [errvar]],
+    C.StmtList $ call_message_handler_msgargs ifname mn types args
+    ]
+    where
+        name = msg_handler_fn_name ifname msg
+        receive_next = C.DerefField bindvar "receive_next"
+
+msg_handler ifname msg@(RPC mn args a) types = C.FunctionDef C.Static (C.TypeName "void") name [C.Param (C.Ptr C.Void) "arg"] [
+    localvar (C.Ptr $ C.Struct $ intf_bind_type ifname)
+        intf_bind_var (Just $ C.Variable "arg"),
+    localvar (C.TypeName "errval_t") "err" Nothing,
+    if null in_args then C.SBlank else localvar (C.Struct $ msg_argstruct_name RX ifname (rpc_call_name mn)) "arguments" (Just (bindvar `C.DerefField` "rx_union" `C.FieldOf` (rpc_call_name mn))),
+    localvar (C.TypeName "uint32_t") "token" (Just $ binding_incoming_token),
+    C.SBlank,
+
+    C.Ex $ C.Assignment errvar $ C.CallInd receive_next [bindvar],
+    C.Ex $ C.Call "assert" [C.Call "err_is_ok" [errvar]],
+    C.If (rpc_rx_handler) [
+        if null out_args then C.SBlank else localvar (C.Struct $ msg_argstruct_name RX ifname (rpc_resp_name mn)) "result" Nothing,
+        C.StmtList $ call_rpc_handler ifname mn types args,
+        C.Ex $ C.Call "thread_set_outgoing_token" [C.Binary C.BitwiseAnd (C.Variable "token") (C.Variable "~1" )],
+        C.StmtList $ send_response ifname mn types args
+        ] [
+        C.StmtList $ call_message_handler_rpcargs ifname mn types args
+        ]
+    ]
+    where
+        name = msg_handler_fn_name ifname (RPC (rpc_call_name mn) args a)
+        receive_next = C.DerefField bindvar "receive_next"
+        rpc_rx_handler = C.DerefField bindvar "rpc_rx_vtbl" `C.FieldOf` (rpc_call_name mn)
+        in_args = [a | RPCArgIn tr a <- args]
+        out_args = [a | RPCArgOut tr a <- args]
+        tx_handler = C.DerefField bindvar "tx_vtbl" `C.FieldOf` (rpc_resp_name mn)
+        binding_outgoing_token = C.DerefField bindvar "outgoing_token"
+        binding_incoming_token = C.DerefField bindvar "incoming_token"
+
+connect_handlers_fn_def :: String -> [MessageDef] -> C.Unit
+connect_handlers_fn_def n messages =
+    C.FunctionDef C.Static (C.TypeName "errval_t") (connect_handlers_fn_name n)
+        [C.Param (C.Ptr $ C.Struct $ intf_bind_type n) intf_bind_var] [
+        localvar (C.TypeName "errval_t") "err" Nothing,
+
+        C.StmtList [connect_handler n m | m <- messages],
+        C.Return $ C.Variable "SYS_ERR_OK"
+    ]
+
+connect_handler :: String -> MessageDef -> C.Stmt
+connect_handler n msg@(Message _ mn _ _) = C.StmtList [
+    C.Ex $ C.Call "flounder_support_waitset_chanstate_init_persistent" [message_chanstate],
+    C.Ex $ C.Assignment errvar $ C.Call "flounder_support_register" [waitset, message_chanstate, closure, C.Variable "false"],
+    C.Ex $ C.Call "assert" [C.Call "err_is_ok" [errvar]]
+    ]
+    where
+        waitset = bindvar `C.DerefField` "waitset"
+        message_chanstate = C.Binary C.Plus (C.DerefField bindvar "message_chanstate") (C.Variable $ msg_enum_elem_name n mn)
+        closure = C.StructConstant "event_closure"
+           [("handler", C.Variable $ msg_handler_fn_name n msg), ("arg", bindvar)]
+
+disconnect_handlers_fn_def :: String -> [MessageDef] -> C.Unit
+disconnect_handlers_fn_def n messages =
+    C.FunctionDef C.Static (C.TypeName "errval_t") (disconnect_handlers_fn_name n)
+        [C.Param (C.Ptr $ C.Struct $ intf_bind_type n) intf_bind_var] [
+        C.StmtList [disconnect_handler n m | m <- messages],
+        C.Return $ C.Variable "SYS_ERR_OK"
+    ]
+
+disconnect_handler :: String -> MessageDef -> C.Stmt
+disconnect_handler n msg@(Message _ mn _ _) = C.StmtList [
+    C.Ex $ C.Call "flounder_support_deregister_chan" [message_chanstate]
+    ]
+    where
+        message_chanstate = C.Binary C.Plus (C.DerefField bindvar "message_chanstate") (C.Variable $ msg_enum_elem_name n mn)
+
 export_fn_def :: String -> C.Unit
 export_fn_def n =
     C.FunctionDef C.NoScope (C.TypeName "errval_t") (export_fn_name n) params [
@@ -180,6 +297,7 @@ bind_cont_def ifn fn_name backends =
             [C.Ex $ C.Call "assert" [C.Unary C.Not $ C.StringConstant "invalid state"]],
         C.SBlank,
         C.Label "out",
+        C.Ex $ C.Call (connect_handlers_fn_name ifn) [C.Variable intf_bind_var],
         C.Ex $ C.CallInd (C.Cast (C.Ptr $ C.TypeName $ intf_bind_cont_type ifn)
                                 (bindst `C.DerefField` "callback"))
                         [bindst `C.DerefField` "st", errvar, C.Variable intf_bind_var],
index 807b546..d6bfa68 100644 (file)
@@ -1,4 +1,4 @@
-{- 
+{-
    GHBackend: Flounder stub generator for generic header files
 
   Part of Flounder: a message passing IDL for Barrelfish
@@ -27,6 +27,11 @@ connect_fn_name n = ifscope n "connect"
 export_fn_name n = ifscope n "export"
 bind_fn_name n = ifscope n "bind"
 
+connect_handlers_fn_name n = ifscope n "connect_handlers"
+disconnect_handlers_fn_name n = ifscope n "disconnect_handlers"
+
+rpc_rx_vtbl_type ifn = ifscope ifn "rpc_rx_vtbl"
+
 ------------------------------------------------------------------------
 -- Language mapping: Create the generic header file for the interface
 ------------------------------------------------------------------------
@@ -50,11 +55,13 @@ intf_header_body infile interface@(Interface name descr decls) =
     let
         (types, messagedecls) = Backend.partitionTypesMessages decls
         messages = rpcs_to_msgs messagedecls
+        rpcs = [m | m@(RPC _ _ _) <- messagedecls]
     in
       [ intf_preamble infile name descr,
         C.Blank,
 
         C.Include C.Standard "flounder/flounder.h",
+        C.Include C.Standard "flounder/flounder_support.h",
         C.Blank,
 
         C.MultiComment [ "Concrete type definitions" ],
@@ -72,6 +79,8 @@ intf_header_body infile interface@(Interface name descr decls) =
         change_waitset_fn_typedef name,
         control_fn_typedef name,
         error_handler_fn_typedef name,
+        receive_next_fn_typedef name,
+        get_receiving_chanstate_fn_typedef name,
         C.Blank,
 
         C.MultiComment [ "Enumeration for message numbers" ],
@@ -86,12 +95,30 @@ intf_header_body infile interface@(Interface name descr decls) =
         C.UnitList [ msg_signature RX name m | m <- messages ],
         C.Blank,
 
-        C.MultiComment [ "Struct type for holding the args for each msg" ],
-        C.UnitList [ msg_argstruct name types m | m <- messages ],
+        C.MultiComment [ "RPC RX function signatures" ],
+        C.UnitList [ msg_signature_rpc_rx name types (binding_param name) m
+                    | m <- rpcs ],
+        C.Blank,
+
+        C.MultiComment [ "Struct type for holding the RX args for each msg" ],
+        C.UnitList [ msg_argstruct RX name types m | m <- messages ],
+        C.Blank,
+
+        C.MultiComment [ "Struct type for holding the TX args for each msg" ],
+        C.UnitList [ msg_argstruct TX name types m | m <- messages ],
+        C.Blank,
+
+        C.MultiComment [ "Union type for all message arguments" ],
+        intf_union RX name messages,
         C.Blank,
 
         C.MultiComment [ "Union type for all message arguments" ],
-        intf_union name messages,
+        intf_union TX name messages,
+        C.Blank,
+
+        C.MultiComment [ "Maximum Transfer Size" ],
+        msg_arg_sizes name types messages,
+        msg_arg_size name types messages,
         C.Blank,
 
         C.MultiComment [ "VTable struct definition for the interface (transmit)" ],
@@ -102,6 +129,10 @@ intf_header_body infile interface@(Interface name descr decls) =
         intf_vtbl name RX messages,
         C.Blank,
 
+        C.MultiComment [ "VTable struct definition for the rpc interface (receive)" ],
+        rpc_rx_vtbl_decl name rpcs,
+        C.Blank,
+
         C.MultiComment [ "Incoming connect callback type" ],
         connect_callback_fn name,
         C.Blank,
@@ -175,36 +206,80 @@ msg_signature_generic dirn ifname typedefs firstparam m = case dirn of
     params = [ firstparam ] ++ opt_continuation ++ concat payload
     payload = case m of
         Message _ _ args _ -> [ msg_argdecl dirn ifname a | a <- args ]
-        RPC s args _       -> [ rpc_argdecl2 ifname typedefs a | a <- args ]
+        RPC s args _       -> [ rpc_argdecl2 TX ifname typedefs a | a <- args ]
 
 msg_signature :: Direction -> String -> MessageDef -> C.Unit
 msg_signature dir ifn = msg_signature_generic dir ifn [] (binding_param ifn)
 
+msg_signature_rpc_rx :: String -> [TypeDef] -> C.Param -> MessageDef -> C.Unit
+msg_signature_rpc_rx ifname typedefs firstparam m@(RPC s args _) = C.TypeDef (C.Function C.NoScope (C.TypeName "errval_t") params) name
+  where
+    name = msg_sig_type_rpc_rx ifname m
+    params = [ firstparam ] ++ concat payload
+    payload = [rpc_argdecl2 RX ifname typedefs a | a <- args]
+
+rpc_rx_vtbl_decl :: String -> [MessageDef] -> C.Unit
+rpc_rx_vtbl_decl n ml =
+    C.StructDecl (rpc_rx_vtbl_type n) [ param n m | m <- ml ]
+    where
+        param ifn m = C.Param (C.Ptr $ C.TypeName $ msg_sig_type_rpc_rx ifn m) ((msg_name m) ++ "_call")
 
 --
--- Generate a struct to hold the arguments of a message while it's being sent.
+-- Get the maximum size of the arguments
 --
-msg_argstruct :: String -> [TypeDef] -> MessageDef -> C.Unit
-msg_argstruct ifname typedefs m@(RPC n args _) =
-    C.StructDecl (msg_argstruct_name ifname n)
-         (concat [ rpc_argdecl ifname a | a <- args ])
-msg_argstruct ifname typedefs m@(Message _ n [] _) = C.NoOp
-msg_argstruct ifname typedefs m@(Message _ n args _) =
-    let tn = msg_argstruct_name ifname n
-    in
-      C.StructDecl tn (concat [ msg_argstructdecl ifname typedefs a
-                               | a <- args ])
 
+msg_arg_size :: String -> [TypeDef] -> [MessageDef] -> C.Unit
+msg_arg_size ifname typedefs messages = C.Define (msg_arg_size_name ifname) []
+                 (C.pp_expr (C.SizeOfT $ C.Union $ binding_arg_union_type RX ifname))
+
+msg_arg_sizes :: String -> [TypeDef] -> [MessageDef] -> C.Unit
+msg_arg_sizes ifname typedefs messages =
+    C.UnitList [ C.UnitList $ define_msg_arg_size ifname m | m <- messages ]
+
+-- extracts the size of the arguemnts of a message
+define_msg_size :: String -> String-> MessageArgument -> C.Unit
+define_msg_size ifn fn (Arg tr (Name an)) = C.NoOp
+define_msg_size ifn fn (Arg tr (StringArray an maxlen)) = C.Define (arg_size_name ifn fn an) [] (show maxlen)
+define_msg_size ifn fn (Arg tr (DynamicArray an len maxlen)) = C.Define (arg_size_name ifn fn an) [] (show maxlen)
+
+
+-- extracts the size of the arguemnts of an RPC (out)
+define_rpc_size :: String -> String-> RPCArgument -> C.Unit
+define_rpc_size ifn fn (RPCArgOut tr (Name an)) = C.NoOp
+define_rpc_size ifn fn (RPCArgIn _ _) = C.NoOp
+define_rpc_size ifn fn (RPCArgOut tr (StringArray an maxlen)) = C.Define (arg_size_name ifn fn an) [] (show maxlen)
+define_rpc_size ifn fn (RPCArgOut tr (DynamicArray an len maxlen)) = C.Define (arg_size_name ifn fn an) [] (show maxlen)
+
+-- extract the size of arguemnts
+define_msg_arg_size :: String-> MessageDef -> [C.Unit]
+define_msg_arg_size ifn (RPC n [] _) = []
+define_msg_arg_size ifn (RPC n args _) = [define_rpc_size ifn n arg | arg <- args]
+define_msg_arg_size ifn (Message mtype n [] _) = []
+define_msg_arg_size ifn (Message mtype n args _) = [define_msg_size ifn n arg | arg <- args]
+
+
+
+--
+-- Generate a struct to hold the arguments of a message while it's being sent.
+--
+msg_argstruct :: Direction -> String -> [TypeDef] -> MessageDef -> C.Unit
+msg_argstruct dir ifname typedefs m@(RPC n args _) =
+    C.StructDecl (msg_argstruct_name dir ifname n)
+                    (concat [ rpc_argdecl TX ifname a | a <- args ])
+msg_argstruct dir ifname typedefs m@(Message _ n [] _) = C.NoOp
+msg_argstruct dir ifname typedefs m@(Message _ n args _) =
+              C.StructDecl (msg_argstruct_name dir ifname n)
+                    (concat [ msg_argstructdecl dir ifname typedefs a | a <- args ])
 --
 -- Generate a union of all the above
 --
-intf_union :: String -> [MessageDef] -> C.Unit
-intf_union ifn msgs =
-    C.UnionDecl (binding_arg_union_type ifn)
-         ([ C.Param (C.Struct $ msg_argstruct_name ifn n) n
+intf_union :: Direction -> String -> [MessageDef] -> C.Unit
+intf_union dir ifn msgs =
+    C.UnionDecl (binding_arg_union_type dir ifn)
+         ([ C.Param (C.Struct $ msg_argstruct_name dir ifn n) n
             | m@(Message _ n a _) <- msgs, 0 /= length a ]
           ++
-          [ C.Param (C.Struct $ msg_argstruct_name ifn n) n
+          [ C.Param (C.Struct $ msg_argstruct_name dir ifn n) n
             | m@(RPC n a _) <- msgs, 0 /= length a ]
          )
 
@@ -229,7 +304,7 @@ binding_struct n ml = C.StructDecl (intf_bind_type n) fields
         C.Param (C.Ptr C.Void) "st",
         C.ParamBlank,
 
-        C.ParamComment "Waitset used for receive handlers and send continuations",
+        C.ParamComment "Waitset used for receive handlers",
         C.Param (C.Ptr $ C.Struct "waitset") "waitset",
         C.ParamBlank,
 
@@ -261,17 +336,40 @@ binding_struct n ml = C.StructDecl (intf_bind_type n) fields
         C.Param (C.Ptr $ C.TypeName $ error_handler_fn_type n) "error_handler",
         C.ParamBlank,
 
+        C.ParamComment "receive next message",
+        C.Param (C.Ptr $ C.TypeName $ receive_next_fn_type n) "receive_next",
+        C.ParamBlank,
+
+        C.ParamComment "get receiving chanstate",
+        C.Param (C.Ptr $ C.TypeName $ get_receiving_chanstate_fn_type n) "get_receiving_chanstate",
+        C.ParamBlank,
+
         C.ParamComment "Message send functions (filled in by binding)",
         C.Param (C.Struct $ intf_vtbl_type n TX) "tx_vtbl",
         C.ParamBlank,
 
-        C.ParamComment "Incoming message handlers (filled in by user)",
+        C.ParamComment "Incoming message handlers, direct (filled in by user)",
         C.Param (C.Struct $ intf_vtbl_type n RX) "rx_vtbl",
         C.ParamBlank,
 
+        C.ParamComment "Incoming message handlers, indirect (filled in by user)",
+        C.Param (C.Struct $ intf_vtbl_type n RX) "message_rx_vtbl",
+        C.ParamBlank,
+
+        C.ParamComment "Incoming message rpc handlers (filled in by user)",
+        C.Param (C.Struct $ rpc_rx_vtbl_type n) "rpc_rx_vtbl",
+        C.ParamBlank,
+
+        C.ParamComment "Message channels",
+        C.Param (C.Array (toInteger ((length ml) + 3)) (C.Struct "waitset_chanstate")) "message_chanstate",
+
+        C.ParamComment "Waitset used for send continuations",
+        C.Param (C.Ptr $ C.Struct "waitset") "send_waitset",
+        C.ParamBlank,
+
         C.ParamComment "Private state belonging to the binding implementation",
-        C.Param (C.Union $ binding_arg_union_type n) "tx_union",
-        C.Param (C.Union $ binding_arg_union_type n) "rx_union",
+        C.Param (C.Union $ binding_arg_union_type TX n) "tx_union",
+        C.Param (C.Union $ binding_arg_union_type RX n) "rx_union",
         C.Param (C.Struct "waitset_chanstate") "register_chanstate",
         C.Param (C.Struct "waitset_chanstate") "tx_cont_chanstate",
         C.Param (C.Enum $ msg_enum_name n) "tx_msgnum",
@@ -283,7 +381,13 @@ binding_struct n ml = C.StructDecl (intf_bind_type n) fields
         C.Param (C.TypeName "size_t") "tx_str_len",
         C.Param (C.TypeName "size_t") "rx_str_len",
         C.Param (C.Struct "event_queue_node") "event_qnode",
-        C.Param (C.Ptr $ C.TypeName $ intf_bind_cont_type n) "bind_cont"]
+        C.Param (C.Ptr $ C.TypeName $ intf_bind_cont_type n) "bind_cont",
+        C.Param (C.TypeName "uint32_t") "incoming_token",
+        C.Param (C.TypeName "uint32_t") "outgoing_token",
+        C.Param (C.Struct "thread_mutex") "rxtx_mutex",
+        C.Param (C.Struct "thread_mutex") "send_mutex",
+        C.Param (C.TypeName "errval_t") "error"
+        ]
 
 --
 -- Generate the binding structure
@@ -399,6 +503,22 @@ error_handler_fn_typedef n =
       params = [ binding_param n,
                  C.Param (C.TypeName "errval_t") "err" ]
 
+receive_next_fn_typedef :: String -> C.Unit
+receive_next_fn_typedef n =
+    C.TypeDef
+        (C.Function C.NoScope (C.TypeName "errval_t") params)
+        (receive_next_fn_type n)
+    where
+        params = [binding_param n]
+
+get_receiving_chanstate_fn_typedef :: String -> C.Unit
+get_receiving_chanstate_fn_typedef n =
+    C.TypeDef
+        (C.Function C.NoScope (C.Ptr $ C.Struct "waitset_chanstate") params)
+        (get_receiving_chanstate_fn_type n)
+    where
+        params = [binding_param n]
+
 bind_function :: String -> C.Unit
 bind_function n =
     C.GVarDecl C.Extern C.NonConst
@@ -451,7 +571,8 @@ tx_wrapper ifn (Message _ mn args _)
     payload_params = [ msg_argdecl TX ifn a | a <- args ]
     payload_args = map C.Variable $ concat $ map mkargs args
     mkargs (Arg _ (Name an)) = [an]
-    mkargs (Arg _ (DynamicArray an al)) = [an, al]
+    mkargs (Arg _ (StringArray an _)) = [an]
+    mkargs (Arg _ (DynamicArray an al _)) = [an, al]
 
 --
 -- Include the right files for different backends
index 221a788..249c9ce 100644 (file)
@@ -1,4 +1,4 @@
-{- 
+{-
    LMP.hs: Flounder stub generator for local message passing.
 
   Part of Flounder: a message passing IDL for Barrelfish
@@ -65,6 +65,8 @@ rx_handler_name ifn = ifscope ifn "lmp_rx_handler"
 -- Names of the control functions
 change_waitset_fn_name ifn = ifscope ifn "lmp_change_waitset"
 control_fn_name ifn = ifscope ifn "lmp_control"
+receive_next_fn_name ifn = ifscope ifn "lmp_receive_next"
+get_receiving_chanstate_fn_name ifn = ifscope ifn "lmp_get_receiving_chanstate"
 
 ------------------------------------------------------------------------
 -- Language mapping: Create the header file for this interconnect driver
@@ -199,6 +201,8 @@ lmp_stub_body arch infile intf@(Interface ifn descr decls) = C.UnitList [
     default_error_handler_fn_def drvname ifn,
     change_waitset_fn_def ifn,
     control_fn_def ifn,
+    receive_next_fn_def ifn,
+    get_receiving_chanstate_fn_def ifn,
 
     C.MultiComment [ "Functions to initialise/destroy the binding state" ],
     lmp_init_fn ifn,
@@ -224,6 +228,8 @@ lmp_init_fn ifn = C.FunctionDef C.NoScope C.Void (lmp_init_fn_name ifn) params [
     C.Ex $ C.Call "lmp_chan_init" [C.AddressOf $ C.DerefField lmp_bind_var "chan"],
     C.Ex $ C.Assignment (common_field "change_waitset") (C.Variable $ change_waitset_fn_name ifn),
     C.Ex $ C.Assignment (common_field "control") (C.Variable $ control_fn_name ifn),
+    C.Ex $ C.Assignment (common_field "receive_next") (C.Variable $ receive_next_fn_name ifn),
+    C.Ex $ C.Assignment (common_field "get_receiving_chanstate") (C.Variable $ get_receiving_chanstate_fn_name ifn),
     C.Ex $ C.Assignment
             (C.DerefField lmp_bind_var "flags")
             (C.Variable "LMP_SEND_FLAGS_DEFAULT") ]
@@ -362,6 +368,9 @@ lmp_connect_handler_fn ifn = C.FunctionDef C.NoScope (C.TypeName "errval_t")
          C.Return $ errvar] [],
     C.SBlank,
 
+    C.Ex $ C.Call (connect_handlers_fn_name ifn) [C.Variable intf_bind_var],
+    C.SBlank,
+
     C.SComment "register for receive",
     C.Ex $ C.Assignment errvar $ C.Call "lmp_chan_register_recv"
         [chanaddr, C.DerefField bindvar "waitset",
@@ -393,6 +402,7 @@ change_waitset_fn_def ifn =
         C.Ex $ C.Call "flounder_support_migrate_notify" [register_chanstate, C.Variable "ws"],
         C.Ex $ C.Call "flounder_support_migrate_notify" [tx_cont_chanstate, C.Variable "ws"],
         C.SBlank,
+        C.Ex $ C.Call (disconnect_handlers_fn_name ifn) [bindvar],
 
         C.SComment "change waitset on binding",
         C.Ex $ C.Assignment
@@ -400,6 +410,8 @@ change_waitset_fn_def ifn =
             (C.Variable "ws"),
         C.SBlank,
 
+        C.Ex $ C.Call (connect_handlers_fn_name ifn) [bindvar],
+
         C.SComment "Migrate send and receive notifications",
         C.Ex $ C.Call "lmp_chan_migrate_recv" [chanaddr, C.Variable "ws"],
         C.Ex $ C.Call "lmp_chan_migrate_send" [chanaddr, C.Variable "ws"],
@@ -432,6 +444,38 @@ control_fn_def ifn =
         params = [C.Param (C.Ptr $ C.Struct $ intf_bind_type ifn) intf_bind_var,
                   C.Param (C.TypeName "idc_control_t") "control"]
 
+receive_next_fn_def :: String -> C.Unit
+receive_next_fn_def ifn =
+    C.FunctionDef C.Static (C.TypeName "errval_t") (receive_next_fn_name ifn) params [
+        localvar (C.TypeName "errval_t") "err" Nothing,
+        localvar (C.Ptr $ C.Struct $ lmp_bind_type ifn)
+            lmp_bind_var_name (Just $ C.Cast (C.Ptr C.Void) $ C.Variable intf_bind_var),
+        localvar (C.Struct "event_closure") "recv_closure"
+            (Just $ C.StructConstant "event_closure" [
+                ("handler", C.Variable $ rx_handler_name ifn),
+                ("arg", C.Variable intf_bind_var)]),
+        C.SBlank,
+        C.SComment "register for another receive notification",
+        C.Ex $ C.Assignment errvar $ C.Call "lmp_chan_register_recv"
+            [chanaddr, C.DerefField bindvar "waitset", C.Variable "recv_closure"],
+        C.Ex $ C.Call "assert" [C.Call "err_is_ok" [errvar]],
+        C.Return $ C.Variable "SYS_ERR_OK"
+    ]
+    where
+        params = [C.Param (C.Ptr $ C.Struct $ intf_bind_type ifn) intf_bind_var]
+        chanaddr = C.AddressOf $ C.DerefField lmp_bind_var "chan"
+
+get_receiving_chanstate_fn_def :: String -> C.Unit
+get_receiving_chanstate_fn_def ifn =
+    C.FunctionDef C.Static (C.Ptr $ C.Struct "waitset_chanstate") (get_receiving_chanstate_fn_name ifn) params [
+        localvar (C.Ptr $ C.Struct $ lmp_bind_type ifn)
+            lmp_bind_var_name (Just $ C.Cast (C.Ptr C.Void) $ C.Variable intf_bind_var),
+        C.SBlank,
+        C.Return $ C.Call "lmp_chan_get_receiving_channel" [C.AddressOf $ C.DerefField lmp_bind_var "chan"]
+    ]
+    where
+        params = [C.Param (C.Ptr $ C.Struct $ intf_bind_type ifn) intf_bind_var]
+
 handler_preamble :: String -> C.Stmt
 handler_preamble ifn = C.StmtList
     [C.SComment "Get the binding state from our argument pointer",
@@ -535,21 +579,29 @@ tx_handler_case arch ifn mn (LMPMsgFragment (OverflowFragment (BufferFragment _
         pos_arg = C.AddressOf $ C.DerefField bindvar "tx_str_pos"
 
 tx_fn :: String -> [TypeDef] -> MessageDef -> C.Unit
-tx_fn ifn typedefs msg@(Message _ n args _) =
+tx_fn ifn typedefs msg@(Message mtype n args _) =
     C.FunctionDef C.Static (C.TypeName "errval_t") (tx_fn_name ifn n) params body
     where
         params = [binding_param ifn, cont_param] ++ (
                     concat [ msg_argdecl TX ifn a | a <- args ])
         cont_param = C.Param (C.Struct "event_closure") intf_cont_var
         body = [
+            -- check size of message
+            C.StmtList [ tx_fn_arg_check_size ifn typedefs n a | a <- args ],
             C.SComment "check that we can accept an outgoing message",
+            C.Ex $ C.Call "thread_mutex_lock" [C.AddressOf $ C.DerefField bindvar "send_mutex"],
+            localvar (C.Ptr $ C.Struct "waitset") "send_waitset" (Just $ C.DerefField bindvar "waitset"),
+            C.Ex $ C.Assignment binding_error (C.Variable "SYS_ERR_OK"),
             C.If (C.Binary C.NotEquals tx_msgnum_field (C.NumConstant 0))
-                [C.Return $ C.Variable "FLOUNDER_ERR_TX_BUSY"] [],
+                [C.Ex $ C.Call "thread_mutex_unlock" [C.AddressOf $ C.DerefField bindvar "send_mutex"],
+                 C.Return $ C.Variable "FLOUNDER_ERR_TX_BUSY"] [],
             C.SBlank,
             C.SComment "register send continuation",
             C.StmtList $ register_txcont (C.Variable intf_cont_var),
             C.SBlank,
             C.SComment "store message number and arguments",
+            C.Ex $ C.Assignment binding_outgoing_token (C.Binary C.BitwiseAnd binding_incoming_token (C.Variable "~1" )),
+            C.Ex $ C.Call "thread_get_outgoing_token" [C.AddressOf binding_outgoing_token],
             C.Ex $ C.Assignment tx_msgnum_field (C.Variable $ msg_enum_elem_name ifn n),
             C.Ex $ C.Assignment tx_msgfrag_field (C.NumConstant 0),
             C.StmtList [ tx_arg_assignment ifn typedefs n a | a <- args ],
@@ -557,11 +609,15 @@ tx_fn ifn typedefs msg@(Message _ n args _) =
             C.SBlank,
             C.SComment "try to send!",
             C.Ex $ C.Call (tx_handler_name ifn n) [C.Variable intf_bind_var],
+            C.StmtList $ block_sending (C.Variable intf_cont_var),
+            C.Ex $ C.Call "thread_mutex_unlock" [C.AddressOf $ C.DerefField bindvar "send_mutex"],
             C.SBlank,
-            C.Return $ C.Variable "SYS_ERR_OK"
+            C.Return binding_error
             ]
         tx_msgnum_field = C.DerefField bindvar "tx_msgnum"
         tx_msgfrag_field = C.DerefField bindvar "tx_msg_fragment"
+        binding_incoming_token = C.DerefField bindvar "incoming_token"
+        binding_outgoing_token = C.DerefField bindvar "outgoing_token"
 
 tx_vtbl :: String -> [MessageDef] -> C.Unit
 tx_vtbl ifn ml =
@@ -575,6 +631,7 @@ rx_handler arch ifn typedefs msgdefs msgs =
         handler_preamble ifn,
         localvar (C.Struct "lmp_recv_msg") "msg" (Just $ C.Variable "LMP_RECV_MSG_INIT"),
         localvar (C.Struct "capref") "cap" Nothing,
+        localvar (C.TypeName "int") "__attribute__ ((unused)) no_register" (Just $ C.NumConstant 0),
 
         -- declare closure for retry
         localvar (C.Struct "event_closure") "recv_closure"
@@ -583,6 +640,8 @@ rx_handler arch ifn typedefs msgdefs msgs =
                 ("arg", C.Variable "arg")]),
         C.SBlank,
 
+        C.If (C.Unary C.Not $ C.Call "lmp_chan_can_recv" [chanaddr]) [C.Goto "out"] [],
+
         C.DoWhile (C.Call "err_is_ok" [errvar]) [
 
         C.SComment "try to retrieve a message from the channel",
@@ -596,7 +655,8 @@ rx_handler arch ifn typedefs msgdefs msgs =
             -- if err_is_fail, check err_no
             [C.If (C.Binary C.Equals (C.Call "err_no" [errvar]) (C.Variable "LIB_ERR_NO_LMP_MSG"))
                 [C.SComment "no message",
-                 C.Break]
+                 C.Ex $ C.Assignment errvar $ C.Variable "SYS_ERR_OK",
+                 C.Continue]
                 [C.SComment "real error",
                  report_user_err $ C.Call "err_push" [errvar, C.Variable "LIB_ERR_LMP_CHAN_RECV"],
                  C.ReturnVoid]
@@ -625,7 +685,8 @@ rx_handler arch ifn typedefs msgdefs msgs =
             C.SComment "unmarshall message number from first word, set fragment to 0",
             C.Ex $ C.Assignment rx_msgnum_field $
                 C.Binary C.BitwiseAnd (C.SubscriptOf msgwords $ C.NumConstant 0) msgnum_mask,
-            C.Ex $ C.Assignment rx_msgfrag_field (C.NumConstant 0)
+            C.Ex $ C.Assignment rx_msgfrag_field (C.NumConstant 0),
+            C.Ex $ C.Assignment binding_incoming_token (C.Binary C.BitwiseAnd (C.Binary C.RightShift (C.SubscriptOf msgwords $ C.NumConstant 0) (C.NumConstant (toInteger msgnum_bits))) (C.HexConstant 0xffffffff))
         ] [],
         C.SBlank,
 
@@ -634,10 +695,12 @@ rx_handler arch ifn typedefs msgdefs msgs =
         ], -- end of the while(1) loop
 
         C.Label "out",
-        C.SComment "re-register for another receive notification",
-        C.Ex $ C.Assignment errvar $ C.Call "lmp_chan_register_recv"
-            [chanaddr, C.DerefField bindvar "waitset", C.Variable "recv_closure"],
-        C.Ex $ C.Call "assert" [C.Call "err_is_ok" [errvar]]
+        C.If (C.Unary C.Not (C.Variable "no_register"))
+            [C.SComment "re-register for another receive notification",
+            C.Ex $ C.Assignment errvar $ C.Call "lmp_chan_register_recv"
+                [chanaddr, C.DerefField bindvar "waitset", C.Variable "recv_closure"],
+            C.Ex $ C.Call "assert" [C.Call "err_is_ok" [errvar]]]
+            []
         ]
     where
         chanaddr = C.AddressOf $ C.DerefField lmp_bind_var "chan"
@@ -647,6 +710,7 @@ rx_handler arch ifn typedefs msgdefs msgs =
         msgnum_bits = bitsizeof_argfieldfrag arch MsgCode
         rx_msgnum_field = C.DerefField bindvar "rx_msgnum"
         rx_msgfrag_field = C.DerefField bindvar "rx_msg_fragment"
+        binding_incoming_token = C.DerefField bindvar "incoming_token"
 
         msgnum_cases = [C.Case (C.Variable $ msg_enum_elem_name ifn mn) (msgnum_case msgdef msg)
                             | (msgdef, msg@(LMPMsgSpec mn _)) <- zip msgdefs msgs]
@@ -703,11 +767,12 @@ rx_handler arch ifn typedefs msgdefs msgs =
                 ],
             C.Break]
             where
-                args = [msg_arg, string_arg, pos_arg, len_arg]
+                args = [msg_arg, string_arg, pos_arg, len_arg, maxsize]
                 msg_arg = C.AddressOf $ C.Variable "msg"
-                string_arg = C.AddressOf $ argfield_expr RX mn af
+                string_arg = argfield_expr RX mn af
                 pos_arg = C.AddressOf $ C.DerefField bindvar "rx_str_pos"
                 len_arg = C.AddressOf $ C.DerefField bindvar "rx_str_len"
+                maxsize = C.SizeOf $ string_arg
 
         msgfrag_case msg@(Message _ mn _ _) (LMPMsgFragment (OverflowFragment (BufferFragment _ afn afl)) _) isLast = [
             C.Ex $ C.Assignment errvar (C.Call "flounder_stub_lmp_recv_buf" args),
@@ -722,11 +787,12 @@ rx_handler arch ifn typedefs msgdefs msgs =
                 ],
             C.Break]
             where
-                args = [msg_arg, buf_arg, len_arg, pos_arg]
+                args = [msg_arg, buf_arg, len_arg, pos_arg, maxsize]
                 msg_arg = C.AddressOf $ C.Variable "msg"
-                buf_arg = C.Cast (C.Ptr $ C.Ptr C.Void) $ C.AddressOf $ argfield_expr RX mn afn
+                buf_arg = C.Cast (C.Ptr C.Void) $ argfield_expr RX mn afn
                 len_arg = C.AddressOf $ argfield_expr RX mn afl
                 pos_arg = C.AddressOf $ C.DerefField bindvar "rx_str_pos"
+                maxsize = C.SizeOf $ argfield_expr RX mn afn
 
         msgfrag_case_prolog :: MessageDef -> Bool -> C.Stmt
         -- intermediate fragment
@@ -734,5 +800,10 @@ rx_handler arch ifn typedefs msgdefs msgs =
             = C.Ex $ C.PostInc $ C.DerefField bindvar "rx_msg_fragment"
 
         -- last fragment: call handler and zero message number
-        msgfrag_case_prolog (Message _ mn msgargs _) True
-            = C.StmtList $ finished_recv drvname ifn typedefs mn msgargs
+        msgfrag_case_prolog (Message mtype mn msgargs _) True
+            = C.StmtList [
+                C.StmtList $ (finished_recv drvname ifn typedefs mtype mn msgargs),
+                                                               C.Goto "out"
+            ]
+            where
+                lmp_chan = C.AddressOf $ C.DerefField lmp_bind_var "chan"
index be847cb..0c0e086 100644 (file)
@@ -1,4 +1,4 @@
-{- 
+{-
    Loopback.hs: Flounder stub generator for dummy loopback stubs
 
   Part of Flounder: a message passing IDL for Barrelfish
@@ -175,9 +175,9 @@ tx_fn ifn msg@(Message _ mn args _) =
             C.Return $ C.Variable "SYS_ERR_OK"
             ]
 
-        arrayargs = [a | a@(Arg _ (DynamicArray _ _)) <- args]
+        arrayargs = [a | a@(Arg _ (DynamicArray _ _ _)) <- args]
 
-        copyarray (Arg tr (DynamicArray n l)) = [
+        copyarray (Arg tr (DynamicArray n l _)) = [
             localvar array_type (array_copy_name n)
                 $ Just $ C.Call "malloc" [size],
             C.If (C.Binary C.Equals copyvar (C.Variable "NULL"))
@@ -191,7 +191,7 @@ tx_fn ifn msg@(Message _ mn args _) =
 
         -- string and array arguments need special treatment
         mkvars (Arg (Builtin String) (Name n)) = [C.Call "strdup" [C.Variable n]]
-        mkvars (Arg _ (DynamicArray n l)) = [C.Variable $ array_copy_name n, C.Variable l]
+        mkvars (Arg _ (DynamicArray n l _)) = [C.Variable $ array_copy_name n, C.Variable l]
         mkvars (Arg _ (Name n)) = [C.Variable n]
 
         array_copy_name n = "_copy_of_" ++ n
index 1610161..dcc3940 100644 (file)
@@ -22,6 +22,7 @@
 > import System.FilePath.Posix
 > import Data.Maybe
 > import Control.Monad
+> import Data.Eq
 
 > import Text.ParserCombinators.Parsec as Parsec
 > import qualified Parser
 
 > data Target = GenericHeader
 >            | GenericCode
+>            | MessageHandlers
 >            | LMP_Header
 >            | LMP_Stub
 >            | UMP_Header
 >            | UMP_Stub
 >            | UMP_IPI_Header
 >            | UMP_IPI_Stub
->           | Multihop_Stub
+>               | Multihop_Stub
 >            | Multihop_Header
 >            | Loopback_Header
 >            | Loopback_Stub
@@ -61,7 +63,7 @@
 >            | THCStubs
 >            | AHCI_Header
 >            | AHCI_Stub
->            deriving (Show)
+>   deriving (Show, Eq)
 
 > data Options = Options {
 >     optTargets :: [Target],
@@ -74,6 +76,7 @@
 > generator :: Options -> Target -> String -> String -> Syntax.Interface -> String
 > generator _ GenericHeader = GHBackend.compile
 > generator _ GenericCode = GCBackend.compile
+> generator _ MessageHandlers = GCBackend.compile_message_handlers
 > generator _ LMP_Header = LMP.header
 > generator opts LMP_Stub
 >     | isNothing arch = error "no architecture specified for LMP stubs"
 > addTarget :: Target -> Options -> IO Options
 > addTarget t o = return o { optTargets = (optTargets o) ++ [t] }
 
+> addTargets :: Target -> Target -> Options -> IO Options
+> addTargets t1 t2 o = return o { optTargets = (optTargets o) ++ (if (elem t1 (optTargets o)) then [t2] else [t1, t2]) }
+
 > setArch :: String -> Options -> IO Options
 > setArch s o = case optArch o of
 >     Nothing -> if isJust arch then return o { optArch = arch }
 > options :: [OptDescr (Options -> IO Options)]
 > options = [
 >             Option ['G'] ["generic-header"] (NoArg $ addTarget GenericHeader) "Create a generic header file",
->             Option [] ["generic-stub"] (NoArg $ addTarget GenericCode) "Create generic part of stub implemention",
+>             Option [] ["generic-stub"] (NoArg $ addTargets MessageHandlers GenericCode) "Create generic part of stub implemention",
 >             Option ['a'] ["arch"] (ReqArg setArch "ARCH")           "Architecture for stubs",
 >             Option ['i'] ["import"] (ReqArg addInclude "FILE")      "Include a given file before processing",
 >             Option [] ["lmp-header"] (NoArg $ addTarget LMP_Header) "Create a header file for LMP",
->             Option [] ["lmp-stub"] (NoArg $ addTarget LMP_Stub)     "Create a stub file for LMP",
+>             Option [] ["lmp-stub"] (NoArg $ addTargets MessageHandlers LMP_Stub)     "Create a stub file for LMP",
 >             Option [] ["ump-header"] (NoArg $ addTarget UMP_Header) "Create a header file for UMP",
->             Option [] ["ump-stub"] (NoArg $ addTarget UMP_Stub)     "Create a stub file for UMP",
+>             Option [] ["ump-stub"] (NoArg $ addTargets MessageHandlers UMP_Stub)     "Create a stub file for UMP",
 >             Option [] ["ump_ipi-header"] (NoArg $ addTarget UMP_IPI_Header) "Create a header file for UMP_IPI",
 >             Option [] ["ump_ipi-stub"] (NoArg $ addTarget UMP_IPI_Stub)     "Create a stub file for UMP_IPI",
 >             Option [] ["multihop-header"] (NoArg $ addTarget Multihop_Header) "Create a header file for Multihop",
index 08fff39..1999f82 100644 (file)
@@ -132,7 +132,7 @@ tx_fn ifn msg@(Message _ mn args _) =
         marshall_arg (Arg (TypeAlias _ b) v) = marshall_arg (Arg (Builtin b) v)
         marshall_arg (Arg (Builtin b) (Name n))
             = C.Call ("msgbuf_marshall_" ++ (show b)) [msgbuf_var, C.Variable n]
-        marshall_arg (Arg (Builtin b) (DynamicArray n l))
+        marshall_arg (Arg (Builtin b) (DynamicArray n l _))
             | b `elem` [Int8, UInt8, Char]
                 = C.Call "msgbuf_marshall_buffer" [msgbuf_var, C.Variable n, C.Variable l]
             | otherwise = error "dynamic arrays are NYI for MsgBuf backend"
@@ -161,7 +161,7 @@ rx_fn ifn msgs =
 
         handle_msg :: String -> [MessageArgument] -> C.Stmt
         handle_msg mn args = C.Block [
-            localvar (C.Struct $ msg_argstruct_name ifn mn) "args" Nothing,
+            localvar (C.Struct $ msg_argstruct_name RX ifn mn) "args" Nothing,
             C.SBlank,
             C.StmtList $ concat $ map (handle_unmarshall.unmarshall_arg) args,
             C.Ex $ C.Call "assert" [C.Binary C.NotEquals rx_handler (C.Variable "NULL")],
@@ -172,7 +172,7 @@ rx_fn ifn msgs =
                 rx_handler_args = [bindvar] ++ (map arg_field $ concat $ map mkargs args)
 
                 mkargs (Arg _ (Name n)) = [n]
-                mkargs (Arg _ (DynamicArray n l)) = [n, l]
+                mkargs (Arg _ (DynamicArray n l _)) = [n, l]
 
         handle_unmarshall :: C.Expr -> [C.Stmt]
         handle_unmarshall unmarshall_expr =
@@ -185,7 +185,7 @@ rx_fn ifn msgs =
         unmarshall_arg (Arg (Builtin b) (Name n))
             = C.Call ("msgbuf_unmarshall_" ++ (show b))
                         [msgbuf_var, C.AddressOf $ arg_field n]
-        unmarshall_arg (Arg (Builtin b) (DynamicArray n l))
+        unmarshall_arg (Arg (Builtin b) (DynamicArray n l _))
             | b `elem` [Int8, UInt8, Char]
                 = C.Call "msgbuf_unmarshall_buffer"
                     [msgbuf_var, C.AddressOf $ arg_field l,
index e2973af..7c7dd6e 100644 (file)
@@ -1,4 +1,4 @@
-{- 
+{-
   MsgFragments.hs: helper for backends that need to split up a message into
    multiple fragments.
 
@@ -19,7 +19,7 @@ import Data.List
 import Data.Ord
 
 import qualified CAbsSyntax as C
-import BackendCommon (Direction (..), intf_bind_var, msg_enum_elem_name,
+import BackendCommon (Direction (..), intf_bind_var, bindvar, msg_enum_elem_name,
                       tx_union_elem, rx_union_elem, type_c_type)
 import Syntax
 import Arch
@@ -56,6 +56,7 @@ type FragmentWord = [ArgFieldFragment]
 -- a (possibly larger) message argument, by type, qualified name and bit offset
 data ArgFieldFragment = ArgFieldFragment TypeBuiltin ArgField Int
                       | MsgCode -- implicit argument, occurs once per message
+                      | Token
                       deriving (Show, Eq)
 
 -- an argument field names the lowest-level field of an argument
@@ -88,6 +89,9 @@ data FieldFragment = FieldFragment ArgFieldFragment
 msg_code_type :: TypeBuiltin
 msg_code_type = UInt16
 
+msg_code_token :: TypeBuiltin
+msg_code_token = UInt32
+
 build_msg_spec :: Arch -> Int -> Bool -> [TypeDef] -> MessageDef -> MsgSpec
 build_msg_spec arch words_per_frag contains_msgcode types (Message _ mn args _)
     -- ensure that we don't produce a completely empty message
@@ -137,7 +141,7 @@ find_msg_fragments arch words_per_frag contains_msgcode frags
     where
         -- does the first fragment need to contain the message code?
         first_frag
-            | contains_msgcode = MsgFragment [[MsgCode]]
+            | contains_msgcode = MsgFragment [[MsgCode, Token]]
             | otherwise        = MsgFragment []
 
         group_frags :: [FieldFragment] -> MsgFragment -> [MsgFragment]
@@ -174,7 +178,7 @@ build_field_fragments arch types args = concat $ map arg_fragments args
     where
         arg_fragments :: MessageArgument -> [FieldFragment]
         arg_fragments (Arg (TypeAlias _ b) v) = arg_fragments (Arg (Builtin b) v)
-        arg_fragments (Arg (Builtin t) (DynamicArray n l))
+        arg_fragments (Arg (Builtin t) (DynamicArray n l _))
             | t `elem` [UInt8, Int8, Char]
                 = [OverflowField $ BufferFragment t [NamedField n] [NamedField l]]
             | otherwise = error "dynamic arrays of types other than char/int8/uint8 are not yet supported"
@@ -183,7 +187,8 @@ build_field_fragments arch types args = concat $ map arg_fragments args
             fragment_typedef [NamedField (varname v)] (lookup_type_name types t)
 
         varname (Name n) = n
-        varname (DynamicArray _ _)
+        varname (StringArray n _) = n
+        varname (DynamicArray _ _ _)
             = error "dynamic arrays of types other than char/int8/uint8 are not yet supported"
 
         fragment_typedef :: ArgField -> TypeDef -> [FieldFragment]
@@ -215,6 +220,8 @@ bitsizeof_argfieldfrag a (ArgFieldFragment t _ _)
     = min (wordsize a) (bitsizeof_builtin a t)
 bitsizeof_argfieldfrag a MsgCode
     = bitsizeof_builtin a msg_code_type
+bitsizeof_argfieldfrag a Token
+    = bitsizeof_builtin a msg_code_token
 
 bitsizeof_builtin :: Arch -> TypeBuiltin -> Int
 bitsizeof_builtin _ UInt8 = 8
@@ -270,6 +277,7 @@ fragment_word_to_expr arch ifn mn frag = mkwordexpr 0 frag
 
         mkfieldexpr :: ArgFieldFragment -> C.Expr
         mkfieldexpr MsgCode = C.Variable $ msg_enum_elem_name ifn mn
+        mkfieldexpr Token = C.DerefField bindvar "outgoing_token"
         mkfieldexpr (ArgFieldFragment t af 0) = fieldaccessor t af
         mkfieldexpr (ArgFieldFragment t af off) =
             C.Binary C.RightShift (fieldaccessor t af) (C.NumConstant $ toInteger off)
@@ -285,6 +293,8 @@ store_arg_frags :: Arch -> String -> String -> C.Expr -> Int -> Int -> [ArgField
 store_arg_frags _ _ _ _ _ _ [] = []
 store_arg_frags arch ifn mn msgdata_ex word bitoff (MsgCode:rest)
     = store_arg_frags arch ifn mn msgdata_ex word (bitoff + bitsizeof_argfieldfrag arch MsgCode) rest
+store_arg_frags arch ifn mn msgdata_ex word bitoff (Token:rest)
+    = store_arg_frags arch ifn mn msgdata_ex word (bitoff + bitsizeof_argfieldfrag arch Token) rest
 store_arg_frags _ _ _ _ _ _ ((ArgFieldFragment String _ _):_)
     = error "strings are not handled here"
 store_arg_frags arch ifn mn msgdata_ex word bitoff (aff@(ArgFieldFragment t af argoff):rest)
index 23a36e8..dd2c03e 100644 (file)
@@ -1,4 +1,4 @@
-{- 
+{-
   Multihop.hs: Flounder stub generator for multihop message passing.
 
   Part of Flounder: a message passing IDL for Barrelfish
@@ -235,6 +235,7 @@ m_fragment_word_to_expr arch ifn mn frag = mkwordexpr 0 frag
 
         mkfieldexpr :: ArgFieldFragment -> C.Expr
         mkfieldexpr MsgCode = C.Variable $ msg_enum_elem_name ifn mn
+        mkfieldexpr Token = C.DerefField bindvar "outgoing_token"
         mkfieldexpr (ArgFieldFragment t af 0) = fieldaccessor t af
         mkfieldexpr (ArgFieldFragment t af off) =
             C.Binary C.RightShift (fieldaccessor t af) (C.NumConstant $ toInteger off)
@@ -728,6 +729,7 @@ tx_fn ifn typedefs msg@(Message _ n args _) =
             C.If (C.Binary C.NotEquals tx_msgnum_field (C.NumConstant 0))
             [C.Return $ C.Variable "FLOUNDER_ERR_TX_BUSY"] [],
             C.SBlank,
+            localvar (C.Ptr $ C.Struct "waitset") "send_waitset" (Just $ C.DerefField bindvar "waitset"),
             C.SComment "register send continuation",
             C.StmtList $ register_txcont (C.Variable intf_cont_var),
             C.SBlank,
@@ -838,6 +840,7 @@ rx_handler arch ifn typedefs msgdefs msgs =
        then localvar m_size_type "o_frag_size" Nothing
        else C.SBlank),
       localvar (C.Ptr $ C.TypeName "uint8_t") "msg" Nothing,
+      localvar (C.TypeName "int") "__attribute__ ((unused)) no_register" (Just $ C.NumConstant 0),
       C.SBlank,
 
       C.SComment "if this a dummy message?",
@@ -937,8 +940,6 @@ rx_handler_msg arch ifn typedefs msgdef (MsgSpec mn frags caps) =
             C.Ex $ C.Call "memcpy" [C.AddressOf $ C.Variable "o_frag_size",
                                     C.Variable "msg",
                                     C.NumConstant m_size_type_bytes ],
-            C.Ex $ C.Assignment (argfield_expr RX mn argfield)
-            (C.Call "malloc" [C.Binary C.Plus (C.Variable "o_frag_size") (C.NumConstant 1)]),
             C.Ex $ C.Call "memcpy" [argfield_expr RX mn argfield,
                                     C.Binary C.Plus (C.Variable "msg")
                                     (C.NumConstant m_size_type_bytes),
@@ -958,8 +959,6 @@ rx_handler_msg arch ifn typedefs msgdef (MsgSpec mn frags caps) =
             C.Ex $ C.Call "memcpy" [C.AddressOf $ C.Variable "o_frag_size",
                                     C.Variable "msg",
                                     C.NumConstant m_size_type_bytes ],
-            C.Ex $ C.Assignment (argfield_expr RX mn d)
-            (C.Call "malloc" [C.Variable "o_frag_size"]),
             C.Ex $ C.Call "memcpy" [argfield_expr RX mn d,
                                     C.Binary C.Plus (C.Variable "msg")
                                     (C.NumConstant m_size_type_bytes),
@@ -979,8 +978,8 @@ rx_handler_msg arch ifn typedefs msgdef (MsgSpec mn frags caps) =
           = C.Ex $ C.PostInc $ C.DerefField bindvar "rx_msg_fragment"
 
         -- last fragment: call handler and zero message number
-        msgfrag_case_prolog ifn typedefs (Message _ mn msgargs _) True
-          = C.StmtList $ finished_recv drvname ifn typedefs mn msgargs
+        msgfrag_case_prolog ifn typedefs (Message mtype mn msgargs _) True
+          = C.StmtList $ finished_recv drvname ifn typedefs mtype mn msgargs
 
 -- receive caps
 caps_rx_handler :: Arch -> String -> [TypeDef] -> [MessageDef] -> [MsgSpec] -> C.Unit
@@ -988,6 +987,7 @@ caps_rx_handler arch ifn typedefs msgdefs msgs =
     C.FunctionDef C.NoScope C.Void (caps_rx_handler_name ifn) multihop_caps_rx_handler_params
     [
       handler_preamble ifn,
+      localvar (C.TypeName "int") "__attribute__ ((unused)) no_register" (Just $ C.NumConstant 0),
       C.SBlank,
 
       C.Ex $ C.Call "assert" [C.Binary C.Equals (C.Variable "capid") (capst `C.FieldOf` "rx_capnum")],
@@ -1016,7 +1016,7 @@ caps_rx_handler arch ifn typedefs msgdefs msgs =
 
 -- receive the capabilities of one message
 cap_rx_handler_case :: Arch -> String -> [TypeDef] -> String -> MessageDef -> Int -> [CapFieldTransfer] -> [C.Stmt]
-cap_rx_handler_case arch ifn typedefs mn (Message _ _ msgargs _) nfrags caps =
+cap_rx_handler_case arch ifn typedefs mn (Message mtype _ msgargs _) nfrags caps =
   [
     C.SComment "Switch on current incoming cap",
     C.Switch (C.PostInc $ capst `C.FieldOf` "rx_capnum") cases
@@ -1038,7 +1038,7 @@ cap_rx_handler_case arch ifn typedefs mn (Message _ _ msgargs _) nfrags caps =
            [(C.If (C.DerefField multihop_bind_var "trigger_chan")
              [C.Ex $ C.Assignment (C.DerefField multihop_bind_var "trigger_chan") (C.Variable "false"),
               C.StmtList finished_send] []),
-            C.StmtList $ (finished_recv drvname ifn typedefs mn msgargs)]
+            C.StmtList $ (finished_recv drvname ifn typedefs mtype mn msgargs)]
          else C.StmtList []),
         C.Break]
         where
index 0df4d25..9180ac8 100644 (file)
@@ -163,8 +163,20 @@ backendParam = do { name <- identifier
 msgtype = do { reserved "message"; return MMessage }
 
 marg typeDcls = try (marg_array typeDcls)
+               <|> (marg_string typeDcls)
                <|> (marg_simple typeDcls)
 
+
+marg_string typeDcls = do {  symbol "String"
+                           ; n <- identifier
+                           ; symbol "["
+                           ; s <- natural
+                           ; symbol "]"
+                           ; bType <- identifyBuiltin typeDcls "String"
+                           ; return (Arg bType (StringArray n s))
+                           }
+
+
 marg_simple typeDcls = do { t <- identifier
                           ; n <- identifier
                           ; b <- identifyBuiltin typeDcls t
@@ -175,9 +187,11 @@ marg_array typeDcls  = do { t <- identifier
                           ; n <- identifier
                           ; symbol "["
                           ; l <- identifier
+                          ; comma
+                          ; s <- natural
                           ; symbol "]"
                           ; bType <- identifyBuiltin typeDcls t
-                          ; return (Arg bType (DynamicArray n l))
+                          ; return (Arg bType (DynamicArray n l s))
                           }
 
 transparentAlias = do { whiteSpace
index 8be2744..6020498 100644 (file)
@@ -1,4 +1,4 @@
-{- 
+{-
   RPCClient.hs: Flounder stub generator for RPC client-side stubs
 
   Part of Flounder: a message passing IDL for Barrelfish
@@ -33,9 +33,6 @@ rpc_bind_var = "_rpc" :: String
 -- Name of the RPC function
 rpc_fn_name ifn mn = idscope ifn mn "rpc"
 
--- Name of the receive handler
-rpc_rx_handler_fn_name ifn mn = idscope ifn mn "rpc_rx_handler"
-
 -- Name of the RPC vtable
 rpc_vtbl_name ifn = ifscope ifn "rpc_vtbl"
 
@@ -105,9 +102,6 @@ rpc_binding_struct name = C.StructDecl (rpc_bind_type name) fields
     fields = [
         C.Param (C.Ptr $ C.Struct $ intf_bind_type name) "b",
         C.Param (C.Struct $ rpc_vtbl_type name) "vtbl",
-        C.Param (C.TypeName "bool") "rpc_in_progress",
-        C.Param (C.TypeName "bool") "reply_present",
-        C.Param (C.TypeName "errval_t") "async_error",
         C.Param (C.Struct "waitset") "rpc_waitset",
         C.Param (C.Struct "waitset_chanstate") "dummy_chanstate"]
 
@@ -141,17 +135,10 @@ rpc_stub_body infile intf@(Interface ifn descr decls) = C.UnitList [
     C.UnitList [ rpc_fn ifn types m | m <- rpcs ],
     C.Blank,
 
-    C.MultiComment [ "Receive handlers" ],
-    C.UnitList [ rpc_rx_handler_fn ifn types m | m <- rpcs ],
-    C.Blank,
-
     C.MultiComment [ "RPC Vtable" ],
     rpc_vtbl ifn rpcs,
     C.Blank,
 
-    C.MultiComment [ "Error handler" ],
-    rpc_error_fn ifn,
-    C.Blank,
 
     C.MultiComment [ "Init function" ],
     rpc_init_fn ifn rpcs]
@@ -165,57 +152,65 @@ rpc_fn ifn typedefs msg@(RPC n args _) =
         localvar (C.TypeName "errval_t") errvar_name (Just $ C.Variable "SYS_ERR_OK"),
         C.Ex $ C.Call "assert" [C.Unary C.Not rpc_progress_var],
         C.Ex $ C.Call "assert" [C.Binary C.Equals async_err_var (C.Variable "SYS_ERR_OK")],
-        C.Ex $ C.Assignment rpc_progress_var (C.Variable "true"),
-        C.Ex $ C.Assignment reply_present_var (C.Variable "false"),
+        C.Ex $ C.Call "thread_set_rpc_in_progress" [C.Variable "true"],
         C.SBlank,
         C.SComment "call send function",
+        C.Ex $ C.Assignment binding_error (C.Variable "SYS_ERR_OK"),
+        C.Ex $ C.Call "thread_set_outgoing_token" [C.Call "thread_set_token" [message_chanstate]],
         C.Ex $ C.Assignment errvar $ C.CallInd tx_func tx_func_args,
-        C.If (C.Call "err_is_fail" [errvar]) [C.Goto "out"] [],
+        C.If (C.Call "err_is_fail" [errvar]) [
+            C.Goto "out"] [],
         C.SBlank,
         C.SComment "wait for message to be sent and reply or error to be present",
-        C.While (C.Binary C.And
-                (C.Binary C.Or (C.Unary C.Not reply_present_var)
-                    (C.Unary C.Not $ C.CallInd (bindvar `C.DerefField` "can_send") [bindvar]))
-                (C.Binary C.Equals async_err_var (C.Variable "SYS_ERR_OK"))) [
-            C.Ex $ C.Assignment errvar $ C.Call "event_dispatch" [waitset_var],
-            C.If (C.Call "err_is_fail" [errvar])
-                [C.Ex $ C.Assignment errvar $ C.Call "err_push"
-                        [errvar, C.Variable "LIB_ERR_EVENT_DISPATCH"],
-                 C.Goto "out"] []
-            ],
+        C.Ex $ C.Assignment errvar $ C.Call "wait_for_channel"
+                [waitset_var, message_chanstate, C.AddressOf binding_error],
         C.SBlank,
-        C.If (C.Call "err_is_fail" [async_err_var])
-            [C.Ex $ C.Assignment errvar async_err_var,
-             C.Ex $ C.Assignment async_err_var (C.Variable "SYS_ERR_OK"),
-             C.Goto "out"] [],
+        C.If (C.Call "err_is_fail" [errvar]) [
+            C.Goto "out"] [],
         C.SBlank,
-        C.StmtList $ if length rxargs > 0 then [
-            C.SComment "grab reply variables out of binding",
-            localvar (C.Ptr $ C.Struct $ intf_bind_type ifn) intf_bind_var
-                $ Just $ C.DerefField rpcvar "b",
-            C.StmtList [C.Ex $ C.Assignment (C.DerefPtr $ C.Variable an) (rpc_rx_union_elem n an)
-                        | an <- concat $ map arg_names rxargs],
-            C.SBlank]
-            else [],
+
+        C.StmtList [assign typedefs arg | arg <- rxargs],
+        C.Ex $ C.Assignment errvar $ C.CallInd receive_next [bindvar],
         C.Label "out",
-        C.Ex $ C.Assignment rpc_progress_var (C.Variable "false"),
+        C.Ex $ C.Call "thread_set_rpc_in_progress" [C.Variable "false"],
+        C.Ex $ C.Call "thread_clear_token" [receiving_chanstate],
         C.Return errvar
     ]
     where
         params = [rpc_binding_param ifn]
-                 ++ concat [rpc_argdecl2 ifn typedefs a | a <- args]
+                 ++ concat [rpc_argdecl2 TX ifn typedefs a | a <- args]
         rpcvar = C.Variable rpc_bind_var
-        reply_present_var = C.DerefField rpcvar "reply_present"
-        rpc_progress_var = C.DerefField rpcvar "rpc_in_progress"
-        async_err_var = C.DerefField rpcvar "async_error"
+        rpc_progress_var = C.Call "thread_get_rpc_in_progress" []
+        async_err_var = C.Call "thread_get_async_error" []
         waitset_var = C.AddressOf $ C.DerefField rpcvar "rpc_waitset"
         bindvar = C.DerefField rpcvar "b"
         tx_func = C.DerefField bindvar "tx_vtbl" `C.FieldOf` (rpc_call_name n)
-        tx_func_args = [bindvar, C.Variable "NOP_CONT"]
-            ++ (map C.Variable $ concat $ map mkargs txargs)
+        tx_func_args = [bindvar, C.Variable "BLOCKING_CONT"] ++ (map C.Variable $ concat $ map mkargs txargs)
         mkargs (Arg _ (Name an)) = [an]
-        mkargs (Arg _ (DynamicArray an al)) = [an, al]
+        mkargs (Arg _ (StringArray an _)) = [an]
+        mkargs (Arg _ (DynamicArray an al _)) = [an, al]
         (txargs, rxargs) = partition_rpc_args args
+        token_name = "token"
+        outgoing_token = bindvar `C.DerefField` "outgoing_token"
+        receiving_chanstate = C.CallInd (bindvar `C.DerefField` "get_receiving_chanstate") [bindvar]
+        binding_error = C.DerefField bindvar "error"
+        message_chanstate = C.Binary C.Plus (C.DerefField bindvar "message_chanstate") (C.Variable $ msg_enum_elem_name ifn (rpc_resp_name n))
+        receive_next = C.DerefField bindvar "receive_next"
+        assign td (Arg tr (Name an)) = case lookup_typeref typedefs tr of
+            TArray t n _ -> C.If (rpc_rx_union_elem n an) [ C.Ex $ C.Call "mem__cpy" [
+                                (rpc_rx_union_elem n an),
+                                (C.Variable an),
+                                C.SizeOfT $ C.TypeName (type_c_name1 ifn n)]][]
+            _ -> C.If (C.Variable an) [
+                    C.Ex $ C.Assignment (C.DerefPtr $ C.Variable an) (rpc_rx_union_elem n an)] []
+        assign _ (Arg _ (StringArray an l)) =  C.If (C.Variable an) [
+                C.Ex $ C.Call "strncpy" [(C.Variable an), (rpc_rx_union_elem n an), C.NumConstant l]
+            ] []
+        assign _ (Arg _ (DynamicArray an al l)) =  C.If (C.Binary C.And (C.Variable an) (C.Variable al)) [
+                C.Ex $ C.Assignment (C.DerefPtr $ C.Variable al) (rpc_rx_union_elem n al),
+                C.Ex $ C.Call "memcpy" [(C.Variable an), (rpc_rx_union_elem n an), C.DerefPtr $ C.Variable al]
+            ] []
+
 
 rpc_vtbl :: String -> [MessageDef] -> C.Unit
 rpc_vtbl ifn ml =
@@ -223,47 +218,13 @@ rpc_vtbl ifn ml =
     where
         fields = [let mn = msg_name m in (mn, rpc_fn_name ifn mn) | m <- ml]
 
-rpc_rx_handler_fn :: String -> [TypeDef] -> MessageDef -> C.Unit
-rpc_rx_handler_fn ifn typedefs msg@(RPC mn args _) =
-    C.FunctionDef C.Static C.Void (rpc_rx_handler_fn_name ifn mn) params [
-        C.SComment "get RPC client state pointer",
-        localvar (C.Ptr $ C.Struct $ rpc_bind_type ifn) rpc_bind_var $
-            Just $ C.DerefField bindvar "st",
-        C.SBlank,
-        C.SComment "XXX: stash reply parameters in binding object",
-        C.SComment "depending on the interconnect driver, they're probably already there",
-        C.StmtList [rx_arg_assignment ifn typedefs mn a | a <- rxargs ],
-        C.SBlank,
-        C.SComment "notify RPC function, and we're done",
-        C.Ex $ C.Assignment
-                (C.Variable rpc_bind_var `C.DerefField` "reply_present")
-                (C.Variable "true")
-    ]
-    where
-        params = [binding_param ifn] ++ concat [msg_argdecl RX ifn a | a <- rxargs]
-        bindvar = C.Variable intf_bind_var
-        (_, rxargs) = partition_rpc_args args
-
--- XXX: this mirrors BackendCommon.tx_arg_assignment
-rx_arg_assignment :: String -> [TypeDef] -> String -> MessageArgument -> C.Stmt
-rx_arg_assignment ifn typedefs mn (Arg tr v) = case v of
-    Name an -> C.Ex $ C.Assignment (rpc_rx_union_elem mn an) (srcarg an)
-    DynamicArray an len -> C.StmtList [
-        C.Ex $ C.Assignment (rpc_rx_union_elem mn an) (C.Variable an),
-        C.Ex $ C.Assignment (rpc_rx_union_elem mn len) (C.Variable len)]
-    where
-        typespec = type_c_type ifn tr
-        srcarg an =
-          case lookup_typeref typedefs tr of
-            -- XXX: I have no idea why GCC requires a cast for the array type
-            TArray _ _ _ -> C.Cast (C.Ptr typespec) (C.Variable an)
-            _ -> C.Variable an
 
 arg_names :: MessageArgument -> [String]
 arg_names (Arg _ v) = var_names v
     where
         var_names (Name n) = [n]
-        var_names (DynamicArray n1 n2) = [n1, n2]
+        var_names (StringArray n _) = [n]
+        var_names (DynamicArray n1 n2 _) = [n1, n2]
 
 rpc_error_fn :: String -> C.Unit
 rpc_error_fn ifn = C.FunctionDef C.Static C.Void (rpc_error_fn_name ifn)
@@ -272,9 +233,9 @@ rpc_error_fn ifn = C.FunctionDef C.Static C.Void (rpc_error_fn_name ifn)
      localvar (C.Ptr $ C.Struct $ rpc_bind_type ifn) rpc_bind_var $
         Just $ C.DerefField bindvar "st",
      C.SBlank,
-     C.If (rpcvar `C.DerefField` "rpc_in_progress")
+     C.If (C.Call "thread_get_rpc_in_progress" [])
         [C.Ex $ C.Call "assert" [C.Call "err_is_fail" [errvar]],
-         C.Ex $ C.Assignment (C.DerefField rpcvar "async_error") errvar,
+         C.Ex $ C.Call "thread_set_async_error" [errvar],
          C.SComment "kick waitset with dummy event",
          C.Ex $ C.Call "flounder_support_register"
                     [waitset_addr, chanstate_addr,
@@ -293,9 +254,6 @@ rpc_init_fn ifn ml = C.FunctionDef C.NoScope (C.TypeName "errval_t")
      C.SBlank,
      C.SComment "Setup state of RPC client object",
      C.Ex $ C.Assignment (C.DerefField rpcvar "b") bindvar,
-     C.Ex $ C.Assignment (C.DerefField rpcvar "reply_present") (C.Variable "false"),
-     C.Ex $ C.Assignment (C.DerefField rpcvar "rpc_in_progress") (C.Variable "false"),
-     C.Ex $ C.Assignment (C.DerefField rpcvar "async_error") (C.Variable "SYS_ERR_OK"),
      C.Ex $ C.Call "waitset_init" [waitset_addr],
      C.Ex $ C.Call "flounder_support_waitset_chanstate_init"
                         [C.AddressOf $ C.DerefField rpcvar "dummy_chanstate"],
@@ -314,11 +272,12 @@ rpc_init_fn ifn ml = C.FunctionDef C.NoScope (C.TypeName "errval_t")
      C.SComment "Set RX handlers on binding object for RPCs",
      C.StmtList [C.Ex $ C.Assignment (C.FieldOf (C.DerefField bindvar "rx_vtbl")
                                         (rpc_resp_name mn))
-         (C.Variable $ rpc_rx_handler_fn_name ifn mn) | RPC mn _ _ <- ml],
+         (C.Variable "NULL") | RPC mn _ _ <- ml],
      C.SBlank,
      C.SComment "Set error handler on binding object",
-     C.Ex $ C.Assignment (bindvar `C.DerefField` "error_handler")
-                          (C.Variable $ rpc_error_fn_name ifn),
+     C.Ex $ C.Assignment (bindvar `C.DerefField` "error_handler") (C.Variable "NULL"),
+    --  C.Ex $ C.Assignment (bindvar `C.DerefField` "error_handler")
+    --                       (C.Variable $ rpc_error_fn_name ifn),
      C.SBlank,
      C.Return $ C.Variable "SYS_ERR_OK"]
     where
@@ -331,7 +290,7 @@ rpc_init_fn_params n = [C.Param (C.Ptr $ C.Struct (rpc_bind_type n)) "rpc",
 
 rpc_rx_union_elem :: String -> String -> C.Expr
 rpc_rx_union_elem mn fn =
-   C.FieldOf (C.FieldOf (C.DerefField (C.Variable intf_bind_var) "rx_union")
+   C.FieldOf (C.FieldOf (C.DerefField (C.DerefField (C.Variable rpc_bind_var) "b") "rx_union")
                     (rpc_resp_name mn)) fn
 
 errvar_name = "_err"
index 9f25ebd..4919c5b 100644 (file)
@@ -125,7 +125,7 @@ Which are shown with:
 >     show IntPtr = "intptr"
 >     show Size = "size"
 >     show Bool = "bool"
->     show String = "string"
+>     show String = "String"
 >     show Char = "char"
 >     show IRef = "iref"
 >     show Cap = "cap"
@@ -147,7 +147,7 @@ Which are shown with:
 >                                "int" -> [(Int32, "")] -- XXX: why? -AB
 >                                "size" -> [(Size, "")]
 >                                "bool" -> [(Bool, "")]
->                                "string" -> [(String, "")]
+>                                "String" -> [(String, "")]
 >                                "char" -> [(Char, "")]
 >                                "iref" -> [(IRef, "")]
 >                                "cap" -> [(Cap, "")]
@@ -303,15 +303,20 @@ the @identifier@ of the argument:
 >     deriving (Show)
 >
 > data Variable = Name String
->               | DynamicArray String String
+>               | StringArray String Integer
+>               | DynamicArray String String Integer
 >     deriving (Show)
 >
 > arg, (.@.) :: TypeRef -> String -> MessageArgument
 > arg typeArg identifier = Arg typeArg (Name identifier)
 > (.@.) = arg
 >
-> argDynamic, (.#.) :: TypeRef -> (String, String) -> MessageArgument
-> argDynamic typeArg (identifier, length) = Arg typeArg (DynamicArray identifier length)
+> argString, (.%.) :: TypeRef -> (String, Integer) -> MessageArgument
+> argString typeArg (identifier, maxlen) = Arg typeArg (StringArray identifier maxlen)
+> (.%.) = argString
+>
+> argDynamic, (.#.) :: TypeRef -> (String, String, Integer) -> MessageArgument
+> argDynamic typeArg (identifier, length, maxlen) = Arg typeArg (DynamicArray identifier length maxlen)
 > (.#.) = argDynamic
 
 And we are done for message definitions.
index db8043f..d4f5eb1 100644 (file)
@@ -541,8 +541,10 @@ rpc_send_argdecl ServerSide ifn (RPCArgOut tr v)  = BC.msg_argdecl BC.TX ifn (Ar
 receive_msg_argdecl :: String -> MessageArgument -> [C.Param]
 receive_msg_argdecl ifn (Arg tr (Name n)) =
     [ C.Param (C.Ptr $ BC.type_c_type ifn tr) n ]
-receive_msg_argdecl ifn (Arg tr (DynamicArray n l)) =
-    [ C.Param (C.Ptr $ C.Ptr $ BC.type_c_type ifn tr) n,
+receive_msg_argdecl ifn (Arg tr (StringArray n l)) = 
+    [ C.Param (BC.type_c_type ifn tr) n ]
+receive_msg_argdecl ifn (Arg tr (DynamicArray n l _)) =
+    [ C.Param (C.Ptr $ BC.type_c_type ifn tr) n, 
       C.Param (C.Ptr $ BC.type_c_type ifn size) l ]
 
 rpc_receive_argdecl :: Side -> String -> RPCArgument -> [C.Param]
@@ -569,7 +571,7 @@ msg_argstruct ifname m@(Message _ n [] _) = C.NoOp
 msg_argstruct ifname m@(Message _ n args _) =
     let tn = msg_argstruct_name ifname n
     in
-      C.StructDecl tn (concat [ BC.msg_argdecl BC.RX ifname a | a <- args ])
+      C.StructDecl tn (concat [ BC.msg_argstructdecl BC.RX ifname [] a | a <- args ])
 msg_argstruct ifname m@(RPC n args _) =
     C.UnitList [
       C.StructDecl (rpc_argstruct_name ifname n "in")
@@ -595,7 +597,7 @@ intf_union ifn msgs =
             | m@(RPC n a _) <- msgs, 0 /= length a ])
 
 rpc_argdecl :: Side -> String -> RPCArgument -> [C.Param]
-rpc_argdecl ClientSide ifn (RPCArgIn tr v) = BC.msg_argdecl BC.RX ifn (Arg tr v)
+rpc_argdecl ClientSide ifn (RPCArgIn tr v) = BC.msg_argstructdecl BC.RX ifn [] (Arg tr v)
 rpc_argdecl ClientSide ifn (RPCArgOut _ _) = []
-rpc_argdecl ServerSide ifn (RPCArgOut tr v) = BC.msg_argdecl BC.RX ifn (Arg tr v)
+rpc_argdecl ServerSide ifn (RPCArgOut tr v) = BC.msg_argstructdecl BC.RX ifn [] (Arg tr v)
 rpc_argdecl ServerSide ifn (RPCArgIn _ _) = []
index 73a1518..be4e9e3 100644 (file)
@@ -1,4 +1,4 @@
-{- 
+{-
   THCBackend: generate interface to Flounder THC stubs
 
   Part of Flounder: a message passing IDL for Barrelfish
@@ -279,7 +279,9 @@ intf_thc_stubs_preamble infile name descr =
 msg_argname :: MessageArgument -> [C.Expr]
 msg_argname (Arg tr (Name n)) =
     [ C.Variable n ]
-msg_argname (Arg tr (DynamicArray n l)) =
+msg_argname (Arg tr (StringArray n l)) =
+    [ C.Variable n ]
+msg_argname (Arg tr (DynamicArray n l _)) =
     [ C.Variable n,
       C.Variable l ]
 
@@ -374,10 +376,28 @@ bh_recv_function side ifn m@(Message _ n args _) =
        decl_args_var =
            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"))
        assignment (Arg _ (Name an)) =
-           [ C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf ((C.DerefField (C.Variable "_args") n)) an))) (C.Variable an) ]
-       assignment (Arg _ (DynamicArray an al)) =
-           [ C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf ((C.DerefField (C.Variable "_args") n)) an))) (C.Variable an),
-             C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf ((C.DerefField (C.Variable "_args") n)) al))) (C.Variable al) ]
+           [ C.If (C.FieldOf ((C.DerefField (C.Variable "_args") n)) an) [
+                C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf ((C.DerefField (C.Variable "_args") n)) an))) (C.Variable an)
+           ][]]
+       assignment (Arg _ (StringArray an l)) =
+           [ C.If (C.FieldOf ((C.DerefField (C.Variable "_args") n)) an) [
+                C.Ex $ C.Call "strncpy" [
+                    (((C.FieldOf ((C.DerefField (C.Variable "_args") n)) an))),
+                    (C.Variable an),
+                    C.NumConstant l
+                 ]
+            ][] ]
+       assignment (Arg _ (DynamicArray an al _)) =
+           [ C.If (C.FieldOf ((C.DerefField (C.Variable "_args") n)) an) [
+                C.Ex $ C.Call "memcpy" [
+                    (((C.FieldOf ((C.DerefField (C.Variable "_args") n)) an))),
+                    (C.Variable an),
+                    C.Variable al
+                ]
+             ][],
+             C.If (C.FieldOf ((C.DerefField (C.Variable "_args") n)) al) [
+                C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf ((C.DerefField (C.Variable "_args") n)) al))) (C.Variable al)
+             ][] ]
        recv_function_body = [
            init_thc_binding_var side ifn,
            decl_fn_var (C.Call thc_start_bh [ pb, common, ( perrx m ) ]),
@@ -411,15 +431,46 @@ bh_recv_function side ifn m@(RPC n args _) =
        opname ClientSide n = n ++ "_response"
        opname ServerSide n = n ++ "_call"
        assignment (RPCArgIn _ (Name an)) =
-           [ C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) an))) (C.Variable an) ]
-       assignment (RPCArgIn _ (DynamicArray an al)) =
-           [ C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) an))) (C.Variable an),
-             C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) al))) (C.Variable al) ]
+           [ C.If ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) an)) [
+              C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) an))) (C.Variable an)
+           ][] ]
+       assignment (RPCArgIn _ (StringArray an l)) =
+           [ C.If ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) an)) [
+              C.Ex $ C.Call "strncpy" [
+                    (((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) an))),
+                    (C.Variable an), C.NumConstant l
+                   ]
+             ][]]
+       assignment (RPCArgIn _ (DynamicArray an al _)) =
+           [ C.If (((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) an))) [
+                C.Ex $ C.Call "memcpy" [
+                    (((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) an))),
+                    (C.Variable an), C.Variable al
+                   ]
+           ][],
+             C.If (C.DerefPtr ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) al))) [
+                C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "in" ) al))) (C.Variable al)
+           ][] ]
        assignment (RPCArgOut _ (Name an)) =
-           [ C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) an))) (C.Variable an) ]
-       assignment (RPCArgOut _ (DynamicArray an al)) =
-           [ C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) an))) (C.Variable an),
-             C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) al))) (C.Variable al) ]
+           [ C.If ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) an)) [
+                C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) an))) (C.Variable an)
+             ][] ]
+       assignment (RPCArgOut _ (StringArray an l)) =
+           [ C.If ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) an)) [
+                C.Ex $ C.Call "strncpy" [
+                    (((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) an))),
+                    (C.Variable an), C.NumConstant l ]
+           ][] ]
+       assignment (RPCArgOut _ (DynamicArray an al _)) =
+           [ C.If (C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) an) [
+                C.Ex $ C.Call "memcpy" [
+                    (((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) an))),
+                    (C.Variable an), C.Variable al
+                 ]
+             ][],
+             C.If ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) al)) [
+                C.Ex $ C.Assignment (C.DerefPtr ((C.FieldOf (C.FieldOf ((C.DerefField (C.Variable "args") n)) "out" ) al))) (C.Variable al)
+             ][]]
        decl_fn_var x =
            C.VarDecl C.NoScope C.NonConst (C.Ptr $ C.Struct thc_receiver_info) "rxi" (Just x)
        decl_args_var =
@@ -700,8 +751,10 @@ intf_struct ifn msgs =
 ptr_msg_argdecl :: String -> MessageArgument -> [C.Param]
 ptr_msg_argdecl ifn (Arg tr (Name n)) =
     [ C.Param (C.Ptr $ BC.type_c_type ifn tr) n ]
-ptr_msg_argdecl ifn (Arg tr (DynamicArray n l)) =
-    [ C.Param (C.Ptr $ C.Ptr $ BC.type_c_type ifn tr) n,
+ptr_msg_argdecl ifn (Arg tr (StringArray n l)) =
+    [ C.Param (BC.type_c_type ifn tr) n ]
+ptr_msg_argdecl ifn (Arg tr (DynamicArray n l _)) =
+    [ C.Param (C.Ptr $ BC.type_c_type ifn tr) n,
       C.Param (C.Ptr $ BC.type_c_type ifn size) l ]
 
 ptr_rpc_argdecl :: Side -> String -> RPCArgument -> [C.Param]
@@ -719,12 +772,16 @@ recv_function_rpc_body assign cb side std_receive_fn ifn m@(RPC n args _) =
        recvEnum ServerSide = THC.call_msg_enum_elem_name
        assignment (RPCArgIn _ (Name an)) =
            [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) (C.Variable an) ]
-       assignment (RPCArgIn _ (DynamicArray an al)) =
+       assignment (RPCArgIn _ (StringArray an l)) =
+           [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) (C.Variable an) ]
+       assignment (RPCArgIn _ (DynamicArray an al _)) =
            [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) (C.Variable an),
              C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") al))) (C.Variable al) ]
        assignment (RPCArgOut _ (Name an)) =
            [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) (C.Variable an) ]
-       assignment (RPCArgOut _ (DynamicArray an al)) =
+       assignment (RPCArgOut _ (StringArray an l)) =
+           [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) (C.Variable an) ]
+       assignment (RPCArgOut _ (DynamicArray an al _)) =
            [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) (C.Variable an),
              C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") al))) (C.Variable al) ]
        dir_args ServerSide = [ a | a@(RPCArgIn _ _) <- args ]
@@ -760,7 +817,9 @@ recv_function cb side ifn m@(Message _ n args _) =
            (concat [ THC.receive_msg_argdecl ifn a | a <- args ]) ]
        assignment (Arg _ (Name an)) =
            [ C.Ex $ C.Assignment (((C.FieldOf ((C.FieldOf (C.Variable "_args") n)) an))) (C.Variable an) ]
-       assignment (Arg _ (DynamicArray an al)) =
+       assignment (Arg _ (StringArray an l)) =
+           [ C.Ex $ C.Assignment (((C.FieldOf ((C.FieldOf (C.Variable "_args") n)) an))) (C.Variable an) ]
+       assignment (Arg _ (DynamicArray an al _)) =
            [ C.Ex $ C.Assignment (((C.FieldOf ((C.FieldOf (C.Variable "_args") n)) an))) (C.Variable an),
              C.Ex $ C.Assignment (((C.FieldOf ((C.FieldOf (C.Variable "_args") n)) al))) (C.Variable al) ]
        recv_function_body = [
@@ -797,12 +856,12 @@ recv_function cb side ifn m@(RPC n args _) =
            (concat [ receive_rpc_argdecl side ifn a | a <- args ]) ]
        assignment (RPCArgIn _ (Name an)) =
            [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) (C.Variable an) ]
-       assignment (RPCArgIn _ (DynamicArray an al)) =
+       assignment (RPCArgIn _ (DynamicArray an al _)) =
            [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) (C.Variable an),
              C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") al))) (C.Variable al) ]
        assignment (RPCArgOut _ (Name an)) =
            [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) (C.Variable an) ]
-       assignment (RPCArgOut _ (DynamicArray an al)) =
+       assignment (RPCArgOut _ (DynamicArray an al _)) =
            [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) (C.Variable an),
              C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") al))) (C.Variable al) ]
        dir_args ServerSide = [ a | a@(RPCArgIn _ _) <- args ]
@@ -856,18 +915,24 @@ gen_receive_any_fn cb side ifn ms =
         p_rxi = C.AddressOf $ C.Variable "_rxi"
         rpc_assignment n (RPCArgIn _ (Name an)) =
            [ 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) ]
-        rpc_assignment n (RPCArgIn _ (DynamicArray an al)) =
-           [ 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),
+        rpc_assignment n (RPCArgIn _ (StringArray an l)) =
+           [ 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) ]
+        rpc_assignment n (RPCArgIn _ (DynamicArray an al _)) =
+           [ 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),
              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) ]
         rpc_assignment n (RPCArgOut _ (Name an)) =
            [ 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) ]
-        rpc_assignment n (RPCArgOut _ (DynamicArray an al)) =
-           [ 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),
+        rpc_assignment n (RPCArgOut _ (StringArray an l)) =
+           [ 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) ]
+        rpc_assignment n (RPCArgOut _ (DynamicArray an al _)) =
+           [ 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),
              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) ]
         message_assignment n (Arg _ (Name an)) =
            [ 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) ]
-        message_assignment n (Arg _ (DynamicArray an al)) =
-           [ 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),
+        message_assignment n (Arg _ (StringArray an l)) =
+           [ 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) ]
+        message_assignment n (Arg _ (DynamicArray an al _)) =
+           [ 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),
              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) ]
         dir_args ServerSide args = [ a | a@(RPCArgIn _ _) <- args ]
         dir_args ClientSide args = [ a | a@(RPCArgOut _ _) <- args ]
@@ -934,10 +999,12 @@ gen_call_seq cb ifn m@(RPC n args _) =
              ]
           ]
        send_arg (RPCArgIn tr (Name an)) = [ C.Variable an ]
-       send_arg (RPCArgIn tr (DynamicArray an al)) = [ C.Variable an, C.Variable al ]
+       send_arg (RPCArgIn tr (StringArray an l)) = [ C.Variable an ]
+       send_arg (RPCArgIn tr (DynamicArray an al _)) = [ C.Variable an, C.Variable al ]
        send_arg (RPCArgOut _ _ ) = [ ]
        receive_arg (RPCArgOut tr (Name an)) = [ C.Variable an ]
-       receive_arg (RPCArgOut tr (DynamicArray an al)) = [ C.Variable an, C.Variable al ]
+       receive_arg (RPCArgOut tr (StringArray an l)) = [ C.Variable an ]
+       receive_arg (RPCArgOut tr (DynamicArray an al _)) = [ C.Variable an, C.Variable al ]
        receive_arg (RPCArgIn _ _ ) = [ ]
    in
         C.FunctionDef C.Static (C.TypeName "errval_t") (fn_name cb)
@@ -1012,10 +1079,12 @@ gen_call_fifo cb ifn m@(RPC n args _) =
             C.Return $ C.Variable "_result"
           ]
        send_arg (RPCArgIn tr (Name an)) = [ C.Variable an ]
-       send_arg (RPCArgIn tr (DynamicArray an al)) = [ C.Variable an, C.Variable al ]
+       send_arg (RPCArgIn tr (StringArray an _)) = [ C.Variable an ]
+       send_arg (RPCArgIn tr (DynamicArray an al _)) = [ C.Variable an, C.Variable al ]
        send_arg (RPCArgOut _ _ ) = [ ]
        receive_arg (RPCArgOut tr (Name an)) = [ C.Variable an ]
-       receive_arg (RPCArgOut tr (DynamicArray an al)) = [ C.Variable an, C.Variable al ]
+       receive_arg (RPCArgOut tr (StringArray an _)) = [ C.Variable an ]
+       receive_arg (RPCArgOut tr (DynamicArray an al _)) = [ C.Variable an, C.Variable al ]
        receive_arg (RPCArgIn _ _ ) = [ ]
    in
         C.FunctionDef C.Static (C.TypeName "errval_t") (fn_name cb)
@@ -1033,12 +1102,16 @@ gen_call_ooo cb ifn m@(RPC n (_:_:args) _) =
            (concat [ call_rpc_argdecl ifn a | a <- args ]) ]
        assignment (RPCArgIn _ (Name an)) =
            [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) (C.Variable an) ]
-       assignment (RPCArgIn _ (DynamicArray an al)) =
+       assignment (RPCArgIn _ (StringArray an _)) =
+           [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) (C.Variable an) ]
+       assignment (RPCArgIn _ (DynamicArray an al _)) =
            [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") an))) (C.Variable an),
              C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "in") al))) (C.Variable al) ]
        assignment (RPCArgOut _ (Name an)) =
            [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) (C.Variable an) ]
-       assignment (RPCArgOut _ (DynamicArray an al)) =
+       assignment (RPCArgOut _ (StringArray an _)) =
+           [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) (C.Variable an) ]
+       assignment (RPCArgOut _ (DynamicArray an al _)) =
            [ C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") an))) (C.Variable an),
              C.Ex $ C.Assignment (((C.FieldOf (C.FieldOf (C.FieldOf (C.Variable "_args") n) "out") al))) (C.Variable al) ]
        call_function_body CANCELABLE = [
@@ -1109,10 +1182,12 @@ gen_call_ooo cb ifn m@(RPC n (_:_:args) _) =
             ]
           ]
        send_arg (RPCArgIn tr (Name an)) = [ C.Variable an ]
-       send_arg (RPCArgIn tr (DynamicArray an al)) = [ C.Variable an, C.Variable al ]
+       send_arg (RPCArgIn tr (StringArray an _)) = [ C.Variable an ]
+       send_arg (RPCArgIn tr (DynamicArray an al _)) = [ C.Variable an, C.Variable al ]
        send_arg (RPCArgOut _ _ ) = [ ]
        receive_arg (RPCArgOut tr (Name an)) = [ C.Variable an ]
-       receive_arg (RPCArgOut tr (DynamicArray an al)) = [ C.Variable an, C.Variable al ]
+       receive_arg (RPCArgOut tr (StringArray an _)) = [ C.Variable an ]
+       receive_arg (RPCArgOut tr (DynamicArray an al _)) = [ C.Variable an, C.Variable al ]
        receive_arg (RPCArgIn _ _ ) = [ ]
    in
         C.FunctionDef C.Static (C.TypeName "errval_t") (fn_name cb)
index 7e06182..5df467a 100644 (file)
@@ -1,4 +1,4 @@
-{- 
+{-
   UMPCommon.hs: Flounder stub generator for cross-core shared memory message passing.
 
   Part of Flounder: a message passing IDL for Barrelfish
@@ -22,6 +22,7 @@ import Arch
 import BackendCommon
 import Syntax
 import MsgFragments
+import GHBackend (connect_handlers_fn_name, disconnect_handlers_fn_name)
 
 -- parameters used to modify the behaviour of this backend
 data UMPParams = UMPParams {
@@ -129,6 +130,11 @@ change_waitset_fn_name p ifn = ump_ifscope p ifn "change_waitset"
 -- Name of the continuation that runs when we get the monitor mutex
 monitor_mutex_cont_name p ifn = ump_ifscope p ifn "monitor_mutex_cont"
 
+-- Name of the receive next function that should be called when a binding
+-- can start receiving next message
+receive_next_fn_name p ifn = ump_ifscope p ifn "receive_next"
+get_receiving_chanstate_fn_name p ifn = ump_ifscope p ifn "get_receiving_chanstate"
+
 ------------------------------------------------------------------------
 -- Language mapping: Create the header file for this interconnect driver
 ------------------------------------------------------------------------
@@ -319,6 +325,8 @@ stub_body p infile intf@(Interface ifn descr decls) = C.UnitList [
       default_error_handler_fn_def drvname ifn,
       change_waitset_fn_def p ifn,
       generic_control_fn_def drvname ifn,
+      receive_next_fn_def p ifn,
+      get_receiving_chanstate_fn_def p ifn,
       C.Blank,
 
       C.MultiComment [ "Function to destroy the binding state" ],
@@ -388,6 +396,8 @@ connect_fn p ifn =
       C.Ex $ C.Call "flounder_stub_ump_state_init" [C.AddressOf statevar, my_bindvar],
       C.Ex $ C.Assignment (common_field "change_waitset") (C.Variable $ change_waitset_fn_name p ifn),
       C.Ex $ C.Assignment (common_field "control") (C.Variable $ generic_control_fn_name (ump_drv p) ifn),
+      C.Ex $ C.Assignment (common_field "receive_next") (C.Variable $ receive_next_fn_name p ifn),
+      C.Ex $ C.Assignment (common_field "get_receiving_chanstate") (C.Variable $ get_receiving_chanstate_fn_name p ifn),
       C.Ex $ C.Assignment (common_field "st") (C.Variable "st"),
       C.Ex $ C.Assignment (intf_bind_v `C.FieldOf` "bind_cont") (C.Variable intf_cont_var),
 
@@ -433,6 +443,7 @@ connect_fn p ifn =
           (C.Variable $ tx_vtbl_name p ifn)
         intf_bind_v = C.DerefField my_bindvar "b"
         common_field f = intf_bind_v `C.FieldOf` f
+        receiving_chanstate = my_bindvar `C.DerefField` "b" `C.FieldOf` "receiving_chanstate"
 
 accept_fn :: UMPParams -> String -> C.Unit
 accept_fn p ifn =
@@ -466,6 +477,8 @@ accept_fn p ifn =
       C.Ex $ C.Assignment (sendvar) (C.DerefField (C.Variable "_frameinfo") "sendbase"),
       C.Ex $ C.Assignment (common_field "change_waitset") (C.Variable $ change_waitset_fn_name p ifn),
       C.Ex $ C.Assignment (common_field "control") (C.Variable $ generic_control_fn_name (ump_drv p) ifn),
+      C.Ex $ C.Assignment (common_field "receive_next") (C.Variable $ receive_next_fn_name p ifn),
+      C.Ex $ C.Assignment (common_field "get_receiving_chanstate") (C.Variable $ get_receiving_chanstate_fn_name p ifn),
       C.Ex $ C.Assignment (common_field "st") (C.Variable "st"),
       C.Ex $ C.Assignment (common_field "bind_cont") (C.Variable intf_cont_var),
       C.Ex $ C.Assignment (my_bindvar `C.DerefField` "inchanlen") (C.DerefField (C.Variable intf_frameinfo_var) "inbufsize"),
@@ -501,6 +514,8 @@ bind_fn p ifn =
         C.Ex $ C.Call "flounder_stub_ump_state_init" [C.AddressOf statevar, my_bindvar],
         C.Ex $ C.Assignment (common_field "change_waitset") (C.Variable $ change_waitset_fn_name p ifn),
         C.Ex $ C.Assignment (common_field "control") (C.Variable $ generic_control_fn_name (ump_drv p) ifn),
+        C.Ex $ C.Assignment (common_field "receive_next") (C.Variable $ receive_next_fn_name p ifn),
+        C.Ex $ C.Assignment (common_field "get_receiving_chanstate") (C.Variable $ get_receiving_chanstate_fn_name p ifn),
         C.Ex $ C.Assignment (common_field "st") (C.Variable "st"),
         C.Ex $ C.Assignment (intf_bind_var `C.FieldOf` "bind_cont") (C.Variable intf_cont_var),
         C.Ex $ C.Assignment (my_bindvar `C.DerefField` "iref") (C.Variable "iref"),
@@ -551,6 +566,7 @@ bind_fn p ifn =
       params = bind_params p ifn
       intf_bind_var = C.DerefField my_bindvar "b"
       common_field f = intf_bind_var `C.FieldOf` f
+      receiving_chanstate = my_bindvar `C.DerefField` "b" `C.FieldOf` "receiving_chanstate"
 
 
 new_monitor_cont_fn :: UMPParams -> String -> C.Unit
@@ -649,7 +665,9 @@ connect_handler_fn p ifn = C.FunctionDef C.NoScope (C.TypeName "errval_t")
     C.Ex $ C.Call "flounder_stub_ump_state_init" [C.AddressOf statevar, my_bindvar],
     C.Ex $ C.Assignment (common_field "change_waitset") (C.Variable $ change_waitset_fn_name p ifn),
     C.Ex $ C.Assignment (common_field "control") (C.Variable $ generic_control_fn_name (ump_drv p) ifn),
-      C.Ex $ C.Assignment (my_bindvar `C.DerefField` "no_cap_transfer") (C.Variable "0"),
+    C.Ex $ C.Assignment (common_field "receive_next") (C.Variable $ receive_next_fn_name p ifn),
+    C.Ex $ C.Assignment (common_field "get_receiving_chanstate") (C.Variable $ get_receiving_chanstate_fn_name p ifn),
+    C.Ex $ C.Assignment (my_bindvar `C.DerefField` "no_cap_transfer") (C.Variable "0"),
     C.StmtList $ (ump_connect_extra_fields_init p),
     C.SBlank,
 
@@ -677,6 +695,8 @@ connect_handler_fn p ifn = C.FunctionDef C.NoScope (C.TypeName "errval_t")
     C.StmtList $ setup_cap_handlers p ifn,
     C.SBlank,
 
+    C.Ex $ C.Call (connect_handlers_fn_name ifn) [C.Variable intf_bind_var],
+
     C.StmtList $ if isJust (ump_accept_alloc_notify p)
         then
             [C.StmtList $ (fromJust $ ump_accept_alloc_notify p) ifn,
@@ -705,6 +725,7 @@ connect_handler_fn p ifn = C.FunctionDef C.NoScope (C.TypeName "errval_t")
                         (exportvar `C.DerefField` "waitset")
                         (C.Variable $ tx_vtbl_name p ifn)
         common_field f = my_bindvar `C.DerefField` "b" `C.FieldOf` f
+        receiving_chanstate = my_bindvar `C.DerefField` "b" `C.FieldOf` "receiving_chanstate"
 
 change_waitset_fn_def :: UMPParams -> String -> C.Unit
 change_waitset_fn_def p ifn =
@@ -725,14 +746,6 @@ change_waitset_fn_def p ifn =
                 []
             ] [],
         C.SBlank,
-
-        C.SComment "change waitset on binding",
-        C.Ex $ C.Assignment
-            (bindvar `C.DerefField` "waitset")
-            (C.Variable "ws"),
-        C.SBlank,
-
-        C.SComment "re-register for receive (if previously registered)",
         C.StmtList $ ump_deregister_recv p ifn,
         C.If (C.Binary C.And
                 (C.Call "err_is_fail" [errvar])
@@ -741,6 +754,16 @@ change_waitset_fn_def p ifn =
             [C.Return $
                C.Call "err_push" [errvar, C.Variable "LIB_ERR_CHAN_DEREGISTER_RECV"]]
             [],
+        C.Ex $ C.Call (disconnect_handlers_fn_name ifn) [bindvar],
+
+        C.SComment "change waitset on binding",
+        C.Ex $ C.Assignment
+            (bindvar `C.DerefField` "waitset")
+            (C.Variable "ws"),
+        C.SBlank,
+
+        C.Ex $ C.Call (connect_handlers_fn_name ifn) [bindvar],
+        C.SComment "re-register for receive (if previously registered)",
         C.If (C.Call "err_is_ok" [errvar]) [
             C.StmtList $ ump_register_recv p ifn,
             C.If (C.Call "err_is_fail" [errvar])
@@ -756,6 +779,30 @@ change_waitset_fn_def p ifn =
         params = [C.Param (C.Ptr $ C.Struct $ intf_bind_type ifn) intf_bind_var,
                   C.Param (C.Ptr $ C.Struct "waitset") "ws"]
 
+receive_next_fn_def :: UMPParams -> String -> C.Unit
+receive_next_fn_def p ifn =
+    C.FunctionDef C.Static (C.TypeName "errval_t") (receive_next_fn_name p ifn) params [
+        localvar (C.TypeName "errval_t") "err" Nothing,
+        localvar (C.Ptr $ C.Struct $ my_bind_type p ifn)
+            my_bind_var_name (Just $ C.Cast (C.Ptr C.Void) $ C.Variable intf_bind_var),
+        C.SBlank,
+        C.StmtList $ register_recv p ifn,
+        C.Return $ C.Variable "SYS_ERR_OK"
+    ]
+    where
+        params = [C.Param (C.Ptr $ C.Struct $ intf_bind_type ifn) intf_bind_var]
+
+get_receiving_chanstate_fn_def :: UMPParams -> String -> C.Unit
+get_receiving_chanstate_fn_def p ifn =
+    C.FunctionDef C.Static (C.Ptr $ C.Struct "waitset_chanstate") (get_receiving_chanstate_fn_name p ifn) params [
+        localvar (C.Ptr $ C.Struct $ my_bind_type p ifn)
+            my_bind_var_name (Just $ C.Cast (C.Ptr C.Void) bindvar),
+        C.SBlank,
+        C.Return $ C.Call "ump_chan_get_receiving_channel" [C.AddressOf $ C.FieldOf (C.DerefField my_bindvar "ump_state") "chan"]
+    ]
+    where
+        params = [C.Param (C.Ptr $ C.Struct $ intf_bind_type ifn) intf_bind_var]
+
 handler_preamble :: UMPParams -> String -> C.Stmt
 handler_preamble p ifn = C.StmtList
     [C.SComment "Get the binding state from our argument pointer",
@@ -846,6 +893,7 @@ tx_bind_msg p ifn =
       C.SBlank,
 
       C.SComment "send the next fragment",
+      C.Ex $ C.Assignment ump_token (C.Variable "0"),
       C.Ex $ C.Assignment msgvar $ C.Call "ump_chan_get_next" [chanaddr, ctrladdr],
       C.Ex $ C.Call "flounder_stub_ump_control_fill"
                   [chanst, ctrladdr, C.Variable $ msg_enum_elem_name ifn "__bind"],
@@ -868,6 +916,7 @@ tx_bind_msg p ifn =
       msgvar = C.Variable "msg"
       msgword n = C.DerefField msgvar "data" `C.SubscriptOf` (C.NumConstant $ toInteger n)
       msgheader = C.DerefField msgvar "header" `C.FieldOf` "control"
+      ump_token = C.DerefField chanst "token"
 
 
 
@@ -882,10 +931,11 @@ tx_bind_reply p ifn =
 
       C.SComment "check if we can send another message",
       C.If (C.Unary C.Not $ C.Call "flounder_stub_ump_can_send" [C.AddressOf umpst])
-          [C.Return (C.Variable "FLOUNDER_ERR_TX_BUSY")] [],
+        [C.Return (C.Variable "FLOUNDER_ERR_TX_BUSY")] [],
       C.SBlank,
 
       C.SComment "send the next fragment",
+      C.Ex $ C.Assignment ump_token (C.Variable "0"),
       C.Ex $ C.Assignment msgvar $ C.Call "ump_chan_get_next" [chanaddr, ctrladdr],
       C.Ex $ C.Call "flounder_stub_ump_control_fill"
                   [chanst, ctrladdr, C.Variable $ msg_enum_elem_name ifn "__bind_reply"],
@@ -908,6 +958,7 @@ tx_bind_reply p ifn =
       msgvar = C.Variable "msg"
       msgword n = C.DerefField msgvar "data" `C.SubscriptOf` (C.NumConstant $ toInteger n)
       msgheader = C.DerefField msgvar "header" `C.FieldOf` "control"
+      ump_token = C.DerefField chanst "token"
 
 tx_handler :: UMPParams -> String -> [MsgSpec] -> C.Unit
 tx_handler p ifn msgs =
@@ -1007,6 +1058,7 @@ tx_handler_case p ifn mn (MsgFragment words) = [
     C.SBlank,
 
     C.SComment "send the next fragment",
+    C.Ex $ C.Assignment ump_token binding_outgoing_token,
     C.Ex $ C.Assignment msgvar $ C.Call "ump_chan_get_next" [chanaddr, ctrladdr],
     C.Ex $ C.Call "flounder_stub_ump_control_fill"
                 [stateaddr, ctrladdr, C.Variable $ msg_enum_elem_name ifn mn],
@@ -1024,9 +1076,14 @@ tx_handler_case p ifn mn (MsgFragment words) = [
         msgword n = C.DerefField msgvar "data" `C.SubscriptOf` (C.NumConstant $ toInteger n)
         msgheader = C.DerefField msgvar "header" `C.FieldOf` "control"
         chanaddr = C.AddressOf $ C.FieldOf statevar "chan"
+        ump_token = C.DerefField chanst "token"
+        umpst = C.DerefField my_bindvar "ump_state"
+        chanst = C.AddressOf umpst
+        binding_outgoing_token = C.DerefField bindvar "outgoing_token"
 
 tx_handler_case p ifn mn (OverflowFragment (StringFragment af)) =
-    [C.Ex $ C.Assignment errvar (C.Call "flounder_stub_ump_send_string" args),
+    [C.Ex $ C.Assignment ump_token binding_outgoing_token,
+     C.Ex $ C.Assignment errvar (C.Call "flounder_stub_ump_send_string" args),
      C.If (C.Call "err_is_fail" [errvar]) [
         -- have we run out of space in the buffer?
         C.If (C.Binary C.Equals (C.Call "err_no" [errvar])
@@ -1044,9 +1101,14 @@ tx_handler_case p ifn mn (OverflowFragment (StringFragment af)) =
         string_arg = argfield_expr TX mn af
         pos_arg = C.AddressOf $ C.DerefField bindvar "tx_str_pos"
         len_arg = C.AddressOf $ C.DerefField bindvar "tx_str_len"
+        ump_token = C.DerefField chanst "token"
+        umpst = C.DerefField my_bindvar "ump_state"
+        chanst = C.AddressOf umpst
+        binding_outgoing_token = C.DerefField bindvar "outgoing_token"
 
 tx_handler_case p ifn mn (OverflowFragment (BufferFragment _ afn afl)) =
-    [C.Ex $ C.Assignment errvar (C.Call "flounder_stub_ump_send_buf" args),
+    [C.Ex $ C.Assignment ump_token binding_outgoing_token,
+     C.Ex $ C.Assignment errvar (C.Call "flounder_stub_ump_send_buf" args),
      C.If (C.Call "err_is_fail" [errvar]) [
         -- have we run out of space in the buffer?
         C.If (C.Binary C.Equals (C.Call "err_no" [errvar])
@@ -1064,23 +1126,42 @@ tx_handler_case p ifn mn (OverflowFragment (BufferFragment _ afn afl)) =
         buf_arg = argfield_expr TX mn afn
         len_arg = argfield_expr TX mn afl
         pos_arg = C.AddressOf $ C.DerefField bindvar "tx_str_pos"
+        ump_token = C.DerefField chanst "token"
+        umpst = C.DerefField my_bindvar "ump_state"
+        chanst = C.AddressOf umpst
+        binding_outgoing_token = C.DerefField bindvar "outgoing_token"
 
 tx_fn :: UMPParams -> String -> [TypeDef] -> MessageDef -> MsgSpec -> C.Unit
-tx_fn p ifn typedefs msg@(Message _ n args _) (MsgSpec _ _ caps) =
+tx_fn p ifn typedefs msg@(Message mtype n args _) (MsgSpec _ _ caps) =
     C.FunctionDef C.Static (C.TypeName "errval_t") (tx_fn_name p ifn n) params body
     where
-        params = [binding_param ifn, cont_param] ++ (
+        params = [binding_param2 ifn, cont_param] ++ (
                     concat [ msg_argdecl TX ifn a | a <- args ])
         cont_param = C.Param (C.Struct "event_closure") intf_cont_var
         body = [
+            localvar (C.Ptr $ C.Struct $ intf_bind_type ifn) intf_bind_var (Just $ C.Variable (intf_bind_var ++ "_")),
+            -- check message size does not exceed receive buffer
+            C.StmtList [ tx_fn_arg_check_size ifn typedefs n a | a <- args ],
+            C.Ex $ C.Call "thread_mutex_lock" [C.AddressOf $ C.DerefField bindvar "send_mutex"],
+            C.Ex $ C.Assignment binding_error (C.Variable "SYS_ERR_OK"),
+            localvar (C.Ptr $ C.Struct "waitset") "send_waitset" (Just $ C.DerefField bindvar "waitset"),
+            -- localvar (C.Struct "waitset") "tmp_waitset" Nothing,
+            -- C.If (C.Binary C.Equals ((C.Variable intf_cont_var) `C.FieldOf` "handler") (C.Variable "blocking_cont")) [
+            --     C.Ex $ C.Assignment (C.Variable "send_waitset") (C.AddressOf $ C.Variable "tmp_waitset"),
+            --     C.Ex $ C.Call "waitset_init" [C.Variable "send_waitset"]
+            -- ] [],
+
             C.SComment "check that we can accept an outgoing message",
             C.If (C.Binary C.NotEquals tx_msgnum_field (C.NumConstant 0))
-                [C.Return $ C.Variable "FLOUNDER_ERR_TX_BUSY"] [],
+                [C.Ex $ C.Call "thread_mutex_unlock" [C.AddressOf $ C.DerefField bindvar "send_mutex"],
+                 C.Return $ C.Variable "FLOUNDER_ERR_TX_BUSY"] [],
             C.SBlank,
             C.SComment "register send continuation",
             C.StmtList $ register_txcont (C.Variable intf_cont_var),
             C.SBlank,
             C.SComment "store message number and arguments",
+            C.Ex $ C.Assignment binding_outgoing_token (C.Binary C.BitwiseAnd binding_incoming_token (C.Variable "~1" )),
+            C.Ex $ C.Call "thread_get_outgoing_token" [C.AddressOf binding_outgoing_token],
             C.Ex $ C.Assignment tx_msgnum_field (C.Variable $ msg_enum_elem_name ifn n),
             C.Ex $ C.Assignment tx_msgfrag_field (C.NumConstant 0),
             C.StmtList [ tx_arg_assignment ifn typedefs n a | a <- args ],
@@ -1104,15 +1185,21 @@ tx_fn p ifn typedefs msg@(Message _ n args _) (MsgSpec _ _ caps) =
                  C.SBlank]
                 else [],
             C.SComment "try to send!",
+            C.Ex $ C.Call "thread_mutex_lock" [C.AddressOf $ C.DerefField bindvar "rxtx_mutex"],
             C.Ex $ C.Call (tx_handler_name p ifn) [bindvar],
+            C.Ex $ C.Call "thread_mutex_unlock" [C.AddressOf $ C.DerefField bindvar "rxtx_mutex"],
+            C.StmtList $ block_sending (C.Variable intf_cont_var),
+            C.Ex $ C.Call "thread_mutex_unlock" [C.AddressOf $ C.DerefField bindvar "send_mutex"],
             C.SBlank,
-            C.Return $ C.Variable "SYS_ERR_OK"
+            C.Return binding_error
             ]
         umpvar = C.Cast (C.Ptr $ C.Struct $ my_bind_type p ifn) bindvar
         umpst = C.DerefField umpvar "ump_state"
         capst = umpst `C.FieldOf` "capst"
         tx_msgnum_field = C.DerefField bindvar "tx_msgnum"
         tx_msgfrag_field = C.DerefField bindvar "tx_msg_fragment"
+        binding_incoming_token = C.DerefField bindvar "incoming_token"
+        binding_outgoing_token = C.DerefField bindvar "outgoing_token"
 
 tx_vtbl :: UMPParams -> String -> [MessageDef] -> C.Unit
 tx_vtbl p ifn ml =
@@ -1141,13 +1228,18 @@ rx_handler p ifn typedefs msgdefs msgs =
         -- local variables
         localvar (C.Volatile $ C.Ptr $ C.Struct "ump_message") "msg" Nothing,
         localvar (C.TypeName "int") "msgnum" Nothing,
+        localvar (C.TypeName "int") "__attribute__ ((unused)) no_register" (Just $ C.NumConstant 0),
+        localvar (C.TypeName "int") "call_msgnum" $ Just $ C.NumConstant 0,
+
+        C.Ex $ C.Call "thread_mutex_lock" [C.AddressOf $ C.DerefField bindvar "rxtx_mutex"],
         C.SBlank,
 
         C.While (C.Variable "true") loopbody,
         C.SBlank,
 
         C.Label "out",
-        C.StmtList $ register_recv p ifn,
+        C.If (C.Unary C.Not (C.Variable "no_register"))
+            [C.StmtList $ register_recv p ifn] [],
         C.SBlank,
 
         -- XXX: hack around the AST to get an attribute on this label, which may not be used
@@ -1161,7 +1253,10 @@ rx_handler p ifn typedefs msgdefs msgs =
                    [C.Ex $ C.Call "flounder_stub_ump_send_ack" [stateaddr],
                     C.StmtList $ ump_notify p]
                    []
-             ]
+             ],
+        C.If (C.Variable "call_msgnum") [C.Ex $ C.Assignment rx_msgnum_field (C.NumConstant 0)] [],
+        C.Ex $ C.Call "thread_mutex_unlock" [C.AddressOf $ C.DerefField bindvar "rxtx_mutex"],
+        C.Switch (C.Variable "call_msgnum") call_cases [C.Break]
         ]
     where
         loopbody = [
@@ -1265,6 +1360,12 @@ rx_handler p ifn typedefs msgdefs msgs =
         rx_msgnum_field = C.DerefField bindvar "rx_msgnum"
         rx_msgfrag_field = C.DerefField bindvar "rx_msg_fragment"
 
+        call_cases = [C.Case (C.Variable $ msg_enum_elem_name ifn mn) (call_msgnum_case msgdef msg)
+                            | (msgdef, msg@(MsgSpec mn _ _)) <- zip msgdefs msgs]
+
+        call_msgnum_case msgdef@(Message mtype mn msgargs _) (MsgSpec _ frags caps) =
+            [C.StmtList $ call_handler (ump_drv p) ifn typedefs mtype mn msgargs, C.Break]
+
         msgnum_cases = [C.Case (C.Variable $ msg_enum_elem_name ifn mn) (msgnum_case msgdef msg)
                             | (msgdef, msg@(MsgSpec mn _ _)) <- zip msgdefs msgs]
 
@@ -1282,7 +1383,7 @@ rx_handler p ifn typedefs msgdefs msgs =
                             (capst `C.FieldOf` "rx_capnum") (C.NumConstant 0)
                         ] else [])
                        else []) ++
-                    (msgfrag_case msgdef frag caps (i == length frags - 1))
+                    (msgfrag_case msgdef frag caps (i == 0) (i == length frags - 1))
                  | (frag, i) <- zip frags [0..] ]
                 bad_msgfrag,
             C.Break]
@@ -1293,16 +1394,23 @@ rx_handler p ifn typedefs msgdefs msgs =
         bad_msgfrag = [report_user_err $ C.Variable "FLOUNDER_ERR_INVALID_STATE",
                       C.Goto "out"]
 
-        msgfrag_case :: MessageDef -> MsgFragment -> [CapFieldTransfer] -> Bool -> [C.Stmt]
-        msgfrag_case msg@(Message _ mn _ _) (MsgFragment wl) caps isLast = [
+        msgfrag_case :: MessageDef -> MsgFragment -> [CapFieldTransfer] -> Bool -> Bool -> [C.Stmt]
+        msgfrag_case msg@(Message _ mn _ _) (MsgFragment wl) caps isFirst isLast = [
             C.StmtList $ concat [store_arg_frags (ump_arch p) ifn mn msgdata word 0 afl
                                  | (afl, word) <- zip wl [0..]],
+            (if isFirst then C.Ex $ C.Assignment binding_incoming_token ump_token else C.SBlank),
             C.SBlank,
             C.StmtList $ msgfrag_case_prolog msg caps isLast,
-            C.Break]
+            C.Goto "out"]
+            where
+                ump_token = C.Variable "msg" `C.DerefField` "header" `C.FieldOf` "control" `C.FieldOf` "token"
+                umpst = C.DerefField my_bindvar "ump_state"
+                chanst = C.AddressOf umpst
+                binding_incoming_token = C.DerefField bindvar "incoming_token"
 
-        msgfrag_case msg@(Message _ mn _ _) (OverflowFragment (StringFragment af)) caps isLast = [
+        msgfrag_case msg@(Message _ mn _ _) (OverflowFragment (StringFragment af)) caps isFirst isLast = [
             C.Ex $ C.Assignment errvar (C.Call "flounder_stub_ump_recv_string" args),
+            (if isFirst then C.Ex $ C.Assignment binding_incoming_token ump_token else C.SBlank),
             C.If (C.Call "err_is_ok" [errvar])
                 (msgfrag_case_prolog msg caps isLast)
                 -- error from string receive code, check if it's permanent
@@ -1314,13 +1422,18 @@ rx_handler p ifn typedefs msgdefs msgs =
                 ],
             C.Break]
             where
-                args = [msg_arg, string_arg, pos_arg, len_arg]
+                args = [msg_arg, string_arg, pos_arg, len_arg, max_size]
                 msg_arg = C.Variable "msg"
-                string_arg = C.AddressOf $ argfield_expr RX mn af
+                string_arg = argfield_expr RX mn af
                 pos_arg = C.AddressOf $ C.DerefField bindvar "rx_str_pos"
                 len_arg = C.AddressOf $ C.DerefField bindvar "rx_str_len"
+                ump_token = C.Variable "msg" `C.DerefField` "header" `C.FieldOf` "control" `C.FieldOf` "token"
+                umpst = C.DerefField my_bindvar "ump_state"
+                chanst = C.AddressOf umpst
+                binding_incoming_token = C.DerefField bindvar "incoming_token"
+                max_size = C.SizeOf $ string_arg
 
-        msgfrag_case msg@(Message _ mn _ _) (OverflowFragment (BufferFragment _ afn afl)) caps isLast = [
+        msgfrag_case msg@(Message _ mn _ _) (OverflowFragment (BufferFragment _ afn afl)) caps isFirst isLast = [
             C.Ex $ C.Assignment errvar (C.Call "flounder_stub_ump_recv_buf" args),
             C.If (C.Call "err_is_ok" [errvar])
                 (msgfrag_case_prolog msg caps isLast)
@@ -1333,11 +1446,16 @@ rx_handler p ifn typedefs msgdefs msgs =
                 ],
             C.Break]
             where
-                args = [msg_arg, buf_arg, len_arg, pos_arg]
+                args = [msg_arg, buf_arg, len_arg, pos_arg, max_size]
                 msg_arg = C.Variable "msg"
-                buf_arg = C.Cast (C.Ptr $ C.Ptr C.Void) $ C.AddressOf $ argfield_expr RX mn afn
+                buf_arg = C.Cast (C.Ptr C.Void) $ argfield_expr RX mn afn
                 len_arg = C.AddressOf $ argfield_expr RX mn afl
                 pos_arg = C.AddressOf $ C.DerefField bindvar "rx_str_pos"
+                ump_token = C.Variable "msg" `C.DerefField` "header" `C.FieldOf` "control" `C.FieldOf` "token"
+                umpst = C.DerefField my_bindvar "ump_state"
+                chanst = C.AddressOf umpst
+                binding_incoming_token = C.DerefField bindvar "incoming_token"
+                max_size = C.SizeOf $ argfield_expr RX mn afn
 
 
         msgfrag_case_prolog :: MessageDef -> [CapFieldTransfer] -> Bool -> [C.Stmt]
@@ -1346,16 +1464,19 @@ rx_handler p ifn typedefs msgdefs msgs =
 
         -- last fragment: call handler and zero message number
         -- if we're expecting any caps, only do so if we've received them all
-        msgfrag_case_prolog (Message _ mn msgargs _) caps True
-            | caps == [] = finished_recv (ump_drv p) ifn typedefs mn msgargs
+        msgfrag_case_prolog (Message mtype mn msgargs _) caps True
+            | caps == [] = call_callback
             | otherwise = [
                 rx_fragment_increment,
                 C.If (C.Binary C.Equals
                                     (capst `C.FieldOf` "rx_capnum")
                                     (C.NumConstant $ toInteger $ length caps))
-                    (finished_recv (ump_drv p) ifn typedefs mn msgargs)
+                    call_callback
                     [C.SComment "don't process anything else until we're done",
                      C.Goto "out_no_reregister"]]
+             where
+                call_callback = [C.StmtList $ finished_recv_nocall (ump_drv p) ifn typedefs mtype mn msgargs, C.Goto "out"]
+                ump_chan = C.AddressOf $ statevar `C.FieldOf` "chan"
 
         rx_fragment_increment
             = C.Ex $ C.PostInc $ C.DerefField bindvar "rx_msg_fragment"
@@ -1368,12 +1489,15 @@ cap_rx_handler p ifn typedefs msgdefs msgspecs
          C.Param (C.Struct "capref") "cap",
          C.Param (C.TypeName "uint32_t") "capid"]
         [handler_preamble p ifn,
+        localvar (C.TypeName "int") "call_msgnum" $ Just $ C.NumConstant 0,
+        localvar (C.TypeName "int") "__attribute__ ((unused)) no_register" (Just $ C.NumConstant 0),
 
          C.Ex $ C.Call "assert" [C.Binary C.Equals
                                        (C.Variable "capid")
                                        (capst `C.FieldOf` "rx_capnum")],
          C.SBlank,
 
+         C.Ex $ C.Call "thread_mutex_lock" [C.AddressOf $ C.DerefField bindvar "rxtx_mutex"],
          C.SComment "Check if there's an associated error",
          C.SComment "FIXME: how should we report this to the user? at present we just deliver a NULL capref",
          C.If (C.Call "err_is_fail" [C.Variable "success"])
@@ -1386,7 +1510,10 @@ cap_rx_handler p ifn typedefs msgdefs msgspecs
          C.Switch (C.DerefField bindvar "rx_msgnum") cases
             [C.Ex $ C.Call "assert"
                     [C.Unary C.Not $ C.StringConstant "invalid message number"],
-             report_user_err (C.Variable "FLOUNDER_ERR_INVALID_STATE")]
+             report_user_err (C.Variable "FLOUNDER_ERR_INVALID_STATE")],
+        C.If (C.Variable "call_msgnum") [C.Ex $ C.Assignment rx_msgnum_field (C.NumConstant 0)] [],
+        C.Ex $ C.Call "thread_mutex_unlock" [C.AddressOf $ C.DerefField bindvar "rxtx_mutex"],
+        C.Switch (C.Variable "call_msgnum") call_cases [C.Break]
         ]
     where
         umpst = C.DerefField my_bindvar "ump_state"
@@ -1394,9 +1521,15 @@ cap_rx_handler p ifn typedefs msgdefs msgspecs
         cases = [C.Case (C.Variable $ msg_enum_elem_name ifn mn)
                         (cap_rx_handler_case p ifn typedefs mn msgdef (length frags) caps)
                  | (MsgSpec mn frags caps, msgdef) <- zip msgspecs msgdefs, caps /= []]
+        rx_msgnum_field = C.DerefField bindvar "rx_msgnum"
+        call_cases = [C.Case (C.Variable $ msg_enum_elem_name ifn mn) (call_msgnum_case msgdef msg)
+                            | (msgdef, msg@(MsgSpec mn _ _)) <- zip msgdefs msgspecs]
+
+        call_msgnum_case msgdef@(Message mtype mn msgargs _) (MsgSpec _ frags caps) =
+            [C.StmtList $ call_handler (ump_drv p) ifn typedefs mtype mn msgargs, C.Break]
 
 cap_rx_handler_case :: UMPParams -> String -> [TypeDef] -> String -> MessageDef -> Int -> [CapFieldTransfer] -> [C.Stmt]
-cap_rx_handler_case p ifn typedefs mn (Message _ _ msgargs _) nfrags caps = [
+cap_rx_handler_case p ifn typedefs mn (Message mtype _ msgargs _) nfrags caps = [
     C.SComment "Switch on current incoming cap",
     C.Switch (C.PostInc $ capst `C.FieldOf` "rx_capnum") cases
             [C.Ex $ C.Call "assert"
@@ -1416,14 +1549,18 @@ cap_rx_handler_case p ifn typedefs mn (Message _ _ msgargs _) nfrags caps = [
                 -- if this was the last cap, and we've received all the other fragments, we're done
                 C.If (C.Binary C.Equals rx_msgfrag_field (C.NumConstant $ toInteger nfrags))
                     [
-                        C.StmtList $ finished_recv (ump_drv p) ifn typedefs mn msgargs,
-                        C.StmtList $ register_recv p ifn
+                        C.StmtList $ finished_recv_nocall (ump_drv p) ifn typedefs mtype mn msgargs,
+                        C.If (C.Unary C.Not (C.Variable "no_register"))
+                            [C.StmtList $ register_recv p ifn] [],
+                        C.SBlank
                     ] []
                 else C.StmtList [],
             C.Break]
             where
                 rx_msgfrag_field = C.DerefField bindvar "rx_msg_fragment"
                 is_last = (ncap + 1 == length caps)
+                statevar = C.DerefField my_bindvar "ump_state"
+                ump_chan = C.AddressOf $ statevar `C.FieldOf` "chan"
 
 -- generate the code to register for receive notification
 register_recv :: UMPParams -> String -> [C.Stmt]