1%include polycode.fmt 2 3%if false 4 Flounder2: an even more simpler IDL for Barrelfish 5 6 Copyright (c) 2009 ETH Zurich. 7 All rights reserved. 8 9 This file is distributed under the terms in the attached LICENSE file. 10 If you do not find this file, copies can be found by writing to: 11 ETH Zurich D-INFK, Haldeneggsteig 4, CH-8092 Zurich. Attn: Systems Group. 12%endif 13 14 15\section{General Functions for Back-ends} 16 17 18In this module, we define some general functions. These functions are 19used in both Code and Header back-ends. They are quite simple, so we 20can afford to present them out of their context. 21 22 23> module Backend where 24 25%if false 26 27> import Data.List 28 29> import Syntax 30 31%endif 32 33 34\subsection{The Preamble} 35 36In both cases, we will have to emit a long, tedious copyright 37notice. So, here it is done once and for all. 38 39> preamble :: Interface -> String -> String 40> preamble interface filename = 41> let name = 42> case interface of 43> Interface _ (Just desc) _ -> desc 44> _ -> "" 45> in 46> {-" \mbox{and so on\ldots} "-} 47 48%if false 49 50> "/*\n * Interface Definition: " ++ name ++ "\n\ 51> \ * Generated from: " ++ filename ++ "\n\ 52> \ * \n\ 53> \ * Copyright (c) 2009, ETH Zurich.\n\ 54> \ * All rights reserved.\n\ 55> \ * \n\ 56> \ * This file is distributed under the terms in the attached LICENSE\n\ 57> \ * file. If you do not find this file, copies can be found by\n\ 58> \ * writing to:\n\ 59> \ * ETH Zurich D-INFK, Haldeneggsteig 4, CH-8092 Zurich.\n\ 60> \ * Attn: Systems Group.\n\ 61> \ * \n\ 62> \ * THIS FILE IS AUTOMATICALLY GENERATED: DO NOT EDIT!\n\ 63> \ */\n\n" 64 65%endif 66 67 68\subsection{Dealing with Namespace Issues} 69 70 71In order to avoid name clashes, we qualify type names with the 72interface name, excepted when it is a built-in type. 73 74> qualifyName :: String -> TypeRef -> String 75> qualifyName interfaceName (Builtin t) = show t 76> qualifyName interfaceName (TypeVar t) = interfaceName ++ "_" ++ t 77> qualifyName interfaceName (TypeAlias t _) = interfaceName ++ "_" ++ t 78 79When we are declarating real C types, we have to add a @_t@ at the 80end. 81 82> qualifyType :: String -> TypeRef -> String 83> qualifyType qualifier (Builtin String) = "char *" 84> qualifyType qualifier (TypeAlias name _) = name ++ "_t" 85> qualifyType qualifier typeDef = 86> qualifyName qualifier typeDef ++ "_t" 87 88When we are generating stubs, we will need to qualify exported procedures: 89@qualifyProcName@ corresponds to the interface namespace, along with a 90@_fn@ specifier. 91 92> qualifyProcName :: String -> TypeRef -> String 93> qualifyProcName interfaceName typeDef = 94> qualifyName interfaceName typeDef ++ "_fn" 95 96 97\subsection{Dealing with Declarations} 98 99 100Often (always), we treat types and messages separately. Hence, 101@partitionTypesMessages@ takes a list of declarations and partitions 102it into two lists: one containing the type declarations, the other 103containing the message declarations. 104 105> partitionTypesMessages :: [Declaration] -> ([TypeDef], [MessageDef]) 106> partitionTypesMessages declarations = 107> let (types, messages) = foldl' typeFilter ([],[]) declarations in 108> (types, reverse messages) 109> where typeFilter (types, messages) (Messagedef m) = (types, m : messages) 110> typeFilter (types, messages) (Typedef t) = (t : types, messages) 111 112 113\subsection{Dealing with Messages} 114 115 116Messages can either go Forward or Backward: 117 118> data MessageClass = Forward 119> | Backward 120 121This defines the following relation: 122 123> isForward, isBackward :: MessageDef -> Bool 124> isForward (Message MResponse _ _ _) = False 125> isForward _ = True 126> isBackward (Message MCall _ _ _) = False 127> isBackward _ = True 128 129The distinction between \emph{service} and \emph{client} handler 130stands in the type of the closure response: one is typed for the 131\emph{service} closure, the other for the \emph{client} closure. This 132difference is materialized by the following data-type: 133 134> data Side = ServerSide 135> | ClientSide 136 137> instance Show Side where 138> show ServerSide = "service" 139> show ClientSide = "client" 140 141 142To compile the list of arguments of messages, we use: 143 144> compileCommonDefinitionArgs :: String -> Side -> MessageDef -> [(String,String)] 145> compileCommonDefinitionArgs interfaceName side message@(Message _ _ messageArgs _) = 146> [("struct " ++ interfaceName ++ "_" ++ show side ++ "_response *", "st")] 147> ++ [(constType typeArg ++ " " ++ qualifyType interfaceName typeArg, nameOf arg) 148> | Arg typeArg arg <- messageArgs ] 149 150> compileRPCDefinitionArgs :: String -> [RPCArgument] -> [(String,String)] 151> compileRPCDefinitionArgs interfaceName rpcArgs = 152> ("struct " ++ interfaceName ++ "_client_response *", "st" ) : 153> [ case messageArg of 154> RPCArgIn typeArg arg -> 155> (constType typeArg ++ " " 156> ++ qualifyType interfaceName typeArg, 157> nameOf arg) 158> RPCArgOut typeArg arg -> 159> (qualifyType interfaceName typeArg ++ "*", 160> nameOf arg) 161> | messageArg <- rpcArgs ] 162 163Where \verb!const! adds a const type modifier for pointers that should 164not be modified. 165 166> constType :: TypeRef -> String 167> constType (Builtin String) = "const" 168> constType _ = "" 169 170 171 172\subsection{Dealing with Dynamic Arrays} 173 174 175When we manipulate dynamic arrays, we might just need the name of the 176array, without its associated length bound. 177 178> nameOf :: Variable -> String 179> nameOf (Name s) = s 180> nameOf (DynamicArray s _ _) = s 181 182 183Conversely, when marshaling or unmarshaling dynamic arrays, we need to 184pass the @length@ parameter. 185 186> listOfArgs :: String -> Variable -> String 187> listOfArgs dereference (Name s) = dereference ++ s 188> listOfArgs dereference (DynamicArray name length _) = dereference ++ name ++ ", " ++ length 189 190 191> callNameOf :: MessageDef -> String 192> callNameOf (Message _ messageName _ _) = messageName 193> callNameOf (RPC name _ _) = name 194