Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Use pony_alloc_msg to allocate method argument structs. #73

Merged
merged 2 commits into from
Feb 5, 2015
Merged

Use pony_alloc_msg to allocate method argument structs. #73

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
fb18bea
remove warnings
Feb 5, 2015
373c95b
Use `pony_alloc_msg` to allocate method argument structs.
Feb 5, 2015
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
65 changes: 50 additions & 15 deletions src/back/CodeGen/CCodeNames.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,25 +17,60 @@ import Types as Ty
import CCode.Main
import Data.Char


char :: CCode Ty
char = Typ "char"

int :: CCode Ty
int = Typ "int64_t"

uint :: CCode Ty
uint = Typ "uint64_t"

bool :: CCode Ty
bool = Typ "int64_t" -- For pony argument tag compatibility. Should be changed to something smaller

double :: CCode Ty
double = Typ "double"

void :: CCode Ty
void = Typ "void"

encore_actor_t :: CCode Ty
encore_actor_t = Typ "encore_actor_t"

pony_type_t :: CCode Ty
pony_type_t = Typ "pony_type_t"

pony_actor_t :: CCode Ty
pony_actor_t = Typ "pony_actor_t"

pony_actor_type_t :: CCode Ty
pony_actor_type_t = Typ "pony_actor_type_t"

pony_arg_t :: CCode Ty
pony_arg_t = Typ "pony_arg_t"

pony_msg_t :: CCode Ty
pony_msg_t = Typ "pony_msg_t"

enc_msg_t :: CCode Ty
enc_msg_t = Typ "encore_fut_msg_t"

enc_oneway_msg_t :: CCode Ty
enc_oneway_msg_t = Typ "encore_oneway_msg_t"

closure :: CCode Ty
closure = Ptr $ Typ "closure_t"

future :: CCode Ty
future = Ptr $ Typ "future_t"

stream :: CCode Ty
stream = Ptr $ Typ "stream_t"

unit :: CCode Lval
unit = Embed "UNIT"
unit = Embed "UNIT"

-- | each method is implemented as a function with a `this`
-- pointer. This is the name of that function
Expand All @@ -48,7 +83,7 @@ global_closure_name funname =
Nam $ (show funname)

global_function_name :: ID.Name -> CCode Name
global_function_name funname =
global_function_name funname =
Nam $ "_enc__global_" ++ (show funname) ++ "_fun"

closure_fun_name :: String -> CCode Name
Expand Down Expand Up @@ -76,39 +111,39 @@ class_trace_fn_name :: Ty.Type -> CCode Name
class_trace_fn_name clazz = Nam $ "_enc__" ++ Ty.getId clazz ++ "_trace"

method_message_type_name :: Ty.Type -> ID.Name -> CCode Lval --fixme should be a name
method_message_type_name cls mname =
method_message_type_name cls mname =
Var $ "_ENC__FUT_MSG_" ++ Ty.getId cls ++ "_" ++ show mname

one_way_message_type_name :: Ty.Type -> ID.Name -> CCode Lval --fixme should be a name
one_way_message_type_name cls mname =
Var $ "_ENC__ONE_WAY_MSG_" ++ Ty.getId cls ++ "_" ++ show mname
one_way_message_type_name cls mname =
Var $ "_ENC__ONEWAY_MSG_" ++ Ty.getId cls ++ "_" ++ show mname

-- | for each method, there's a corresponding message, this is its name
method_msg_name :: Ty.Type -> ID.Name -> CCode Name
method_msg_name cls mname =
Nam $ "_ENC__MSG_" ++ Ty.getId cls ++ "_" ++ show mname
method_msg_name cls mname =
Nam $ "_ENC__FUT_MSG_" ++ Ty.getId cls ++ "_" ++ show mname

one_way_send_msg_name :: Ty.Type -> ID.Name -> CCode Name
one_way_send_msg_name cls mname =
Nam $ "_ENC__ONE_WAY_MSG_" ++ Ty.getId cls ++ "_" ++ show mname
one_way_send_msg_name cls mname =
Nam $ "_ENC__ONEWAY_MSG_" ++ Ty.getId cls ++ "_" ++ show mname

class_type_name :: Ty.Type -> CCode Name
class_type_name cls
class_type_name cls
| Ty.isActiveRefType cls =
Nam $ "_enc__active_" ++ Ty.getId cls ++ "_t"
| Ty.isPassiveRefType cls =
Nam $ "_enc__passive_" ++ Ty.getId cls ++ "_t"
| otherwise = error $ "Type '" ++ show cls ++
"' is neither active nor passive!"
| otherwise = error $ "Type '" ++ show cls ++
"' is neither active nor passive!"

