- -- get the return register
- let ret_reg ([CmmHinted reg hint]) = (reg, hint)
- ret_reg t = panic $ "genCall: Bad number of registers! Can only handle"
- ++ " 1, given " ++ show (length t) ++ "."
-
- -- deal with call types
- let getFunPtr :: CmmCallTarget -> UniqSM ExprData
- getFunPtr targ = case targ of
- CmmCallee (CmmLit (CmmLabel lbl)) _ -> do
- let name = strCLabel_llvm lbl
- case funLookup name env1 of
- Just ty'@(LMFunction sig) -> do
- -- Function in module in right form
- let fun = LMGlobalVar name ty' (funcLinkage sig)
- Nothing Nothing False
- return (env1, fun, nilOL, [])
-
- Just ty' -> do
- -- label in module but not function pointer, convert
- let fty@(LMFunction sig) = funTy name
- let fun = LMGlobalVar name (pLift ty') (funcLinkage sig)
- Nothing Nothing False
- (v1, s1) <- doExpr (pLift fty)
- $ Cast LM_Bitcast fun (pLift fty)
- return (env1, v1, unitOL s1, [])
-
- Nothing -> do
- -- label not in module, create external reference
- let fty@(LMFunction sig) = funTy name
- let fun = LMGlobalVar name fty (funcLinkage sig)
- Nothing Nothing False
- let top = CmmData Data [([],[fty])]
- let env' = funInsert name fty env1
- return (env', fun, nilOL, [top])
-
- CmmCallee expr _ -> do
- (env', v1, stmts, top) <- exprToVar env1 expr
- let fty = funTy $ fsLit "dynamic"
- let cast = case getVarType v1 of
- ty | isPointer ty -> LM_Bitcast
- ty | isInt ty -> LM_Inttoptr
-
- ty -> panic $ "genCall: Expr is of bad type for function"
- ++ " call! (" ++ show (ty) ++ ")"
-
- (v2,s1) <- doExpr (pLift fty) $ Cast cast v1 (pLift fty)
- return (env', v2, stmts `snocOL` s1, top)
-
- CmmPrim mop -> do
- let name = cmmPrimOpFunctions mop
- let lbl = mkForeignLabel name Nothing
- ForeignLabelInExternalPackage IsFunction
- getFunPtr $ CmmCallee (CmmLit (CmmLabel lbl)) CCallConv
-
- (env2, fptr, stmts2, top2) <- getFunPtr target