X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fgenapply%2FGenApply.hs;h=d9e6041a61327a840410a8b8837b1d76167067a9;hb=d05212cf8475778cf41758c04f4eee510ae47e98;hp=c42ccb181a1f287e33ad6d66485a5d810a0afece;hpb=6015a94f9108a502150565577b66c23650796639;p=ghc-hetmet.git

diff --git a/utils/genapply/GenApply.hs b/utils/genapply/GenApply.hs
index c42ccb1..d9e6041 100644
--- a/utils/genapply/GenApply.hs
+++ b/utils/genapply/GenApply.hs
@@ -1,9 +1,15 @@
 {-# OPTIONS -cpp -fglasgow-exts #-}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
 module Main(main) where
 
 #include "../../includes/ghcconfig.h"
-#include "../../includes/MachRegs.h"
-#include "../../includes/Constants.h"
+#include "../../includes/stg/MachRegs.h"
+#include "../../includes/rts/Constants.h"
 
 -- Needed for TAG_BITS
 #include "../../includes/MachDeps.h"
@@ -420,12 +426,12 @@ 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
+formalParamType arg = argRep arg
 
 argRep F = text "F_"
 argRep D = text "D_"
 argRep L = text "L_"
+argRep P = text "gcptr"
 argRep _ = text "W_"
 
 genApply regstatus args =
@@ -461,10 +467,8 @@ genApply regstatus args =
 --        print "    [THUNK_STATIC]    &&thunk_lbl,"
 --        print "    [THUNK_SELECTOR]  &&thunk_lbl,"
 --        print "    [IND]	      &&ind_lbl,"
---        print "    [IND_OLDGEN]      &&ind_lbl,"
 --        print "    [IND_STATIC]      &&ind_lbl,"
 --        print "    [IND_PERM]	      &&ind_lbl,"
---        print "    [IND_OLDGEN_PERM] &&ind_lbl"
 --        print "  };"
     
        tickForArity (length args),
@@ -558,10 +562,8 @@ genApply regstatus args =
 --    else:
 	text "case AP,",
 	text "     AP_STACK,",
-	text "     CAF_BLACKHOLE,",
 	text "     BLACKHOLE,",
-	text "     SE_BLACKHOLE,",
-	text "     SE_CAF_BLACKHOLE,",
+	text "     WHITEHOLE,",
         text "     THUNK,",
         text "     THUNK_1_0,",
         text "     THUNK_0_1,",
@@ -586,10 +588,8 @@ genApply regstatus args =
 --        print "    ind_lbl:"
 --    else:
         text "case IND,",
-        text "     IND_OLDGEN,",
         text "     IND_STATIC,",
-        text "     IND_PERM,",
-        text "     IND_OLDGEN_PERM: {",
+        text "     IND_PERM: {",
 	nest 4 (vcat [
 	  text "R1 = StgInd_indirectee(R1);",
             -- An indirection node might contain a tagged pointer
@@ -602,7 +602,7 @@ genApply regstatus args =
 
        text "default: {",
        nest 4 (
-         text "foreign \"C\" barf(\"" <> fun_ret_label <> text "\");"
+         text "foreign \"C\" barf(\"" <> fun_ret_label <> text "\") never returns;"
        ),
        text "}"