[project @ 2000-12-11 12:56:13 by simonmar]

[ghc-hetmet.git] / ghc / rts / PrimOps.hc

diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc
index f70d745..39a1503 100644 (file)
--- a/ghc/rts/PrimOps.hc
+++ b/ghc/rts/PrimOps.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.60 2000/12/04 12:31:21 simonmar Exp $
+ * $Id: PrimOps.hc,v 1.61 2000/12/11 12:56:14 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -1023,6 +1023,35 @@ FN_(makeStableNamezh_fast)
 }
 
 /* -----------------------------------------------------------------------------
+   Bytecode object primitives
+   -------------------------------------------------------------------------  */
+
+FN_(newBCOzh_fast)
+{
+  /* R1.p = instrs
+     R2.p = literals
+     R3.p = ptrs
+  */
+  StgBCO *bco;
+  FB_
+
+  HP_CHK_GEN_TICKY(sizeofW(StgBCO),R1_PTR|R2_PTR|R3_PTR, newBCOzh_fast,);
+  TICK_ALLOC_PRIM(sizeofW(StgHeader), sizeofW(StgBCO)-sizeofW(StgHeader), 0);
+  CCS_ALLOC(CCCS,sizeofW(StgBCO)); /* ccs prof */
+
+  bco = (StgBCO *) (Hp + 1 - sizeof(StgBCO));
+  SET_HDR(w, &stg_BCO_info, CCCS);
+
+  w->instrs     = R1.cl;
+  w->literals   = R2.cl;
+  w->ptrs       = R3.cl;
+
+  TICK_RET_UNBOXED_TUP(1);
+  RET_P(w);
+  FE_
+}
+
+/* -----------------------------------------------------------------------------
    Thread I/O blocking primitives
    -------------------------------------------------------------------------- */