runtime_type_name :: Ty.Type -> CCode Name
runtime_type_name cls
runtime_type_name cls
| Ty.isActiveRefType cls =
Nam $ "_enc__active_" ++ Ty.getId cls ++ "_type"
| Ty.isPassiveRefType cls =
Nam $ "_enc__passive_" ++ Ty.getId cls ++ "_type"
| otherwise = error $ "Type '" ++ show cls ++
"' is neither active nor passive!"
| otherwise = error $ "Type '" ++ show cls ++
"' is neither active nor passive!"

future_type_rec_name :: CCode Name
future_type_rec_name = Nam $ "future_type"
Expand Down
17 changes: 6 additions & 11 deletions src/back/CodeGen/Expr.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -178,7 +178,7 @@ instance Translatable A.Expr (State Ctx.Context (CCode Lval, CCode Stat)) where
return (Var tmp, Seq [ttarg,
(Assign (Decl (translate (A.getType acc), Var tmp)) (Deref ntarg `Dot` (Nam $ show name)))])

translate l@(A.Let {A.decls, A.body}) = do
translate (A.Let {A.decls, A.body}) = do
do
tmps_tdecls <- mapM translate_decl decls
let (tmps, tdecls) = unzip tmps_tdecls
Expand All @@ -197,7 +197,7 @@ instance Translatable A.Expr (State Ctx.Context (CCode Lval, CCode Stat)) where
, te
, Assign (Decl (translate (A.getType expr), Var tmp)) ne])

translate new@(A.New {A.ty})
translate (A.New {A.ty})
| Ty.isActiveRefType ty =
named_tmp_var "new" ty $
Cast (Ptr . AsType $ class_type_name ty)
Expand Down Expand Up @@ -227,7 +227,6 @@ instance Translatable A.Expr (State Ctx.Context (CCode Lval, CCode Stat)) where
remote_call =
do (ntarget, ttarget) <- translate target
targs <- mapM varaccess_this_to_aref args
let targtys = map (translate . A.getType) args :: [CCode Ty]
the_fut_name <- if Ty.isStreamType $ A.getType call then
Ctx.gen_named_sym "stream"
else
Expand All @@ -241,7 +240,7 @@ instance Translatable A.Expr (State Ctx.Context (CCode Lval, CCode Stat)) where
(Call (Nam "future_mk") ([runtime_type . Ty.getResultType . A.getType $ call]))
the_arg_name <- Ctx.gen_named_sym "arg"
let the_arg_ty = (Typ $ "___encore_"++(show (A.getType target)++"_"++(show name)++"_fut_msg")) :: CCode Ty
let the_arg_decl = EmbedC (Decl (the_arg_ty, Var the_arg_name))
let the_arg_decl = Assign (Decl (the_arg_ty, Var the_arg_name)) (Call (Nam "pony_alloc_msg") [Int 0, AsExpr $ method_message_type_name (A.getType target) name])
let no_args = length args
let arg_assignments = zipWith (\i tmp_expr -> Assign (Dot (Var the_arg_name) (Nam $ "f"++show i)) tmp_expr) [1..no_args] targs
let the_arg_init = Seq $ map Statement arg_assignments
Expand Down Expand Up @@ -270,22 +269,18 @@ instance Translatable A.Expr (State Ctx.Context (CCode Lval, CCode Stat)) where
message_send =
do ttarget <- varaccess_this_to_aref target
targs <- mapM varaccess_this_to_aref args
let targtys = map (translate . A.getType) args :: [CCode Ty]
the_arg_name <- Ctx.gen_named_sym "arg"
let the_arg_decl' = Assign
(Decl (Typ "pony_arg_t", ArrAcc (1 + length args) (Var the_arg_name)))
(Record ((map (\(arg, ty) -> UnionInst (pony_arg_t_tag ty) arg)
(zip targs targtys)) :: [CCode Expr]))
let the_arg_ty = (Typ $ "___encore_"++(show (A.getType target)++"_"++(show name)++"_fut_msg")) :: CCode Ty
let the_arg_decl = EmbedC (Decl (the_arg_ty, Var the_arg_name))
let no_args = length args
let arg_assignments = zipWith (\i tmp_expr -> Assign (Dot (Var the_arg_name) (Nam $ "f"++show i)) tmp_expr) [1..no_args] targs
let the_arg_init = Seq $ map Statement arg_assignments

the_call <- return (Call (Nam "pony_sendv")
[ttarget,
AsExpr . AsLval $ one_way_send_msg_name (A.getType target) name,
Int $ length args,
AsExpr $ Var the_arg_name])
let the_arg_ty = (Typ $ "___encore_"++(show (A.getType target)++"_"++(show name)++"_oneway_msg")) :: CCode Ty
let the_arg_decl = Assign (Decl (the_arg_ty, Var the_arg_name)) (Call (Nam "pony_alloc_msg") [Int 0, AsExpr $ one_way_message_type_name (A.getType target) name])
return (unit,
Seq ((Comm "message send") :
the_arg_decl :
Expand Down