#include "../../includes/Constants.h"
-#if __GLASGOW_HASKELL__ >= 504
import Text.PrettyPrint
import Data.Word
import Data.Bits
import System.Exit
import System.Environment
import System.IO
-#else
-import System
-import IO
-import Bits
-import Word
-import Pretty
-import List ( intersperse )
-#endif
-- -----------------------------------------------------------------------------
-- Argument kinds (rougly equivalent to PrimRep)
smaller_arity arity
= text "if (arity == " <> int arity <> text ") {" $$
nest 4 (vcat [
- text "TICK_SLOW_CALL_" <> text ticker <> text "_TOO_MANY();",
+ -- text "TICK_SLOW_CALL_" <> text ticker <> text "_TOO_MANY();",
-- load up regs for the call, if necessary
load_regs,
| otherwise = loadRegArgs regstatus stk_args_offset args
in
nest 4 (vcat [
- text "TICK_SLOW_CALL_" <> text ticker <> text "_CORRECT();",
+-- text "TICK_SLOW_CALL_" <> text ticker <> text "_CORRECT();",
reg_doc,
text "Sp_adj(" <> int sp' <> text ");",
if is_pap
empty
in
nest 4 (vcat [
- text "TICK_SLOW_CALL_" <> text ticker <> text "_TOO_FEW();",
+-- text "TICK_SLOW_CALL_" <> text ticker <> text "_TOO_FEW();",
save_regs,
text macro <> char '(' <> int n_args <> comma <>
int all_args_size <>
-- generate an apply function
-- args is a list of 'p', 'n', 'f', 'd' or 'l'
+formalParam :: ArgRep -> Int -> Doc
+formalParam V _ = empty
+formalParam arg n =
+ formalParamType arg <> space <>
+ text "arg" <> int n <> text ", "
+formalParamType arg | isPtr arg = text "\"ptr\"" <> space <> argRep arg
+ | otherwise = argRep arg
+
+argRep F = text "F_"
+argRep D = text "D_"
+argRep L = text "L_"
+argRep _ = text "W_"
genApply regstatus args =
let
in
vcat [
text "INFO_TABLE_RET(" <> mkApplyName args <> text ", " <>
- int all_args_size <> text "/*framsize*/," <>
- int (fromIntegral (mkBitmap args)) <> text "/*bitmap*/, " <>
- text "RET_SMALL)\n{",
+ text "RET_SMALL, " <> (cat $ zipWith formalParam args [1..]) <>
+ text ")\n{",
nest 4 (vcat [
text "W_ info;",
text "W_ arity;",
-- text "IF_DEBUG(sanity,checkStackChunk(Sp+" <> int (1 + all_args_size) <>
-- text ", CurrentTSO->stack + CurrentTSO->stack_size));",
- text "TICK_SLOW_CALL(" <> int (length args) <> text ");",
+-- text "TICK_SLOW_CALL(" <> int (length args) <> text ");",
let do_assert [] _ = []
do_assert (arg:args) offset
text " THUNK_STATIC,",
text " THUNK_SELECTOR: {",
nest 4 (vcat [
- text "TICK_SLOW_CALL_UNEVALD(" <> int (length args) <> text ");",
+-- text "TICK_SLOW_CALL_UNEVALD(" <> int (length args) <> text ");",
text "Sp(0) = " <> fun_info_label <> text ";",
-- CAREFUL! in SMP mode, the info table may already have been
-- overwritten by an indirection, so we must enter the original