From 201aa3211648947db21b07644bdd9f48393c1167 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Mon, 11 Dec 2000 12:56:14 +0000
Subject: [PATCH 1/1] [project @ 2000-12-11 12:56:13 by simonmar] New BCO
 primops.

---
 ghc/compiler/prelude/primops.txt |   44 ++++----------------------------------
 ghc/includes/PrimOps.h           |    9 +++++++-
 ghc/lib/std/PrelGHC.hi-boot      |    3 +++
 ghc/rts/PrimOps.hc               |   31 ++++++++++++++++++++++++++-
 4 files changed, 45 insertions(+), 42 deletions(-)

diff --git a/ghc/compiler/prelude/primops.txt b/ghc/compiler/prelude/primops.txt
index 592f818..63c6141 100644
--- a/ghc/compiler/prelude/primops.txt
+++ b/ghc/compiler/prelude/primops.txt
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------
--- $Id: primops.txt,v 1.7 2000/12/04 12:31:19 simonmar Exp $
+-- $Id: primops.txt,v 1.8 2000/12/11 12:56:14 simonmar Exp $
 --
 -- Primitive Operations
 --
@@ -998,49 +998,13 @@ primop TouchOp "touch#" GenPrimOp
 ------------------------------------------------------------------------
 
 primop  NewBCOOp "newBCO#" GenPrimOp
-   Int# -> Int# -> Int# -> a -> State# RealWorld -> (# State# RealWorld, BCO# #)
+   ByteArr# -> ByteArr# -> MutArr# s a -> State# s -> (# State# s, BCO# #)
    with
    has_side_effects = True
    out_of_line      = True
-   strictness       = { \ arity -> StrictnessInfo 
-                                   [wwPrim, wwPrim, wwPrim, wwLazy, wwPrim] False }
-   usage            = { mangle NewBCOOp [mkP, mkP, mkP, mkM, mkP] mkR }
-
-primop  WriteBCOPtrOp "writeBCOPtr#" GenPrimOp
-   BCO# -> Int# -> o -> State# RealWorld -> State# RealWorld
-   with
-   usage            = { mangle WriteBCOPtrOp [mkP, mkP, mkM, mkP] mkR }
-   strictness       = { \ arity -> StrictnessInfo 
-                                   [wwPrim, wwPrim, wwLazy, wwPrim] False }
-   has_side_effects = True
-
-primop  WriteBCONonPtrOp "writeBCONonPtr#" GenPrimOp
-   BCO# -> Int# -> Word# -> State# RealWorld -> State# RealWorld
-   with
-   has_side_effects = True
-
-primop  WriteBCOInstrOp "writeBCOInstr#" GenPrimOp
-   BCO# -> Int# -> Word# -> State# RealWorld -> State# RealWorld
-   with
-   has_side_effects = True
-
-primop  ReadBCOPtrOp "readBCOPtr#"  GenPrimOp
-   BCO# -> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
-   with
-   usage = { mangle ReadBCOPtrOp [mkP, mkP] mkM }
-
-primop  ReadBCONonPtrOp "readBCONonPtr#"  GenPrimOp
-   BCO# -> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
-
-primop  ReadBCOInstrOp "readBCOInstr#" GenPrimOp
-   BCO# -> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
-
-primop  SameBCOOp "sameBCO#" GenPrimOp
-   BCO# -> BCO# -> Bool
-   with
-   -- is this usage right?
-   usage = { mangle SameMutableArrayOp [mkP, mkP] mkM }
 
+primop  GetBCOPtrsOp "getBCOPtrs#" GenPrimOp
+   BCO# -> State# s -> (# State# s, MutArr# s a #)
 
 ------------------------------------------------------------------------
 --- Weak pointers                                                    ---
diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h
index c4aa989..0813f7a 100644
--- a/ghc/includes/PrimOps.h
+++ b/ghc/includes/PrimOps.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.68 2000/12/04 12:31:20 simonmar Exp $
+ * $Id: PrimOps.h,v 1.69 2000/12/11 12:56:14 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -962,6 +962,13 @@ EXTFUN_RTS(mkForeignObjzh_fast);
 /*  tagToEnum# is handled directly by the code generator. */
 
 /* -----------------------------------------------------------------------------
+   BCOs
+   -------------------------------------------------------------------------- */
+
+EXTFUN_RTS(newBCOzh_fast);
+#define getBCOPtrszh(r,bco) r=((StgBCO *)bco)->ptrs
+
+/* -----------------------------------------------------------------------------
    Signal processing.  Not really primops, but called directly from
    Haskell. 
    -------------------------------------------------------------------------- */
diff --git a/ghc/lib/std/PrelGHC.hi-boot b/ghc/lib/std/PrelGHC.hi-boot
index e64caba..2e1c77c 100644
--- a/ghc/lib/std/PrelGHC.hi-boot
+++ b/ghc/lib/std/PrelGHC.hi-boot
@@ -348,6 +348,9 @@ __export PrelGHC
 
   reallyUnsafePtrEqualityzh
 
+  newBCOzh
+  getBCOPtrszh
+
   unsafeCoercezh
 ;
 
diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc
index f70d745..39a1503 100644
--- 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
    -------------------------------------------------------------------------- */
 
-- 
1.7.10.4