X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fcmm%2FCmmParse.y;h=73618bc35bd8e3ba87360e1d9d216ed6ef01cbe7;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=e81d34c28662d28edf52bca496841c9c9a27dd4c;hpb=0c53bd0e1b02dea0bde32cd7eb8ccb5ee2d3719e;p=ghc-hetmet.git

diff --git a/ghc/compiler/cmm/CmmParse.y b/ghc/compiler/cmm/CmmParse.y
index e81d34c..73618bc 100644
--- a/ghc/compiler/cmm/CmmParse.y
+++ b/ghc/compiler/cmm/CmmParse.y
@@ -32,7 +32,7 @@ import MachOp
 import SMRep		( fixedHdrSize, CgRep(..) )
 import Lexer
 
-import ForeignCall	( CCallConv(..) )
+import ForeignCall	( CCallConv(..), Safety(..) )
 import Literal		( mkMachInt )
 import Unique
 import UniqFM
@@ -48,6 +48,7 @@ import Constants	( wORD_SIZE )
 import Outputable
 
 import Monad		( when )
+import Data.Char	( ord )
 
 #include "HsVersions.h"
 }
@@ -177,7 +178,7 @@ static 	:: { ExtFCode [CmmStatic] }
 			     return [CmmStaticLit (getLit e)] }
 	| type ';'			{ return [CmmUninitialised
 							(machRepByteWidth $1)] }
-        | 'bits8' '[' ']' STRING ';'	{ return [CmmString $4] }
+        | 'bits8' '[' ']' STRING ';'	{ return [mkString $4] }
         | 'bits8' '[' INT ']' ';'	{ return [CmmUninitialised 
 							(fromIntegral $3)] }
         | typenot8 '[' INT ']' ';'	{ return [CmmUninitialised 
@@ -295,6 +296,7 @@ bool_op :: { ExtFCode BoolExpr }
 -- This is not C-- syntax.  What to do?
 vols 	:: { Maybe [GlobalReg] }
 	: {- empty -}			{ Nothing }
+	| '[' ']'		        { Just [] }
 	| '[' globals ']'		{ Just $2 }
 
 globals :: { [GlobalReg] }
@@ -426,6 +428,9 @@ section "rodata" = ReadOnlyData
 section "bss"	 = UninitialisedData
 section s	 = OtherSection s
 
+mkString :: String -> CmmStatic
+mkString s = CmmString (map (fromIntegral.ord) s)
+
 -- mkMachOp infers the type of the MachOp from the type of its first
 -- argument.  We assume that this is correct: for MachOps that don't have
 -- symmetrical args (e.g. shift ops), the first arg determines the type of
@@ -459,8 +464,10 @@ exprOp name args_code =
 exprMacros :: UniqFM ([CmmExpr] -> CmmExpr)
 exprMacros = listToUFM [
   ( FSLIT("ENTRY_CODE"),   \ [x] -> entryCode x ),
-  ( FSLIT("GET_ENTRY"),    \ [x] -> entryCode (closureInfoPtr x) ),
+  ( FSLIT("INFO_PTR"),     \ [x] -> closureInfoPtr x ),
   ( FSLIT("STD_INFO"),     \ [x] -> infoTable x ),
+  ( FSLIT("FUN_INFO"),     \ [x] -> funInfoTable x ),
+  ( FSLIT("GET_ENTRY"),    \ [x] -> entryCode (closureInfoPtr x) ),
   ( FSLIT("GET_STD_INFO"), \ [x] -> infoTable (closureInfoPtr x) ),
   ( FSLIT("GET_FUN_INFO"), \ [x] -> funInfoTable (closureInfoPtr x) ),
   ( FSLIT("INFO_TYPE"),    \ [x] -> infoTableClosureType x ),
@@ -727,7 +734,8 @@ foreignCall "C" results_code expr_code args_code vols
 	results <- sequence results_code
 	expr <- expr_code
 	args <- sequence args_code
-	stmtEC (CmmCall (CmmForeignCall expr CCallConv) results args vols)
+        code (emitForeignCall' PlayRisky results 
+                 (CmmForeignCall expr CCallConv) args vols)
 foreignCall conv _ _ _ _
   = fail ("unknown calling convention: " ++ conv)