add a comment
[ghc.git] / compiler / cmm / CmmParse.y
index dee5c7d..8033330 100644 (file)
@@ -89,6 +89,19 @@ High-level only:
   - pushing stack frames:
     push (info_ptr, field1, ..., fieldN) { ... statements ... }
 
+  - reserving temporary stack space:
+
+      reserve N = x { ... }
+
+    this reserves an area of size N (words) on the top of the stack,
+    and binds its address to x (a local register).  Typically this is
+    used for allocating temporary storage for passing to foreign
+    functions.
+
+    Note that if you make any native calls or invoke the GC in the
+    scope of the reserve block, you are responsible for ensuring that
+    the stack you reserved is laid out correctly with an info table.
+
 Low-level only:
 
   - References to Sp, R1-R8, F1-F4 etc.
@@ -122,9 +135,9 @@ be anything at all.
 If a low-level procedure implements the NativeNode calling convention,
 then it can be called by high-level code using an ordinary function
 call.  In general this is hard to arrange because the calling
-convention depends on the number of physical register available for
+convention depends on the number of physical registers available for
 parameter passing, but there are two cases where the calling
-convention is platform-independnt:
+convention is platform-independent:
 
  - Zero arguments.
 
@@ -187,7 +200,7 @@ convention.
 -- 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
+--     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
 -- for details
 
 module CmmParse ( parseCmmFile ) where
@@ -208,6 +221,7 @@ import StgCmmLayout     hiding (ArgRep(..))
 import StgCmmTicky
 import StgCmmBind       ( emitBlackHoleCode, emitUpdateFrame )
 
+import CmmOpt
 import MkGraph
 import Cmm
 import CmmUtils
@@ -302,6 +316,7 @@ import Data.Maybe
         'foreign'       { L _ (CmmT_foreign) }
         'never'         { L _ (CmmT_never) }
         'prim'          { L _ (CmmT_prim) }
+        'reserve'       { L _ (CmmT_reserve) }
         'return'        { L _ (CmmT_return) }
         'returns'       { L _ (CmmT_returns) }
         'import'        { L _ (CmmT_import) }
@@ -558,7 +573,7 @@ importName
 
         -- A label imported with an explicit packageId.
         | STRING NAME
-        { ($2, mkCmmCodeLabel (fsToPackageId (mkFastString $1)) $2) }
+        { ($2, mkCmmCodeLabel (fsToPackageKey (mkFastString $1)) $2) }
         
         
 names   :: { [FastString] }
@@ -614,6 +629,8 @@ stmt    :: { CmmParse () }
                 { cmmIfThenElse $2 $4 $6 }
         | 'push' '(' exprs0 ')' maybe_body
                 { pushStackFrame $3 $5 }
+        | 'reserve' expr '=' lreg maybe_body
+                { reserveStackFrame $2 $4 $5 }
 
 foreignLabel     :: { CmmParse CmmExpr }
         : NAME                          { return (CmmLit (CmmLabel (mkForeignLabel $1 Nothing ForeignLabelInThisPackage IsFunction))) }
@@ -952,8 +969,16 @@ callishMachOps = listToUFM $
         ( "write_barrier", MO_WriteBarrier ),
         ( "memcpy", MO_Memcpy ),
         ( "memset", MO_Memset ),
-        ( "memmove", MO_Memmove )
+        ( "memmove", MO_Memmove ),
+
+        ("prefetch0",MO_Prefetch_Data 0),
+        ("prefetch1",MO_Prefetch_Data 1),
+        ("prefetch2",MO_Prefetch_Data 2),
+        ("prefetch3",MO_Prefetch_Data 3)
+
         -- ToDo: the rest, maybe
+        -- edit: which rest?
+        -- also: how do we tell CMM Lint how to type check callish macops?
     ]
 
 parseSafety :: String -> P Safety
@@ -1052,13 +1077,31 @@ pushStackFrame fields body = do
   emit g
   withUpdFrameOff new_updfr_off body
 
+reserveStackFrame
+  :: CmmParse CmmExpr
+  -> CmmParse CmmReg
+  -> CmmParse ()
+  -> CmmParse ()
+reserveStackFrame psize preg body = do
+  dflags <- getDynFlags
+  old_updfr_off <- getUpdFrameOff
+  reg <- preg
+  esize <- psize
+  let size = case constantFoldExpr dflags esize of
+               CmmLit (CmmInt n _) -> n
+               _other -> pprPanic "CmmParse: not a compile-time integer: "
+                            (ppr esize)
+  let frame = old_updfr_off + wORD_SIZE dflags * fromIntegral size
+  emitAssign reg (CmmStackSlot Old frame)
+  withUpdFrameOff frame body
+
 profilingInfo dflags desc_str ty_str
   = if not (gopt Opt_SccProfilingOn dflags)
     then NoProfilingInfo
     else ProfilingInfo (stringToWord8s desc_str)
                        (stringToWord8s ty_str)
 
-staticClosure :: PackageId -> FastString -> FastString -> [CmmLit] -> CmmParse ()
+staticClosure :: PackageKey -> FastString -> FastString -> [CmmLit] -> CmmParse ()
 staticClosure pkg cl_label info payload
   = do dflags <- getDynFlags
        let lits = mkStaticClosure dflags (mkCmmInfoLabel pkg info) dontCareCCS payload [] [] []
@@ -1291,7 +1334,7 @@ forkLabelledCode p = do
 initEnv :: DynFlags -> Env
 initEnv dflags = listToUFM [
   ( fsLit "SIZEOF_StgHeader",
-    VarN (CmmLit (CmmInt (fromIntegral (fixedHdrSize dflags * wORD_SIZE dflags)) (wordWidth dflags)) )),
+    VarN (CmmLit (CmmInt (fromIntegral (fixedHdrSize dflags)) (wordWidth dflags)) )),
   ( fsLit "SIZEOF_StgInfoTable",
     VarN (CmmLit (CmmInt (fromIntegral (stdInfoTableSizeB dflags)) (wordWidth dflags)) ))
   ]